procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge from trunk

Browse source
This commit is contained in:
Stefan Monnier 2011-02-01 12:09:25 -05:00
commit 8f1d2ef658
2420 changed files with 53924 additions and 27118 deletions
Download patch file Download diff file Expand all files Collapse all files

1
lisp/emacs-lisp/.gitignore vendored
View file

@ -1,3 +1,2 @@
!*-loaddefs.el
# arch-tag: d0a60bce-b886-4817-b4c3-9a81ba0308bc

8
lisp/emacs-lisp/advice.el
View file

@ -1,7 +1,6 @@
;;; advice.el --- an overloading mechanism for Emacs Lisp functions
;; Copyright (C) 1993, 1994, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1993-1994, 2000-2011 Free Software Foundation, Inc.
;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
;; Maintainer: FSF
@ -3008,9 +3007,7 @@ in any of these classes."
(setq usage (if (null usage) t (setq origdoc (cdr usage)) (car usage)))
(if origdoc (setq paragraphs (list origdoc)))
(unless (eq style 'plain)
(push (propertize (concat "This " origtype " is advised.")
'face 'font-lock-warning-face)
paragraphs))
(push (concat "This " origtype " is advised.") paragraphs))
(ad-dolist (class ad-advice-classes)
(ad-dolist (advice (ad-get-enabled-advices function class))
(setq advice-docstring
@ -3966,5 +3963,4 @@ Use only in REAL emergencies."
(provide 'advice)
;; arch-tag: 29f8c9a1-8c88-471f-95d7-e28541c6b7c0
;;; advice.el ends here

4
lisp/emacs-lisp/assoc.el
View file

@ -1,7 +1,6 @@
;;; assoc.el --- insert/delete/sort functions on association lists
;; Copyright (C) 1996, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
;; 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1996, 2001-2011 Free Software Foundation, Inc.
;; Author: Barry A. Warsaw <bwarsaw@cen.com>
;; Keywords: extensions
@ -138,5 +137,4 @@ extra values are ignored. Returns the created alist."
(provide 'assoc)
;; arch-tag: 3e58bd89-d912-4b74-a0dc-6ed9735922bc
;;; assoc.el ends here

3
lisp/emacs-lisp/authors.el
View file

@ -1,7 +1,6 @@
;;; authors.el --- utility for maintaining Emacs' AUTHORS file -*-coding: utf-8;-*-
;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
;; 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
;; Author: Gerd Moellmann <gerd@gnu.org>
;; Maintainer: Kim F. Storm <storm@cua.dk>

4
lisp/emacs-lisp/autoload.el
View file

@ -1,8 +1,6 @@
;; autoload.el --- maintain autoloads in loaddefs.el
;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 2001, 2002, 2003,
;; 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Copyright (C) 1991-1997, 2001-2011 Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
;; Keywords: maint

3
lisp/emacs-lisp/avl-tree.el
View file

@ -1,6 +1,6 @@
;;; avl-tree.el --- balanced binary trees, AVL-trees
;; Copyright (C) 1995, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1995, 2007-2011 Free Software Foundation, Inc.
;; Author: Per Cederqvist <ceder@lysator.liu.se>
;; Inge Wallin <inge@lysator.liu.se>
@ -466,5 +466,4 @@ If there is no such element in the tree, the value is nil."
(provide 'avl-tree)
;; arch-tag: 47e26701-43c9-4222-bd79-739eac6357a9
;;; avl-tree.el ends here

4
lisp/emacs-lisp/backquote.el
View file

@ -1,7 +1,6 @@
;;; backquote.el --- implement the ` Lisp construct
;; Copyright (C) 1990, 1992, 1994, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1990, 1992, 1994, 2001-2011 Free Software Foundation, Inc.
;; Author: Rick Sladkey <jrs@world.std.com>
;; Maintainer: FSF
@ -241,5 +240,4 @@ LEVEL is only used internally and indicates the nesting level:
tail))
(t (cons 'list heads)))))
;; arch-tag: 1a26206a-6b5e-4c56-8e24-2eef0f7e0e7a
;;; backquote.el ends here

4
lisp/emacs-lisp/benchmark.el
View file

@ -1,7 +1,6 @@
;;; benchmark.el --- support for benchmarking code
;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Copyright (C) 2003-2011 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: lisp, extensions
@ -116,5 +115,4 @@ For non-interactive use see also `benchmark-run' and
(provide 'benchmark)
;; arch-tag: be570e24-4b51-4784-adf3-fa2b56c31946
;;; benchmark.el ends here

3
lisp/emacs-lisp/bindat.el
View file

@ -1,6 +1,6 @@
;;; bindat.el --- binary data structure packing and unpacking.
;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Assignment name: struct.el
@ -649,5 +649,4 @@ The port (if any) is omitted. IP can be a string, as well."
(provide 'bindat)
;; arch-tag: 5e6708c3-03e2-4ad7-9885-5041b779c3fb
;;; bindat.el ends here

3
lisp/emacs-lisp/byte-opt.el
View file

@ -1,7 +1,6 @@
;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler
;; Copyright (C) 1991, 1994, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1991, 1994, 2000-2011 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>

4
lisp/emacs-lisp/byte-run.el
View file

@ -1,7 +1,6 @@
;;; byte-run.el --- byte-compiler support for inlining
;; Copyright (C) 1992, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
;; 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1992, 2001-2011 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
@ -292,5 +291,4 @@ In interpreted code, this is entirely equivalent to `progn'."
;; (file-format emacs19))"
;; nil)
;; arch-tag: 76f8328a-1f66-4df2-9b6d-5c3666dc05e9
;;; byte-run.el ends here

9
lisp/emacs-lisp/bytecomp.el
View file

@ -1,7 +1,6 @@
;;; bytecomp.el --- compilation of Lisp code into byte code
;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002,
;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Copyright (C) 1985-1987, 1992, 1994, 1998, 2000-2011
;; Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
@ -2177,9 +2176,9 @@ list that represents a doc string reference.
;; to objects already output
;; (for instance, gensyms in the arg list).
(let (non-nil)
(dotimes (i (length print-number-table))
(if (aref print-number-table i)
(setq non-nil t)))
(when (hash-table-p print-number-table)
(maphash (lambda (k v) (if v (setq non-nil t)))
print-number-table))
(not non-nil)))
;; Output the byte code and constants specially
;; for lazy dynamic loading.

75
lisp/emacs-lisp/chart.el
View file

@ -1,7 +1,7 @@
;;; chart.el --- Draw charts (bar charts, etc)
;; Copyright (C) 1996, 1998, 1999, 2001, 2004, 2005, 2007, 2008, 2009,
;; 2010 Free Software Foundation, Inc.
;; Copyright (C) 1996, 1998-1999, 2001, 2004-2005, 2007-2011
;; Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 0.2
@ -62,17 +62,13 @@
(require 'eieio)
;;; Code:
(defvar chart-map (make-sparse-keymap) "Keymap used in chart mode.")
(defvar chart-mode-map (make-sparse-keymap) "Keymap used in chart mode.")
(define-obsolete-variable-alias 'chart-map 'chart-mode-map "24.1")
(defvar chart-local-object nil
"Local variable containing the locally displayed chart object.")
(make-variable-buffer-local 'chart-local-object)
(defvar chart-face-list nil
"Faces used to colorize charts.
List is limited currently, which is ok since you really can't display
too much in text characters anyways.")
(defvar chart-face-color-list '("red" "green" "blue"
"cyan" "yellow" "purple")
"Colors to use when generating `chart-face-list'.
@ -90,41 +86,42 @@ Useful if new Emacs is used on B&W display.")
:group 'eieio
:type 'boolean)
(if (and (if (fboundp 'display-color-p)
(display-color-p)
window-system)
(not chart-face-list))
(let ((cl chart-face-color-list)
(pl chart-face-pixmap-list)
nf)
(while cl
(setq nf (make-face (intern (concat "chart-" (car cl) "-" (car pl)))))
(if (condition-case nil
(> (x-display-color-cells) 4)
(error t))
(set-face-background nf (car cl))
(set-face-background nf "white"))
(set-face-foreground nf "black")
(if (and chart-face-use-pixmaps
pl
(fboundp 'set-face-background-pixmap))
(condition-case nil
(set-face-background-pixmap nf (car pl))
(error (message "Cannot set background pixmap %s" (car pl)))))
(setq chart-face-list (cons nf chart-face-list))
(setq cl (cdr cl)
pl (cdr pl)))))
(defvar chart-face-list
(if (if (fboundp 'display-color-p)
(display-color-p)
window-system)
(let ((cl chart-face-color-list)
(pl chart-face-pixmap-list)
(faces ())
nf)
(while cl
(setq nf (make-face
(intern (concat "chart-" (car cl) "-" (car pl)))))
(set-face-background nf (if (condition-case nil
(> (x-display-color-cells) 4)
(error t))
(car cl)
"white"))
(set-face-foreground nf "black")
(if (and chart-face-use-pixmaps
pl
(fboundp 'set-face-background-pixmap))
(condition-case nil
(set-face-background-pixmap nf (car pl))
(error (message "Cannot set background pixmap %s" (car pl)))))
(push nf faces)
(setq cl (cdr cl)
pl (cdr pl)))
faces))
"Faces used to colorize charts.
List is limited currently, which is ok since you really can't display
too much in text characters anyways.")
(defun chart-mode ()
(define-derived-mode chart-mode fundamental-mode "CHART"
"Define a mode in Emacs for displaying a chart."
(kill-all-local-variables)
(use-local-map chart-map)
(setq major-mode 'chart-mode
mode-name "CHART")
(buffer-disable-undo)
(set (make-local-variable 'font-lock-global-modes) nil)
(font-lock-mode -1)
(run-hooks 'chart-mode-hook)
(font-lock-mode -1) ;Isn't it off already? --Stef
)
(defun chart-new-buffer (obj)

3
lisp/emacs-lisp/check-declare.el
View file

@ -1,6 +1,6 @@
;;; check-declare.el --- Check declare-function statements
;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
;; Author: Glenn Morris <rgm@gnu.org>
;; Keywords: lisp, tools, maint
@ -314,5 +314,4 @@ Returns non-nil if any false statements are found."
(provide 'check-declare)
;; arch-tag: a4d6cdc4-deb7-4502-b327-0e4ef3d82d96
;;; check-declare.el ends here.

7
lisp/emacs-lisp/checkdoc.el
View file

@ -1,7 +1,6 @@
;;; checkdoc.el --- check documentation strings for style requirements
;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
;; 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1997-1998, 2001-2011 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 0.6.2
@ -1798,7 +1797,9 @@ Replace with \"%s\"? " original replace)
(let ((found nil) (start (point)) (msg nil) (ms nil))
(while (and (not msg)
(re-search-forward
"[^-([`':a-zA-Z]\\(\\w+[:-]\\(\\w\\|\\s_\\)+\\)[^]']"
;; Ignore manual page refereces like
;; git-config(1).
"[^-([`':a-zA-Z]\\(\\w+[:-]\\(\\w\\|\\s_\\)+\\)[^](']"
e t))
(setq ms (match-string 1))
;; A . is a \s_ char, so we must remove periods from

4
lisp/emacs-lisp/cl-extra.el
View file

@ -1,7 +1,6 @@
;;; cl-extra.el --- Common Lisp features, part 2
;; Copyright (C) 1993, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
;; 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1993, 2000-2011 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Keywords: extensions
@ -826,5 +825,4 @@ This also does some trivial optimizations to make the form prettier."
;; generated-autoload-file: "cl-loaddefs.el"
;; End:
;; arch-tag: bcd03437-0871-43fb-a8f1-ad0e0b5427ed
;;; cl-extra.el ends here

4
lisp/emacs-lisp/cl-indent.el
View file

@ -1,7 +1,6 @@
;;; cl-indent.el --- enhanced lisp-indent mode
;; Copyright (C) 1987, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
;; 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1987, 2000-2011 Free Software Foundation, Inc.
;; Author: Richard Mlynarik <mly@eddie.mit.edu>
;; Created: July 1987
@ -691,5 +690,4 @@ For example, the function `case' has an indent property
;(put 'defclass 'common-lisp-indent-function '((&whole 2 &rest (&whole 2 &rest 1) &rest (&whole 2 &rest 1)))
;(put 'defgeneric 'common-lisp-indent-function 'defun)
;; arch-tag: 7914d50f-92ec-4476-93fc-0f043a380e03
;;; cl-indent.el ends here

6
lisp/emacs-lisp/cl-loaddefs.el
View file

@ -10,7 +10,7 @@
;;;;;; ceiling* floor* isqrt lcm gcd cl-progv-before cl-set-frame-visible-p
;;;;;; cl-map-overlays cl-map-intervals cl-map-keymap-recursively
;;;;;; notevery notany every some mapcon mapcan mapl maplist map
;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "20c8c875ff1d11dd819e15a1f25afd73")
;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "60f6b85256416c5f2a0a3954a11523b6")
;;; Generated autoloads from cl-extra.el
(autoload 'coerce "cl-extra" "\
@ -282,7 +282,7 @@ Not documented
;;;;;; do-all-symbols do-symbols dotimes dolist do* do loop return-from
;;;;;; return block etypecase typecase ecase case load-time-value
;;;;;; eval-when destructuring-bind function* defmacro* defun* gentemp
;;;;;; gensym) "cl-macs" "cl-macs.el" "34ea402a8756c7d74d27cdcecf35e3c3")
;;;;;; gensym) "cl-macs" "cl-macs.el" "8b2ce9c2ec0e273606bb37c333c4bdde")
;;; Generated autoloads from cl-macs.el
(autoload 'gensym "cl-macs" "\
@ -754,7 +754,7 @@ surrounded by (block NAME ...).
;;;;;; find nsubstitute-if-not nsubstitute-if nsubstitute substitute-if-not
;;;;;; substitute-if substitute delete-duplicates remove-duplicates
;;;;;; delete-if-not delete-if delete* remove-if-not remove-if remove*
;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "7b7531276ddf8457abecdd487d3cf0b7")
;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "43e0c1183e738e1e1038cdd84fde8366")
;;; Generated autoloads from cl-seq.el
(autoload 'reduce "cl-seq" "\

3
lisp/emacs-lisp/cl-macs.el
View file

@ -1,7 +1,6 @@
;;; cl-macs.el --- Common Lisp macros
;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
;; 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Version: 2.02

4
lisp/emacs-lisp/cl-seq.el
View file

@ -1,7 +1,6 @@
;;; cl-seq.el --- Common Lisp features, part 3
;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
;; 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Version: 2.02
@ -1018,5 +1017,4 @@ Atoms are compared by `eql'; cons cells are compared recursively.
;; generated-autoload-file: "cl-loaddefs.el"
;; End:
;; arch-tag: ec1cc072-9006-4225-b6ba-d6b07ed1710c
;;; cl-seq.el ends here

4
lisp/emacs-lisp/cl-specs.el
View file

@ -1,7 +1,6 @@
;;; cl-specs.el --- Edebug specs for cl.el -*- no-byte-compile: t -*-
;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc.
;; Author: Daniel LaLiberte <liberte@holonexus.org>
;; Keywords: lisp, tools, maint
;; Package: emacs
@ -469,5 +468,4 @@
(def-edebug-spec loop-d-type-spec
(&or (loop-d-type-spec . [&or nil loop-d-type-spec]) cl-type-spec))
;; arch-tag: b29aa3c2-cf67-4af8-9ee1-318fea61b478
;;; cl-specs.el ends here

4
lisp/emacs-lisp/cl.el
View file

@ -1,7 +1,6 @@
;;; cl.el --- Common Lisp extensions for Emacs
;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
;; 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Version: 2.02
@ -676,5 +675,4 @@ If ALIST is non-nil, the new pairs are prepended to it."
;; byte-compile-warnings: (not cl-functions)
;; End:
;; arch-tag: 5f07fa74-f153-4524-9303-21f5be125851
;;; cl.el ends here

332
lisp/emacs-lisp/copyright.el
View file

@ -1,7 +1,6 @@
;;; copyright.el --- update the copyright notice in current buffer
;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1998, 2001, 2002, 2003,
;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1991-1995, 1998, 2001-2011 Free Software Foundation, Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
;; Keywords: maint, tools
@ -47,6 +46,7 @@ This is useful for ChangeLogs."
:group 'copyright
:type 'boolean
:version "23.1")
;;;###autoload(put 'copyright-at-end-flag 'safe-local-variable 'booleanp)
(defcustom copyright-regexp
"\\(©\\|@copyright{}\\|[Cc]opyright\\s *:?\\s *\\(?:(C)\\)?\
@ -66,6 +66,11 @@ someone else or to a group for which you do not work."
:group 'copyright
:type 'regexp)
;; The worst that can happen is a malicious regexp that overflows in
;; the regexp matcher, a minor nuisance. It's a pain to be always
;; prompted if you want to put this in a dir-locals.el.
;;;###autoload(put 'copyright-names-regexp 'safe-local-variable 'stringp)
(defcustom copyright-years-regexp
"\\(\\s *\\)\\([1-9]\\([-0-9, ';/*%#\n\t]\\|\\s<\\|\\s>\\)*[0-9]+\\)"
"Match additional copyright notice years.
@ -73,6 +78,19 @@ The second \\( \\) construct must match the years."
:group 'copyright
:type 'regexp)
;; See "Copyright Notices" in maintain.info.
;; TODO? 'end only for ranges at the end, other for all ranges.
;; Minimum limit on the size of a range?
(defcustom copyright-year-ranges nil
"Non-nil if individual consecutive years should be replaced with a range.
For example: 2005, 2006, 2007, 2008 might be replaced with 2005-2008.
If you use ranges, you should add an explanatory note in a README file.
The function `copyright-fix-year' respects this variable."
:group 'copyright
:type 'boolean
:version "24.1")
;;;###autoload(put 'copyright-year-ranges 'safe-local-variable 'booleanp)
(defcustom copyright-query 'function
"If non-nil, ask user before changing copyright.
@ -120,78 +138,88 @@ When this is `function', only ask when called non-interactively."
(< (point) (- (point-max) copyright-limit))
(> (point) (+ (point-min) copyright-limit)))))
(defun copyright-update-year (replace noquery)
(when
(condition-case err
;; (1) Need the extra \\( \\) around copyright-regexp because we
;; goto (match-end 1) below. See note (2) below.
(copyright-re-search (concat "\\(" copyright-regexp
"\\)\\([ \t]*\n\\)?.*\\(?:"
copyright-names-regexp "\\)")
(copyright-limit)
t)
;; In case the regexp is rejected. This is useful because
;; copyright-update is typically called from before-save-hook where
;; such an error is very inconvenient for the user.
(error (message "Can't update copyright: %s" err) nil))
(goto-char (match-end 1))
;; If the years are continued onto multiple lines
;; that are marked as comments, skip to the end of the years anyway.
(while (save-excursion
(and (eq (following-char) ?,)
(progn (forward-char 1) t)
(progn (skip-chars-forward " \t") (eolp))
comment-start-skip
(save-match-data
(forward-line 1)
(and (looking-at comment-start-skip)
(goto-char (match-end 0))))
(looking-at-p copyright-years-regexp)))
(forward-line 1)
(re-search-forward comment-start-skip)
;; (2) Need the extra \\( \\) so that the years are subexp 3, as
;; they are at note (1) above.
(re-search-forward (format "\\(%s\\)" copyright-years-regexp)))
(defun copyright-find-copyright ()
"Return non-nil if a copyright header suitable for updating is found.
The header must match `copyright-regexp' and `copyright-names-regexp', if set.
This function sets the match-data that `copyright-update-year' uses."
(widen)
(goto-char (copyright-start-point))
(condition-case err
;; (1) Need the extra \\( \\) around copyright-regexp because we
;; goto (match-end 1) below. See note (2) below.
(copyright-re-search (concat "\\(" copyright-regexp
"\\)\\([ \t]*\n\\)?.*\\(?:"
copyright-names-regexp "\\)")
(copyright-limit)
t)
;; In case the regexp is rejected. This is useful because
;; copyright-update is typically called from before-save-hook where
;; such an error is very inconvenient for the user.
(error (message "Can't update copyright: %s" err) nil)))
;; Note that `current-time-string' isn't locale-sensitive.
(setq copyright-current-year (substring (current-time-string) -4))
(unless (string= (buffer-substring (- (match-end 3) 2) (match-end 3))
(substring copyright-current-year -2))
(if (or noquery
(save-window-excursion
(switch-to-buffer (current-buffer))
;; Fixes some point-moving oddness (bug#2209).
(save-excursion
(y-or-n-p (if replace
(concat "Replace copyright year(s) by "
copyright-current-year "? ")
(concat "Add " copyright-current-year
" to copyright? "))))))
(if replace
(replace-match copyright-current-year t t nil 3)
(let ((size (save-excursion (skip-chars-backward "0-9"))))
(if (and (eq (% (- (string-to-number copyright-current-year)
(string-to-number (buffer-substring
(+ (point) size)
(point))))
100)
1)
(or (eq (char-after (+ (point) size -1)) ?-)
(eq (char-after (+ (point) size -2)) ?-)))
;; This is a range so just replace the end part.
(delete-char size)
;; Insert a comma with the preferred number of spaces.
(insert
(save-excursion
(if (re-search-backward "[0-9]\\( *, *\\)[0-9]"
(line-beginning-position) t)
(match-string 1)
", ")))
;; If people use the '91 '92 '93 scheme, do that as well.
(if (eq (char-after (+ (point) size -3)) ?')
(insert ?')))
;; Finally insert the new year.
(insert (substring copyright-current-year size))))))))
(defun copyright-find-end ()
"Possibly adjust the search performed by `copyright-find-copyright'.
If the years continue onto multiple lines that are marked as comments,
skips to the end of all the years."
(while (save-excursion
(and (eq (following-char) ?,)
(progn (forward-char 1) t)
(progn (skip-chars-forward " \t") (eolp))
comment-start-skip
(save-match-data
(forward-line 1)
(and (looking-at comment-start-skip)
(goto-char (match-end 0))))
(looking-at-p copyright-years-regexp)))
(forward-line 1)
(re-search-forward comment-start-skip)
;; (2) Need the extra \\( \\) so that the years are subexp 3, as
;; they are at note (1) above.
(re-search-forward (format "\\(%s\\)" copyright-years-regexp))))
(defun copyright-update-year (replace noquery)
;; This uses the match-data from copyright-find-copyright/end.
(goto-char (match-end 1))
(copyright-find-end)
;; Note that `current-time-string' isn't locale-sensitive.
(setq copyright-current-year (substring (current-time-string) -4))
(unless (string= (buffer-substring (- (match-end 3) 2) (match-end 3))
(substring copyright-current-year -2))
(if (or noquery
(save-window-excursion
(switch-to-buffer (current-buffer))
;; Fixes some point-moving oddness (bug#2209).
(save-excursion
(y-or-n-p (if replace
(concat "Replace copyright year(s) by "
copyright-current-year "? ")
(concat "Add " copyright-current-year
" to copyright? "))))))
(if replace
(replace-match copyright-current-year t t nil 3)
(let ((size (save-excursion (skip-chars-backward "0-9"))))
(if (and (eq (% (- (string-to-number copyright-current-year)
(string-to-number (buffer-substring
(+ (point) size)
(point))))
100)
1)
(or (eq (char-after (+ (point) size -1)) ?-)
(eq (char-after (+ (point) size -2)) ?-)))
;; This is a range so just replace the end part.
(delete-char size)
;; Insert a comma with the preferred number of spaces.
(insert
(save-excursion
(if (re-search-backward "[0-9]\\( *, *\\)[0-9]"
(line-beginning-position) t)
(match-string 1)
", ")))
;; If people use the '91 '92 '93 scheme, do that as well.
(if (eq (char-after (+ (point) size -3)) ?')
(insert ?')))
;; Finally insert the new year.
(insert (substring copyright-current-year size)))))))
;;;###autoload
(defun copyright-update (&optional arg interactivep)
@ -208,76 +236,110 @@ interactively."
(and (eq copyright-query 'function) interactivep))))
(save-excursion
(save-restriction
(widen)
(goto-char (copyright-start-point))
(copyright-update-year arg noquery)
(goto-char (copyright-start-point))
(and copyright-current-gpl-version
;; match the GPL version comment in .el files, including the
;; bilingual Esperanto one in two-column, and in texinfo.tex
(copyright-re-search
"\\(the Free Software Foundation;\
either \\|; a\\^u eldono \\([0-9]+\\)a, ? a\\^u (la\\^u via \\)\
version \\([0-9]+\\), or (at"
(copyright-limit) t)
;; Don't update if the file is already using a more recent
;; version than the "current" one.
(< (string-to-number (match-string 3))
(string-to-number copyright-current-gpl-version))
(or noquery
(save-match-data
(save-window-excursion
(switch-to-buffer (current-buffer))
(y-or-n-p (format "Replace GPL version by %s? "
copyright-current-gpl-version)))))
(progn
(if (match-end 2)
;; Esperanto bilingual comment in two-column.el
(replace-match copyright-current-gpl-version t t nil 2))
(replace-match copyright-current-gpl-version t t nil 3))))
;; If names-regexp doesn't match, we should not mess with
;; the years _or_ the GPL version.
;; TODO there may be multiple copyrights we should update.
(when (copyright-find-copyright)
(copyright-update-year arg noquery)
(goto-char (copyright-start-point))
(and copyright-current-gpl-version
;; Match the GPL version comment in .el files.
;; This is sensitive to line-breaks. :(
(copyright-re-search
"the Free Software Foundation[,;\n].*either version \
\\([0-9]+\\)\\(?: of the License\\)?, or[ \n].*any later version"
(copyright-limit) t)
;; Don't update if the file is already using a more recent
;; version than the "current" one.
(< (string-to-number (match-string 1))
(string-to-number copyright-current-gpl-version))
(or noquery
(save-match-data
(goto-char (match-end 1))
(save-window-excursion
(switch-to-buffer (current-buffer))
(y-or-n-p
(format "Replace GPL version %s with version %s? "
(match-string-no-properties 1)
copyright-current-gpl-version)))))
(replace-match copyright-current-gpl-version t t nil 1))))
(set (make-local-variable 'copyright-update) nil)))
;; If a write-file-hook returns non-nil, the file is presumed to be written.
nil))
;; FIXME should be within 50 years of present (cf calendar).
;; FIXME heuristic should be within 50 years of present (cf calendar).
;;;###autoload
(defun copyright-fix-years ()
"Convert 2 digit years to 4 digit years.
Uses heuristic: year >= 50 means 19xx, < 50 means 20xx."
Uses heuristic: year >= 50 means 19xx, < 50 means 20xx.
If `copyright-year-ranges' (which see) is non-nil, also
independently replaces consecutive years with a range."
(interactive)
(widen)
(goto-char (copyright-start-point))
(if (copyright-re-search copyright-regexp (copyright-limit) t)
(let ((s (match-beginning 2))
(e (copy-marker (1+ (match-end 2))))
;; TODO there may be multiple copyrights we should fix.
(if (copyright-find-copyright)
(let ((s (match-beginning 3))
(p (make-marker))
last)
;; Not line-beg-pos, so we don't mess up leading whitespace.
(copystart (match-beginning 0))
e last sep year prev-year first-year range-start range-end)
;; In case years are continued over multiple, commented lines.
(goto-char (match-end 1))
(copyright-find-end)
(setq e (copy-marker (1+ (match-end 3))))
(goto-char s)
(while (re-search-forward "[0-9]+" e t)
(set-marker p (point))
(goto-char (match-beginning 0))
(let ((sep (char-before))
(year (string-to-number (match-string 0))))
(when (and sep
(/= (char-syntax sep) ?\s)
(/= sep ?-))
(insert " "))
(when (< year 100)
(insert (if (>= year 50) "19" "20"))))
(setq year (string-to-number (match-string 0)))
(and (setq sep (char-before))
(/= (char-syntax sep) ?\s)
(/= sep ?-)
(insert " "))
(when (< year 100)
(insert (if (>= year 50) "19" "20"))
(setq year (+ year (if (>= year 50) 1900 2000))))
(goto-char p)
(setq last p))
(when copyright-year-ranges
;; If the previous thing was a range, don't try to tack more on.
;; Ie not 2000-2005 -> 2000-2005-2007
;; TODO should merge into existing range if possible.
(if (eq sep ?-)
(setq prev-year nil
year nil)
(if (and prev-year (= year (1+ prev-year)))
(setq range-end (point))
(when (and first-year prev-year
(> prev-year first-year))
(goto-char range-end)
(delete-region range-start range-end)
(insert (format "-%d" prev-year))
(goto-char p))
(setq first-year year
range-start (point)))))
(setq prev-year year
last p))
(when last
(when (and copyright-year-ranges
first-year prev-year
(> prev-year first-year))
(goto-char range-end)
(delete-region range-start range-end)
(insert (format "-%d" prev-year)))
(goto-char last)
;; Don't mess up whitespace after the years.
(skip-chars-backward " \t")
(save-restriction
(narrow-to-region (copyright-start-point) (point))
(let ((fill-prefix " "))
(fill-region s last))))
(save-restriction
(narrow-to-region copystart (point))
;; This is clearly wrong, eg what about comment markers?
;;; (let ((fill-prefix " "))
;; TODO do not break copyright owner over lines.
(fill-region (point-min) (point-max))))
(set-marker e nil)
(set-marker p nil)
(copyright-update nil t))
(set-marker p nil))
;; Simply reformatting the years is not copyrightable, so it does
;; not seem right to call this. Also it messes with ranges.
;;; (copyright-update nil t))
(message "No copyright message")))
;;;###autoload
@ -292,17 +354,24 @@ Uses heuristic: year >= 50 means 19xx, < 50 means 20xx."
(message "Copyright extends beyond `copyright-limit' and won't be updated automatically."))
comment-end \n)
;; TODO: recurse, exclude COPYING etc.
;;;###autoload
(defun copyright-update-directory (directory match)
"Update copyright notice for all files in DIRECTORY matching MATCH."
(defun copyright-update-directory (directory match &optional fix)
"Update copyright notice for all files in DIRECTORY matching MATCH.
If FIX is non-nil, run `copyright-fix-years' instead."
(interactive "DDirectory: \nMFilenames matching (regexp): ")
(dolist (file (directory-files directory t match nil))
(message "Updating file `%s'" file)
(find-file file)
(let ((copyright-query nil))
(copyright-update))
(save-buffer)
(kill-buffer (current-buffer))))
(unless (file-directory-p file)
(message "Updating file `%s'" file)
(find-file file)
(let ((inhibit-read-only t)
(enable-local-variables :safe)
copyright-query)
(if fix
(copyright-fix-years)
(copyright-update)))
(save-buffer)
(kill-buffer (current-buffer)))))
(provide 'copyright)
@ -311,5 +380,4 @@ Uses heuristic: year >= 50 means 19xx, < 50 means 20xx."
;; coding: utf-8
;; End:
;; arch-tag: b4991afb-b6b1-4590-bebe-e076d9d4aee8
;;; copyright.el ends here

4
lisp/emacs-lisp/crm.el
View file

@ -1,7 +1,6 @@
;;; crm.el --- read multiple strings with completion
;; Copyright (C) 1985, 1986, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1985-1986, 1993-2011 Free Software Foundation, Inc.
;; Author: Sen Nagata <sen@eccosys.com>
;; Keywords: completion, minibuffer, multiple elements
@ -321,5 +320,4 @@ INHERIT-INPUT-METHOD."
(provide 'crm)
;; arch-tag: db1911d9-86c6-4a42-b32a-4910701b15a6
;;; crm.el ends here

4
lisp/emacs-lisp/cust-print.el
View file

@ -1,7 +1,6 @@
;;; cust-print.el --- handles print-level and print-circle
;; Copyright (C) 1992, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
;; 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1992, 2001-2011 Free Software Foundation, Inc.
;; Author: Daniel LaLiberte <liberte@holonexus.org>
;; Adapted-By: ESR
@ -681,5 +680,4 @@ See `custom-format' for the details."
(provide 'cust-print)
;; arch-tag: 3a5a8650-622c-48c4-87d8-e01bf72ec580
;;; cust-print.el ends here

4
lisp/emacs-lisp/debug.el
View file

@ -1,7 +1,6 @@
;;; debug.el --- debuggers and related commands for Emacs
;; Copyright (C) 1985, 1986, 1994, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1985-1986, 1994, 2001-2011 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: lisp, tools, maint
@ -890,5 +889,4 @@ To specify a nil argument interactively, exit with an empty minibuffer."
(provide 'debug)
;; arch-tag: b6ec7047-f801-4103-9c63-d69322db9d3b
;;; debug.el ends here

4
lisp/emacs-lisp/derived.el
View file

@ -1,8 +1,7 @@
;;; derived.el --- allow inheritance of major modes
;; (formerly mode-clone.el)
;; Copyright (C) 1993, 1994, 1999, 2001, 2002, 2003, 2004, 2005, 2006,
;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1993-1994, 1999, 2001-2011 Free Software Foundation, Inc.
;; Author: David Megginson (dmeggins@aix1.uottawa.ca)
;; Maintainer: FSF
@ -457,5 +456,4 @@ Where the new table already has an entry, nothing is copied from the old one."
(provide 'derived)
;; arch-tag: 630be248-47d1-4f02-afa0-8207de0ebea0
;;; derived.el ends here

4
lisp/emacs-lisp/disass.el
View file

@ -1,7 +1,6 @@
;;; disass.el --- disassembler for compiled Emacs Lisp code
;; Copyright (C) 1986, 1991, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1986, 1991, 2002-2011 Free Software Foundation, Inc.
;; Author: Doug Cutting <doug@csli.stanford.edu>
;; Jamie Zawinski <jwz@lucid.com>
@ -269,5 +268,4 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler."
(provide 'disass)
;; arch-tag: 89482fe4-a087-4761-8dc6-d771054e763a
;;; disass.el ends here

10
lisp/emacs-lisp/easy-mmode.el
View file

@ -1,7 +1,6 @@
;;; easy-mmode.el --- easy definition for major and minor modes
;; Copyright (C) 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
;; 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1997, 2000-2011 Free Software Foundation, Inc.
;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr>
;; Maintainer: Stefan Monnier <monnier@gnu.org>
@ -94,8 +93,9 @@ Optional INIT-VALUE is the initial value of the mode's variable.
Optional LIGHTER is displayed in the modeline when the mode is on.
Optional KEYMAP is the default keymap bound to the mode keymap.
If non-nil, it should be a variable name (whose value is a keymap),
a keymap, or a list of arguments for `easy-mmode-define-keymap'.
If KEYMAP is a keymap or list, this also defines the variable MODE-map.
or an expression that returns either a keymap or a list of
arguments for `easy-mmode-define-keymap'. If KEYMAP is not a symbol,
this also defines the variable MODE-map.
BODY contains code to execute each time the mode is enabled or disabled.
It is executed after toggling the mode, and before running MODE-hook.
@ -274,7 +274,7 @@ With zero or negative ARG turn mode off.
(let ((m ,keymap))
(cond ((keymapp m) m)
((listp m) (easy-mmode-define-keymap m))
(t (error "Invalid keymap %S" ,keymap))))
(t (error "Invalid keymap %S" m))))
,(format "Keymap for `%s'." mode-name)))
,(if (not (symbolp mode))

86
lisp/emacs-lisp/easymenu.el
View file

@ -1,7 +1,6 @@
;;; easymenu.el --- support the easymenu interface for defining a menu
;; Copyright (C) 1994, 1996, 1998, 1999, 2000, 2001, 2002, 2003,
;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1994, 1996, 1998-2011 Free Software Foundation, Inc.
;; Keywords: emulations
;; Author: Richard Stallman <rms@gnu.org>
@ -30,6 +29,8 @@
;;; Code:
(eval-when-compile (require 'cl))
(defvar easy-menu-precalculate-equivalent-keybindings nil
"Determine when equivalent key bindings are computed for easy-menu menus.
It can take some time to calculate the equivalent key bindings that are shown
@ -66,8 +67,8 @@ expression has a non-nil value. `:included' is an alias for `:visible'.
:active ENABLE
ENABLE is an expression; the menu is enabled for selection
whenever this expression's value is non-nil.
ENABLE is an expression; the menu is enabled for selection whenever
this expression's value is non-nil. `:enable' is an alias for `:active'.
The rest of the elements in MENU, are menu items.
@ -104,8 +105,8 @@ keyboard equivalent.
:active ENABLE
ENABLE is an expression; the item is enabled for selection
whenever this expression's value is non-nil.
ENABLE is an expression; the item is enabled for selection whenever
this expression's value is non-nil. `:enable' is an alias for `:active'.
:visible INCLUDE
@ -163,10 +164,13 @@ This is expected to be bound to a mouse event."
(prog1 (get menu 'menu-prop)
(setq menu (symbol-function menu))))))
(cons 'menu-item
(cons (or item-name
(if (keymapp menu)
(keymap-prompt menu))
"")
(cons (if (eq :label (car props))
(prog1 (cadr props)
(setq props (cddr props)))
(or item-name
(if (keymapp menu)
(keymap-prompt menu))
""))
(cons menu props)))))
;;;###autoload
@ -232,15 +236,14 @@ possibly preceded by keyword pairs as described in `easy-menu-define'."
(keywordp (setq keyword (car menu-items))))
(setq arg (cadr menu-items))
(setq menu-items (cddr menu-items))
(cond
((eq keyword :filter)
(case keyword
(:filter
(setq filter `(lambda (menu)
(easy-menu-filter-return (,arg menu) ,menu-name))))
((eq keyword :active) (setq enable (or arg ''nil)))
((eq keyword :label) (setq label arg))
((eq keyword :help) (setq help arg))
((or (eq keyword :included) (eq keyword :visible))
(setq visible (or arg ''nil)))))
((:enable :active) (setq enable (or arg ''nil)))
(:label (setq label arg))
(:help (setq help arg))
((:included :visible) (setq visible (or arg ''nil)))))
(if (equal visible ''nil)
nil ; Invisible menu entry, return nil.
(if (and visible (not (easy-menu-always-true-p visible)))
@ -249,14 +252,14 @@ possibly preceded by keyword pairs as described in `easy-menu-define'."
(setq prop (cons :enable (cons enable prop))))
(if filter (setq prop (cons :filter (cons filter prop))))
(if help (setq prop (cons :help (cons help prop))))
(if label (setq prop (cons nil (cons label prop))))
(if filter
;; The filter expects the menu in its XEmacs form and the pre-filter
;; form will only be passed to the filter anyway, so we'd better
;; not convert it at all (it will be converted on the fly by
;; easy-menu-filter-return).
(setq menu menu-items)
(setq menu (append menu (mapcar 'easy-menu-convert-item menu-items))))
(if label (setq prop (cons :label (cons label prop))))
(setq menu (if filter
;; The filter expects the menu in its XEmacs form and the
;; pre-filter form will only be passed to the filter
;; anyway, so we'd better not convert it at all (it will
;; be converted on the fly by easy-menu-filter-return).
menu-items
(append menu (mapcar 'easy-menu-convert-item menu-items))))
(when prop
(setq menu (easy-menu-make-symbol menu 'noexp))
(put menu 'menu-prop prop))
@ -312,7 +315,7 @@ ITEM defines an item as in `easy-menu-define'."
;; Invisible menu item. Don't insert into keymap.
(setq remove t)
(when (and (symbolp command) (setq prop (get command 'menu-prop)))
(when (null (car prop))
(when (eq :label (car prop))
(setq label (cadr prop))
(setq prop (cddr prop)))
(setq command (symbol-function command)))))
@ -331,30 +334,28 @@ ITEM defines an item as in `easy-menu-define'."
(setq keyword (aref item count))
(setq arg (aref item (1+ count)))
(setq count (+ 2 count))
(cond
((or (eq keyword :included) (eq keyword :visible))
(setq visible (or arg ''nil)))
((eq keyword :key-sequence)
(setq cache arg cache-specified t))
((eq keyword :keys) (setq keys arg no-name nil))
((eq keyword :label) (setq label arg))
((eq keyword :active) (setq active (or arg ''nil)))
((eq keyword :help) (setq prop (cons :help (cons arg prop))))
((eq keyword :suffix) (setq suffix arg))
((eq keyword :style) (setq style arg))
((eq keyword :selected) (setq selected (or arg ''nil)))))
(case keyword
((:included :visible) (setq visible (or arg ''nil)))
(:key-sequence (setq cache arg cache-specified t))
(:keys (setq keys arg no-name nil))
(:label (setq label arg))
((:active :enable) (setq active (or arg ''nil)))
(:help (setq prop (cons :help (cons arg prop))))
(:suffix (setq suffix arg))
(:style (setq style arg))
(:selected (setq selected (or arg ''nil)))))
(if suffix
(setq label
(if (stringp suffix)
(if (stringp label) (concat label " " suffix)
(list 'concat label (concat " " suffix)))
`(concat ,label ,(concat " " suffix)))
(if (stringp label)
(list 'concat (concat label " ") suffix)
(list 'concat label " " suffix)))))
`(concat ,(concat label " ") ,suffix)
`(concat ,label " " ,suffix)))))
(cond
((eq style 'button)
(setq label (if (stringp label) (concat "[" label "]")
(list 'concat "[" label "]"))))
`(concat "[" ,label "]"))))
((and selected
(setq style (assq style easy-menu-button-prefix)))
(setq prop (cons :button
@ -674,5 +675,4 @@ In some cases we use that to select between the local and global maps."
(provide 'easymenu)
;; arch-tag: 2a04020d-90d2-476d-a7c6-71e072007a4a
;;; easymenu.el ends here

6
lisp/emacs-lisp/edebug.el
View file

@ -1,8 +1,6 @@
;;; edebug.el --- a source-level debugger for Emacs Lisp
;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1997,
;; 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
;; 2010 Free Software Foundation, Inc.
;; Copyright (C) 1988-1995, 1997, 1999-2011 Free Software Foundation, Inc.
;; Author: Daniel LaLiberte <liberte@holonexus.org>
;; Maintainer: FSF
@ -2131,8 +2129,6 @@ expressions; a `progn' form will be returned enclosing these forms."
(def-edebug-spec with-custom-print body)
(def-edebug-spec sregexq (&rest sexp))
(def-edebug-spec rx (&rest sexp))
;;; The debugger itself

3
lisp/emacs-lisp/eieio-base.el
View file

@ -1,6 +1,6 @@
;;; eieio-base.el --- Base classes for EIEIO.
;;; Copyright (C) 2000, 2001, 2002, 2004, 2005, 2007, 2008, 2009, 2010
;;; Copyright (C) 2000-2002, 2004-2005, 2007-2011
;;; Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@ -329,5 +329,4 @@ a set type."
(provide 'eieio-base)
;; arch-tag: 6260571e-9e8a-41a0-880f-a937b0c2ea8b
;;; eieio-base.el ends here

4
lisp/emacs-lisp/eieio-comp.el
View file

@ -1,7 +1,7 @@
;;; eieio-comp.el -- eieio routines to help with byte compilation
;; Copyright (C) 1995,1996, 1998, 1999, 2000, 2001, 2002, 2005, 2008,
;; 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1995-1996, 1998-2002, 2005, 2008-2011
;; Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 0.2

4
lisp/emacs-lisp/eieio-custom.el
View file

@ -1,7 +1,6 @@
;;; eieio-custom.el -- eieio object customization
;; Copyright (C) 1999, 2000, 2001, 2005, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Copyright (C) 1999-2001, 2005, 2007-2011 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 0.2
@ -461,5 +460,4 @@ Return the symbol for the group, or nil"
(provide 'eieio-custom)
;; arch-tag: bc122762-a771-48d5-891b-7835b16dd924
;;; eieio-custom.el ends here

3
lisp/emacs-lisp/eieio-datadebug.el
View file

@ -1,6 +1,6 @@
;;; eieio-datadebug.el --- EIEIO extensions to the data debugger.
;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: OO, lisp
@ -145,5 +145,4 @@ PREBUTTONTEXT is some text between PREFIX and the object button."
(provide 'eieio-datadebug)
;; arch-tag: 6c7c2890-7614-41b0-816b-c61f3f6a8130
;;; eieio-datadebug.el ends here

5
lisp/emacs-lisp/eieio-opt.el
View file

@ -1,7 +1,7 @@
;;; eieio-opt.el -- eieio optional functions (debug, printing, speedbar)
;; Copyright (C) 1996, 1998, 1999, 2000, 2001, 2002, 2003, 2005, 2008,
;; 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1996, 1998-2003, 2005, 2008-2011
;; Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 0.2
@ -693,5 +693,4 @@ INDENT is the current indentation level."
(provide 'eieio-opt)
;; arch-tag: 71eab5f5-462f-4fa1-8ed1-f5ca1bf9adb6
;;; eieio-opt.el ends here

4
lisp/emacs-lisp/eieio-speedbar.el
View file

@ -1,7 +1,6 @@
;;; eieio-speedbar.el -- Classes for managing speedbar displays.
;; Copyright (C) 1999, 2000, 2001, 2002, 2005, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Copyright (C) 1999-2002, 2005, 2007-2011 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 0.2
@ -422,5 +421,4 @@ to create a speedbar button."
(provide 'eieio-speedbar)
;; arch-tag: eaac1283-10b0-4419-a929-982b87e83234
;;; eieio-speedbar.el ends here

4
lisp/emacs-lisp/eieio.el
View file

@ -1,8 +1,7 @@
;;; eieio.el --- Enhanced Implementation of Emacs Interpreted Objects
;;; or maybe Eric's Implementation of Emacs Intrepreted Objects
;; Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1995-1996, 1998-2011 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 1.3
@ -2956,5 +2955,4 @@ Optional argument NOESCAPE is passed to `prin1-to-string' when appropriate."
(provide 'eieio)
;; arch-tag: c1aeab9c-2938-41a3-842b-1a38bd26e9f2
;;; eieio ends here

4
lisp/emacs-lisp/eldoc.el
View file

@ -1,7 +1,6 @@
;;; eldoc.el --- show function arglist or variable docstring in echo area
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
;; Author: Noah Friedman <friedman@splode.com>
;; Maintainer: friedman@splode.com
@ -540,5 +539,4 @@ The words \"&rest\", \"&optional\" are returned unchanged."
(provide 'eldoc)
;; arch-tag: c9a58f9d-2055-46c1-9b82-7248b71a8375
;;; eldoc.el ends here

3
lisp/emacs-lisp/elint.el
View file

@ -1,7 +1,6 @@
;;; elint.el --- Lint Emacs Lisp
;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
;; 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc.
;; Author: Peter Liljenberg <petli@lysator.liu.se>
;; Created: May 1997

5
lisp/emacs-lisp/elp.el
View file

@ -1,7 +1,7 @@
;;; elp.el --- Emacs Lisp Profiler
;; Copyright (C) 1994, 1995, 1997, 1998, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1994-1995, 1997-1998, 2001-2011
;; Free Software Foundation, Inc.
;; Author: Barry A. Warsaw
;; Maintainer: FSF
@ -660,5 +660,4 @@ displayed."
(provide 'elp)
;; arch-tag: c4eef311-9b3e-4bb2-8a54-3485d41b4eb1
;;; elp.el ends here

290
lisp/emacs-lisp/ert-x.el Normal file
View file

@ -0,0 +1,290 @@
;;; ert-x.el --- Staging area for experimental extensions to ERT
;; Copyright (C) 2008, 2010-2011 Free Software Foundation, Inc.
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
;; Author: Christian Ohler <ohler@gnu.org>
;; This file is part of GNU Emacs.
;; This program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see `http://www.gnu.org/licenses/'.
;;; Commentary:
;; This file includes some extra helper functions to use while writing
;; automated tests with ERT. These have been proposed as extensions
;; to ERT but are not mature yet and likely to change.
;;; Code:
(eval-when-compile
(require 'cl))
(require 'ert)
;;; Test buffers.
(defun ert--text-button (string &rest properties)
"Return a string containing STRING as a text button with PROPERTIES.
See `make-text-button'."
(with-temp-buffer
(insert string)
(apply #'make-text-button (point-min) (point-max) properties)
(buffer-string)))
(defun ert--format-test-buffer-name (base-name)
"Compute a test buffer name based on BASE-NAME.
Helper function for `ert--test-buffers'."
(format "*Test buffer (%s)%s*"
(or (and (ert-running-test)
(ert-test-name (ert-running-test)))
"<anonymous test>")
(if base-name
(format ": %s" base-name)
"")))
(defvar ert--test-buffers (make-hash-table :weakness t)
"Table of all test buffers. Keys are the buffer objects, values are t.
The main use of this table is for `ert-kill-all-test-buffers'.
Not all buffers in this table are necessarily live, but all live
test buffers are in this table.")
(define-button-type 'ert--test-buffer-button
'action #'ert--test-buffer-button-action
'help-echo "mouse-2, RET: Pop to test buffer")
(defun ert--test-buffer-button-action (button)
"Pop to the test buffer that BUTTON is associated with."
(pop-to-buffer (button-get button 'ert--test-buffer)))
(defun ert--call-with-test-buffer (ert--base-name ert--thunk)
"Helper function for `ert-with-test-buffer'.
Create a test buffer with a name based on ERT--BASE-NAME and run
ERT--THUNK with that buffer as current."
(let* ((ert--buffer (generate-new-buffer
(ert--format-test-buffer-name ert--base-name)))
(ert--button (ert--text-button (buffer-name ert--buffer)
:type 'ert--test-buffer-button
'ert--test-buffer ert--buffer)))
(puthash ert--buffer 't ert--test-buffers)
;; We don't use `unwind-protect' here since we want to kill the
;; buffer only on success.
(prog1 (with-current-buffer ert--buffer
(ert-info (ert--button :prefix "Buffer: ")
(funcall ert--thunk)))
(kill-buffer ert--buffer)
(remhash ert--buffer ert--test-buffers))))
(defmacro* ert-with-test-buffer ((&key ((:name name-form)))
&body body)
"Create a test buffer and run BODY in that buffer.
To be used in ERT tests. If BODY finishes successfully, the test
buffer is killed; if there is an error, the test buffer is kept
around on error for further inspection. Its name is derived from
the name of the test and the result of NAME-FORM."
(declare (debug ((form) body))
(indent 1))
`(ert--call-with-test-buffer ,name-form (lambda () ,@body)))
;; We use these `put' forms in addition to the (declare (indent)) in
;; the defmacro form since the `declare' alone does not lead to
;; correct indentation before the .el/.elc file is loaded.
;; Autoloading these `put' forms solves this.
;;;###autoload
(progn
;; TODO(ohler): Figure out what these mean and make sure they are correct.
(put 'ert-with-test-buffer 'lisp-indent-function 1))
;;;###autoload
(defun ert-kill-all-test-buffers ()
"Kill all test buffers that are still live."
(interactive)
(let ((count 0))
(maphash (lambda (buffer dummy)
(when (or (not (buffer-live-p buffer))
(kill-buffer buffer))
(incf count)))
ert--test-buffers)
(message "%s out of %s test buffers killed"
count (hash-table-count ert--test-buffers)))
;; It could be that some test buffers were actually kept alive
;; (e.g., due to `kill-buffer-query-functions'). I'm not sure what
;; to do about this. For now, let's just forget them.
(clrhash ert--test-buffers)
nil)
;;; Simulate commands.
(defun ert-simulate-command (command)
;; FIXME: add unread-events
"Simulate calling COMMAND the way the Emacs command loop would call it.
This effectively executes
\(apply (car COMMAND) (cdr COMMAND)\)
and returns the same value, but additionally runs hooks like
`pre-command-hook' and `post-command-hook', and sets variables
like `this-command' and `last-command'.
COMMAND should be a list where the car is the command symbol and
the rest are arguments to the command.
NOTE: Since the command is not called by `call-interactively'
test for `called-interactively' in the command will fail."
(assert (listp command) t)
(assert (commandp (car command)) t)
(assert (not unread-command-events) t)
(let (return-value)
;; For the order of things here see command_loop_1 in keyboard.c.
;;
;; The command loop will reset the command-related variables so
;; there is no reason to let-bind them. They are set here,
;; however, to be able to test several commands in a row and how
;; they affect each other.
(setq deactivate-mark nil
this-original-command (car command)
;; remap through active keymaps
this-command (or (command-remapping this-original-command)
this-original-command))
(run-hooks 'pre-command-hook)
(setq return-value (apply (car command) (cdr command)))
(run-hooks 'post-command-hook)
(when deferred-action-list
(run-hooks 'deferred-action-function))
(setq real-last-command (car command)
last-command this-command)
(when (boundp 'last-repeatable-command)
(setq last-repeatable-command real-last-command))
(when (and deactivate-mark transient-mark-mode) (deactivate-mark))
(assert (not unread-command-events) t)
return-value))
(defun ert-run-idle-timers ()
"Run all idle timers (from `timer-idle-list')."
(dolist (timer (copy-sequence timer-idle-list))
(timer-event-handler timer)))
;;; Miscellaneous utilities.
(defun ert-filter-string (s &rest regexps)
"Return a copy of S with all matches of REGEXPS removed.
Elements of REGEXPS may also be two-element lists \(REGEXP
SUBEXP\), where SUBEXP is the number of a subexpression in
REGEXP. In that case, only that subexpression will be removed
rather than the entire match."
;; Use a temporary buffer since replace-match copies strings, which
;; would lead to N^2 runtime.
(with-temp-buffer
(insert s)
(dolist (x regexps)
(destructuring-bind (regexp subexp) (if (listp x) x `(,x nil))
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(replace-match "" t t nil subexp))))
(buffer-string)))
(defun ert-propertized-string (&rest args)
"Return a string with properties as specified by ARGS.
ARGS is a list of strings and plists. The strings in ARGS are
concatenated to produce an output string. In the output string,
each string from ARGS will be have the preceding plist as its
property list, or no properties if there is no plist before it.
As a simple example,
\(ert-propertized-string \"foo \" '(face italic) \"bar\" \" baz\" nil \
\" quux\"\)
would return the string \"foo bar baz quux\" where the substring
\"bar baz\" has a `face' property with the value `italic'.
None of the ARGS are modified, but the return value may share
structure with the plists in ARGS."
(with-temp-buffer
(loop with current-plist = nil
for x in args do
(etypecase x
(string (let ((begin (point)))
(insert x)
(set-text-properties begin (point) current-plist)))
(list (unless (zerop (mod (length x) 2))
(error "Odd number of args in plist: %S" x))
(setq current-plist x))))
(buffer-string)))
(defun ert-call-with-buffer-renamed (buffer-name thunk)
"Protect the buffer named BUFFER-NAME from side-effects and run THUNK.
Renames the buffer BUFFER-NAME to a new temporary name, creates a
new buffer named BUFFER-NAME, executes THUNK, kills the new
buffer, and renames the original buffer back to BUFFER-NAME.
This is useful if THUNK has undesirable side-effects on an Emacs
buffer with a fixed name such as *Messages*."
(lexical-let ((new-buffer-name (generate-new-buffer-name
(format "%s orig buffer" buffer-name))))
(with-current-buffer (get-buffer-create buffer-name)
(rename-buffer new-buffer-name))
(unwind-protect
(progn
(get-buffer-create buffer-name)
(funcall thunk))
(when (get-buffer buffer-name)
(kill-buffer buffer-name))
(with-current-buffer new-buffer-name
(rename-buffer buffer-name)))))
(defmacro* ert-with-buffer-renamed ((buffer-name-form) &body body)
"Protect the buffer named BUFFER-NAME from side-effects and run BODY.
See `ert-call-with-buffer-renamed' for details."
(declare (indent 1))
`(ert-call-with-buffer-renamed ,buffer-name-form (lambda () ,@body)))
(defun ert-buffer-string-reindented (&optional buffer)
"Return the contents of BUFFER after reindentation.
BUFFER defaults to current buffer. Does not modify BUFFER."
(with-current-buffer (or buffer (current-buffer))
(let ((clone nil))
(unwind-protect
(progn
;; `clone-buffer' doesn't work if `buffer-file-name' is non-nil.
(let ((buffer-file-name nil))
(setq clone (clone-buffer)))
(with-current-buffer clone
(let ((inhibit-read-only t))
(indent-region (point-min) (point-max)))
(buffer-string)))
(when clone
(let ((kill-buffer-query-functions nil))
(kill-buffer clone)))))))
(provide 'ert-x)
;;; ert-x.el ends here

2544
lisp/emacs-lisp/ert.el Normal file
View file

File diff suppressed because it is too large Load diff

4
lisp/emacs-lisp/ewoc.el
View file

@ -1,7 +1,6 @@
;;; ewoc.el --- utility to maintain a view of a list of objects in a buffer
;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1991-2011 Free Software Foundation, Inc.
;; Author: Per Cederqvist <ceder@lysator.liu.se>
;; Inge Wallin <inge@lysator.liu.se>
@ -578,5 +577,4 @@ Return nil if the buffer has been deleted."
;; eval: (put 'ewoc--set-buffer-bind-dll-let* 'lisp-indent-hook 2)
;; End:
;; arch-tag: d78915b9-9a07-44bf-aac6-04a1fc1bd6d4
;;; ewoc.el ends here

4
lisp/emacs-lisp/find-func.el
View file

@ -1,7 +1,6 @@
;;; find-func.el --- find the definition of the Emacs Lisp function near point
;; Copyright (C) 1997, 1999, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1999, 2001-2011 Free Software Foundation, Inc.
;; Author: Jens Petersen <petersen@kurims.kyoto-u.ac.jp>
;; Maintainer: petersen@kurims.kyoto-u.ac.jp
@ -563,5 +562,4 @@ Set mark before moving, if the buffer already existed."
(provide 'find-func)
;; arch-tag: 43ecd81c-74dc-4d9a-8f63-a61e55670d64
;;; find-func.el ends here

4
lisp/emacs-lisp/find-gc.el
View file

@ -1,7 +1,6 @@
;;; find-gc.el --- detect functions that call the garbage collector
;; Copyright (C) 1992, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1992, 2001-2011 Free Software Foundation, Inc.
;; Maintainer: FSF
@ -159,5 +158,4 @@ Also store it in `find-gc-unsafe'."
(provide 'find-gc)
;; arch-tag: 4a26a538-a008-40d9-a1ef-23bb6dbecef4
;;; find-gc.el ends here

3
lisp/emacs-lisp/float-sup.el
View file

@ -1,7 +1,6 @@
;;; float-sup.el --- define some constants useful for floating point numbers.
;; Copyright (C) 1985, 1986, 1987, 2001, 2002, 2003, 2004, 2005, 2006,
;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1985-1987, 2001-2011 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal

4
lisp/emacs-lisp/generic.el
View file

@ -1,7 +1,6 @@
;;; generic.el --- defining simple major modes with comment and font-lock
;;
;; Copyright (C) 1997, 1999, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1999, 2001-2011 Free Software Foundation, Inc.
;;
;; Author: Peter Breton <pbreton@cs.umb.edu>
;; Created: Fri Sep 27 1996
@ -316,5 +315,4 @@ regular expression that can be used as an element of
(provide 'generic)
;; arch-tag: 239c1fc4-1303-48d9-9ac0-657d655669ea
;;; generic.el ends here

4
lisp/emacs-lisp/gulp.el
View file

@ -1,7 +1,6 @@
;;; gulp.el --- ask for updates for Lisp packages
;; Copyright (C) 1996, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1996, 2001-2011 Free Software Foundation, Inc.
;; Author: Sam Shteingold <shteingd@math.ucla.edu>
;; Maintainer: FSF
@ -175,5 +174,4 @@ That is a list of elements, each of the form (MAINTAINER PACKAGES...)."
(provide 'gulp)
;; arch-tag: 42750a11-460a-4efc-829f-342d075530e5
;;; gulp.el ends here

4
lisp/emacs-lisp/helper.el
View file

@ -1,7 +1,6 @@
;;; helper.el --- utility help package supporting help in electric modes
;; Copyright (C) 1985, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1985, 2001-2011 Free Software Foundation, Inc.
;; Author: K. Shane Hartman
;; Maintainer: FSF
@ -156,5 +155,4 @@
(provide 'helper)
;; arch-tag: a0984577-d3e9-4124-ae0d-c46fe740f6a9
;;; helper.el ends here

4
lisp/emacs-lisp/lisp-mnt.el
View file

@ -1,7 +1,6 @@
;;; lisp-mnt.el --- utility functions for Emacs Lisp maintainers
;; Copyright (C) 1992, 1994, 1997, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1992, 1994, 1997, 2000-2011 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Maintainer: FSF
@ -616,5 +615,4 @@ Prompts for bug subject TOPIC. Leaves you in a mail buffer."
(provide 'lisp-mnt)
;; arch-tag: fa3c5ab4-a37b-4e46-b7cf-b6d78b90e69e
;;; lisp-mnt.el ends here

3
lisp/emacs-lisp/lisp-mode.el
View file

@ -1,7 +1,6 @@
;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands
;; Copyright (C) 1985, 1986, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1985-1986, 1999-2011 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: lisp, languages

4
lisp/emacs-lisp/lisp.el
View file

@ -1,7 +1,6 @@
;;; lisp.el --- Lisp editing commands for Emacs
;; Copyright (C) 1985, 1986, 1994, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1985-1986, 1994, 2000-2011 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: lisp, languages
@ -690,5 +689,4 @@ considered."
(unless (eq predicate 'fboundp)
(lambda (str) (if (fboundp (intern-soft str)) " <f>"))))))))
;; arch-tag: aa7fa8a4-2e6f-4e9b-9cd9-fef06340e67e
;;; lisp.el ends here

3
lisp/emacs-lisp/macroexp.el
View file

@ -1,6 +1,6 @@
;;; macroexp.el --- Additional macro-expansion support
;;
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
;;
;; Author: Miles Bader <miles@gnu.org>
;; Keywords: lisp, compiler, macros
@ -182,5 +182,4 @@ definitions to shadow the loaded ones for use in file byte-compilation."
(provide 'macroexp)
;; arch-tag: af9b8c24-c196-43bc-91e1-a3570790fa5a
;;; macroexp.el ends here

4
lisp/emacs-lisp/map-ynp.el
View file

@ -1,7 +1,6 @@
;;; map-ynp.el --- general-purpose boolean question-asker
;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 2000, 2001, 2002, 2003,
;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1991-1995, 2000-2011 Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
;; Maintainer: FSF
@ -275,5 +274,4 @@ the current %s and exit."
;; Return the number of actions that were taken.
actions))
;; arch-tag: 1d0a3201-a151-4c10-b231-4da47c9e6dc3
;;; map-ynp.el ends here

2
lisp/emacs-lisp/package-x.el
View file

@ -1,6 +1,6 @@
;;; package-x.el --- Package extras
;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
;; Author: Tom Tromey <tromey@redhat.com>
;; Created: 10 Mar 2007

20
lisp/emacs-lisp/package.el
View file

@ -1,6 +1,6 @@
;;; package.el --- Simple package system for Emacs
;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
;; Author: Tom Tromey <tromey@redhat.com>
;; Created: 10 Mar 2007
@ -1663,15 +1663,15 @@ A value of nil means to display all packages.")
Optional PACKAGES is a list of names of packages (symbols) to
list; the default is to display everything in `package-alist'."
(require 'finder-inf nil t)
(with-current-buffer (get-buffer-create "*Packages*")
(package-menu-mode)
(set (make-local-variable 'package-menu-package-list) packages)
(set (make-local-variable 'package-menu-sort-key) nil)
(package--generate-package-list)
;; It's okay to use pop-to-buffer here. The package menu buffer
;; has keybindings, and the user just typed `M-x list-packages',
;; suggesting that they might want to use them.
(pop-to-buffer (current-buffer))))
(let ((buf (get-buffer-create "*Packages*")))
(with-current-buffer buf
(package-menu-mode)
(set (make-local-variable 'package-menu-package-list) packages)
(set (make-local-variable 'package-menu-sort-key) nil)
(package--generate-package-list))
;; The package menu buffer has keybindings. If the user types
;; `M-x list-packages', that suggests it should become current.
(switch-to-buffer buf)))
;;;###autoload
(defun list-packages ()

2
lisp/emacs-lisp/pcase.el
View file

@ -1,6 +1,6 @@
;;; pcase.el --- ML-style pattern-matching macro for Elisp
;; Copyright (C) 2010 Free Software Foundation, Inc.
;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords:

4
lisp/emacs-lisp/pp.el
View file

@ -1,7 +1,6 @@
;;; pp.el --- pretty printer for Emacs Lisp
;; Copyright (C) 1989, 1993, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1989, 1993, 2001-2011 Free Software Foundation, Inc.
;; Author: Randal Schwartz <merlyn@stonehenge.com>
;; Keywords: lisp
@ -202,5 +201,4 @@ Ignores leading comment characters."
(provide 'pp) ; so (require 'pp) works
;; arch-tag: b0f7c65b-02c7-42bb-9ee3-508a59b8fbb9
;;; pp.el ends here

27
lisp/emacs-lisp/re-builder.el
View file

@ -1,7 +1,6 @@
;;; re-builder.el --- building Regexps with visual feedback
;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
;; Author: Detlev Zundel <dzu@gnu.org>
;; Keywords: matching, lisp, tools
@ -60,8 +59,8 @@
;; even the auto updates go all the way. Forcing an update overrides
;; this limit allowing an easy way to see all matches.
;; Currently `re-builder' understands five different forms of input,
;; namely `read', `string', `rx', and `sregex' syntax. Read
;; Currently `re-builder' understands three different forms of input,
;; namely `read', `string', and `rx' syntax. Read
;; syntax and string syntax are both delimited by `"'s and behave
;; according to their name. With the `string' syntax there's no need
;; to escape the backslashes and double quotes simplifying the editing
@ -75,7 +74,7 @@
;; When editing a symbolic regular expression, only the first
;; expression in the RE Builder buffer is considered, which helps
;; limiting the extent of the expression like the `"'s do for the text
;; modes. For the `sregex' syntax the function `sregex' is applied to
;; modes. For the `rx' syntax the function `rx-to-string' is applied to
;; the evaluated expression read. So you can use quoted arguments
;; with something like '("findme") or you can construct arguments to
;; your hearts delight with a valid ELisp expression. (The compiled
@ -126,11 +125,10 @@
(defcustom reb-re-syntax 'read
"Syntax for the REs in the RE Builder.
Can either be `read', `string', `sregex', or `rx'."
Can either be `read', `string', or `rx'."
:group 're-builder
:type '(choice (const :tag "Read syntax" read)
(const :tag "String syntax" string)
(const :tag "`sregex' syntax" sregex)
(const :tag "`rx' syntax" rx)))
(defcustom reb-auto-match-limit 200
@ -244,7 +242,9 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
:help "Quit the RE Builder mode"))
(define-key menu-map [rt]
'(menu-item "Case sensitive" reb-toggle-case
:button (:toggle . case-fold-search)
:button (:toggle . (with-current-buffer
reb-target-buffer
(null case-fold-search)))
:help "Toggle case sensitivity of searches for RE Builder target buffer"))
(define-key menu-map [rb]
'(menu-item "Change target buffer..." reb-change-target-buffer
@ -279,10 +279,8 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
emacs-lisp-mode "RE Builder Lisp"
"Major mode for interactively building symbolic Regular Expressions."
;; Pull in packages as needed
(cond ((eq reb-re-syntax 'sregex) ; sregex is not autoloaded
(require 'sregex)) ; right now..
((eq reb-re-syntax 'rx) ; rx-to-string is autoloaded
(require 'rx))) ; require rx anyway
(cond ((memq reb-re-syntax '(sregex rx)) ; rx-to-string is autoloaded
(require 'rx))) ; require rx anyway
(reb-mode-common))
;; Use the same "\C-c" keymap as `reb-mode' and use font-locking from
@ -612,9 +610,7 @@ optional fourth argument FORCE is non-nil."
(defun reb-cook-regexp (re)
"Return RE after processing it according to `reb-re-syntax'."
(cond ((eq reb-re-syntax 'sregex)
(apply 'sregex (eval (car (read-from-string re)))))
((eq reb-re-syntax 'rx)
(cond ((memq reb-re-syntax '(sregex rx))
(rx-to-string (eval (car (read-from-string re)))))
(t re)))
@ -718,5 +714,4 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions."
(provide 're-builder)
;; arch-tag: 5c5515ac-4085-4524-a421-033f44f032e7
;;; re-builder.el ends here

4
lisp/emacs-lisp/regexp-opt.el
View file

@ -1,7 +1,6 @@
;;; regexp-opt.el --- generate efficient regexps to match strings
;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1994-2011 Free Software Foundation, Inc.
;; Author: Simon Marshall <simon@gnu.org>
;; Maintainer: FSF
@ -293,5 +292,4 @@ Merges keywords to avoid backtracking in Emacs' regexp matcher."
(provide 'regexp-opt)
;; arch-tag: 6c5a66f4-29af-4fd6-8c3b-4b554d5b4370
;;; regexp-opt.el ends here

4
lisp/emacs-lisp/regi.el
View file

@ -1,7 +1,6 @@
;;; regi.el --- REGular expression Interpreting engine
;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc.
;; Author: 1993 Barry A. Warsaw, Century Computing, Inc. <bwarsaw@cen.com>
;; Maintainer: bwarsaw@cen.com
@ -254,5 +253,4 @@ useful information:
(provide 'regi)
;; arch-tag: 804b4e45-4109-4f76-9a88-21887b881747
;;; regi.el ends here

4
lisp/emacs-lisp/ring.el
View file

@ -1,7 +1,6 @@
;;; ring.el --- handle rings of items
;; Copyright (C) 1992, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1992, 2001-2011 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: extensions
@ -236,5 +235,4 @@ If SEQ is already a ring, return it."
(provide 'ring)
;; arch-tag: e707682b-ed69-47c9-b20f-cf2c68cc92d2
;;; ring.el ends here

67
lisp/emacs-lisp/rx.el
View file

@ -1,7 +1,6 @@
;;; rx.el --- sexp notation for regular expressions
;; Copyright (C) 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
;; Author: Gerd Moellmann <gerd@gnu.org>
;; Maintainer: FSF
@ -120,19 +119,17 @@
(nonl . not-newline) ; SRE
(anything . (rx-anything 0 nil))
(any . (rx-any 1 nil rx-check-any)) ; inconsistent with SRE
(any . ".") ; sregex
(in . any)
(char . any) ; sregex
(not-char . (rx-not-char 1 nil rx-check-any)) ; sregex
(not . (rx-not 1 1 rx-check-not))
;; Partially consistent with sregex, whose `repeat' is like our
;; `**'. (`repeat' with optional max arg and multiple sexp forms
;; is ambiguous.)
(repeat . (rx-repeat 2 3))
(repeat . (rx-repeat 2 nil))
(= . (rx-= 2 nil)) ; SRE
(>= . (rx->= 2 nil)) ; SRE
(** . (rx-** 2 nil)) ; SRE
(submatch . (rx-submatch 1 nil)) ; SRE
(group . submatch)
(group . submatch) ; sregex
(zero-or-more . (rx-kleene 1 nil))
(one-or-more . (rx-kleene 1 nil))
(zero-or-one . (rx-kleene 1 nil))
@ -175,6 +172,7 @@
(category . (rx-category 1 1 rx-check-category))
(eval . (rx-eval 1 1))
(regexp . (rx-regexp 1 1 stringp))
(regex . regexp) ; sregex
(digit . "[[:digit:]]")
(numeric . digit) ; SRE
(num . digit) ; SRE
@ -295,15 +293,27 @@ regular expression strings.")
`zero-or-more', and `one-or-more'. Dynamically bound.")
(defun rx-info (op)
(defun rx-info (op head)
"Return parsing/code generation info for OP.
If OP is the space character ASCII 32, return info for the symbol `?'.
If OP is the character `?', return info for the symbol `??'.
See also `rx-constituents'."
See also `rx-constituents'.
If HEAD is non-nil, then OP is the head of a sexp, otherwise it's
a standalone symbol."
(cond ((eq op ? ) (setq op '\?))
((eq op ??) (setq op '\??)))
(while (and (not (null op)) (symbolp op))
(setq op (cdr (assq op rx-constituents))))
(let (old-op)
(while (and (not (null op)) (symbolp op))
(setq old-op op)
(setq op (cdr (assq op rx-constituents)))
(when (if head (stringp op) (consp op))
;; We found something but of the wrong kind. Let's look for an
;; alternate definition for the other case.
(let ((new-op
(cdr (assq old-op (cdr (memq (assq old-op rx-constituents)
rx-constituents))))))
(if (and new-op (not (if head (stringp new-op) (consp new-op))))
(setq op new-op))))))
op)
@ -311,7 +321,7 @@ See also `rx-constituents'."
"Check FORM according to its car's parsing info."
(unless (listp form)
(error "rx `%s' needs argument(s)" form))
(let* ((rx (rx-info (car form)))
(let* ((rx (rx-info (car form) 'head))
(nargs (1- (length form)))
(min-args (nth 1 rx))
(max-args (nth 2 rx))
@ -401,7 +411,7 @@ Only both edges of each range is checked."
(setcdr m (1- char)))))
ranges))
(defun rx-any-condense-range (args)
"Condense by side effect ARGS as range for Rx `any'."
(let (str
@ -564,7 +574,7 @@ ARG is optional."
(condition-case nil
(rx-form arg)
(error ""))))
(eq arg 'word-boundary)
(eq arg 'word-boundary)
(and (consp arg)
(memq (car arg) '(not any in syntax category))))
(error "rx `not' syntax error: %s" arg))
@ -643,14 +653,17 @@ If SKIP is non-nil, allow that number of items after the head, i.e.
(defun rx-** (form)
"Parse and produce code from FORM `(** N M ...)'."
(rx-check form)
(setq form (cons 'repeat (cdr (rx-trans-forms form 2))))
(rx-form form '*))
(rx-form (cons 'repeat (cdr (rx-trans-forms form 2))) '*))
(defun rx-repeat (form)
"Parse and produce code from FORM.
FORM is either `(repeat N FORM1)' or `(repeat N M FORM1)'."
FORM is either `(repeat N FORM1)' or `(repeat N M FORMS...)'."
(rx-check form)
(if (> (length form) 4)
(setq form (rx-trans-forms form 2)))
(if (null (nth 2 form))
(setq form (cons (nth 0 form) (cons (nth 1 form) (nthcdr 3 form)))))
(cond ((= (length form) 3)
(unless (and (integerp (nth 1 form))
(> (nth 1 form) 0))
@ -749,15 +762,18 @@ of all atomic regexps."
"Parse and produce code from FORM, which is `(syntax SYMBOL)'."
(rx-check form)
(let* ((sym (cadr form))
(syntax (assq sym rx-syntax)))
(syntax (cdr (assq sym rx-syntax))))
(unless syntax
;; Try sregex compatibility.
(let ((name (symbol-name sym)))
(if (= 1 (length name))
(setq syntax (rassq (aref name 0) rx-syntax))))
(cond
((characterp sym) (setq syntax sym))
((symbolp sym)
(let ((name (symbol-name sym)))
(if (= 1 (length name))
(setq syntax (aref name 0))))))
(unless syntax
(error "Unknown rx syntax `%s'" (cadr form))))
(format "\\s%c" (cdr syntax))))
(error "Unknown rx syntax `%s'" sym)))
(format "\\s%c" syntax)))
(defun rx-check-category (form)
@ -811,7 +827,7 @@ shy groups around the result and some more in other functions."
(cond ((integerp form)
(regexp-quote (char-to-string form)))
((symbolp form)
(let ((info (rx-info form)))
(let ((info (rx-info form nil)))
(cond ((stringp info)
info)
((null info)
@ -819,7 +835,7 @@ shy groups around the result and some more in other functions."
(t
(funcall (nth 0 info) form)))))
((consp form)
(let ((info (rx-info (car form))))
(let ((info (rx-info (car form) 'head)))
(unless (consp info)
(error "Unknown rx form `%s'" (car form)))
(funcall (nth 0 info) form)))
@ -1144,5 +1160,4 @@ enclosed in `(and ...)'.
(provide 'rx)
;; arch-tag: 12d01a63-0008-42bb-ab8c-1c7d63be370b
;;; rx.el ends here

3
lisp/emacs-lisp/shadow.el
View file

@ -1,7 +1,6 @@
;;; shadow.el --- locate Emacs Lisp file shadowings
;; Copyright (C) 1995, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
;; 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1995, 2001-2011 Free Software Foundation, Inc.
;; Author: Terry Jones <terry@santafe.edu>
;; Keywords: lisp

2
lisp/emacs-lisp/smie.el
View file

@ -1,6 +1,6 @@
;;; smie.el --- Simple Minded Indentation Engine
;; Copyright (C) 2010 Free Software Foundation, Inc.
;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: languages, lisp, internal, parsing, indentation

608
lisp/emacs-lisp/sregex.el
View file

@ -1,608 +0,0 @@
;;; sregex.el --- symbolic regular expressions
;; Copyright (C) 1997, 1998, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Bob Glickstein <bobg+sregex@zanshin.com>
;; Maintainer: Bob Glickstein <bobg+sregex@zanshin.com>
;; Keywords: extensions
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This package allows you to write regular expressions using a
;; totally new, Lisp-like syntax.
;; A "symbolic regular expression" (sregex for short) is a Lisp form
;; that, when evaluated, produces the string form of the specified
;; regular expression. Here's a simple example:
;; (sregexq (or "Bob" "Robert")) => "Bob\\|Robert"
;; As you can see, an sregex is specified by placing one or more
;; special clauses in a call to `sregexq'. The clause in this case is
;; the `or' of two strings (not to be confused with the Lisp function
;; `or'). The list of allowable clauses appears below.
;; With sregex, it is never necessary to "escape" magic characters
;; that are meant to be taken literally; that happens automatically.
;; For example:
;; (sregexq "M*A*S*H") => "M\\*A\\*S\\*H"
;; It is also unnecessary to "group" parts of the expression together
;; to overcome operator precedence; that also happens automatically.
;; For example:
;; (sregexq (opt (or "Bob" "Robert"))) => "\\(?:Bob\\|Robert\\)?"
;; It *is* possible to group parts of the expression in order to refer
;; to them with numbered backreferences:
;; (sregexq (group (or "Go" "Run"))
;; ", Spot, "
;; (backref 1)) => "\\(Go\\|Run\\), Spot, \\1"
;; `sregexq' is a macro. Each time it is used, it constructs a simple
;; Lisp expression that then invokes a moderately complex engine to
;; interpret the sregex and render the string form. Because of this,
;; I don't recommend sprinkling calls to `sregexq' throughout your
;; code, the way one normally does with string regexes (which are
;; cheap to evaluate). Instead, it's wiser to precompute the regexes
;; you need wherever possible instead of repeatedly constructing the
;; same ones over and over. Example:
;; (let ((field-regex (sregexq (opt "resent-")
;; (or "to" "cc" "bcc"))))
;; ...
;; (while ...
;; ...
;; (re-search-forward field-regex ...)
;; ...))
;; The arguments to `sregexq' are automatically quoted, but the
;; flipside of this is that it is not straightforward to include
;; computed (i.e., non-constant) values in `sregexq' expressions. So
;; `sregex' is a function that is like `sregexq' but which does not
;; automatically quote its values. Literal sregex clauses must be
;; explicitly quoted like so:
;; (sregex '(or "Bob" "Robert")) => "Bob\\|Robert"
;; but computed clauses can be included easily, allowing for the reuse
;; of common clauses:
;; (let ((dotstar '(0+ any))
;; (whitespace '(1+ (syntax ?-)))
;; (digits '(1+ (char (?0 . ?9)))))
;; (sregex 'bol dotstar ":" whitespace digits)) => "^.*:\\s-+[0-9]+"
;; To use this package in a Lisp program, simply (require 'sregex).
;; Here are the clauses allowed in an `sregex' or `sregexq'
;; expression:
;; - a string
;; This stands for the literal string. If it contains
;; metacharacters, they will be escaped in the resulting regex
;; (using `regexp-quote').
;; - the symbol `any'
;; This stands for ".", a regex matching any character except
;; newline.
;; - the symbol `bol'
;; Stands for "^", matching the empty string at the beginning of a line
;; - the symbol `eol'
;; Stands for "$", matching the empty string at the end of a line
;; - (group CLAUSE ...)
;; Groups the given CLAUSEs using "\\(" and "\\)".
;; - (sequence CLAUSE ...)
;; Groups the given CLAUSEs; may or may not use "\\(?:" and "\\)".
;; Clauses grouped by `sequence' do not count for purposes of
;; numbering backreferences. Use `sequence' in situations like
;; this:
;; (sregexq (or "dog" "cat"
;; (sequence (opt "sea ") "monkey")))
;; => "dog\\|cat\\|\\(?:sea \\)?monkey"
;; where a single `or' alternate needs to contain multiple
;; subclauses.
;; - (backref N)
;; Matches the same string previously matched by the Nth "group" in
;; the same sregex. N is a positive integer.
;; - (or CLAUSE ...)
;; Matches any one of the CLAUSEs by separating them with "\\|".
;; - (0+ CLAUSE ...)
;; Concatenates the given CLAUSEs and matches zero or more
;; occurrences by appending "*".
;; - (1+ CLAUSE ...)
;; Concatenates the given CLAUSEs and matches one or more
;; occurrences by appending "+".
;; - (opt CLAUSE ...)
;; Concatenates the given CLAUSEs and matches zero or one occurrence
;; by appending "?".
;; - (repeat MIN MAX CLAUSE ...)
;; Concatenates the given CLAUSEs and constructs a regex matching at
;; least MIN occurrences and at most MAX occurrences. MIN must be a
;; non-negative integer. MAX must be a non-negative integer greater
;; than or equal to MIN; or MAX can be nil to mean "infinity."
;; - (char CHAR-CLAUSE ...)
;; Creates a "character class" matching one character from the given
;; set. See below for how to construct a CHAR-CLAUSE.
;; - (not-char CHAR-CLAUSE ...)
;; Creates a "character class" matching any one character not in the
;; given set. See below for how to construct a CHAR-CLAUSE.
;; - the symbol `bot'
;; Stands for "\\`", matching the empty string at the beginning of
;; text (beginning of a string or of a buffer).
;; - the symbol `eot'
;; Stands for "\\'", matching the empty string at the end of text.
;; - the symbol `point'
;; Stands for "\\=", matching the empty string at point.
;; - the symbol `word-boundary'
;; Stands for "\\b", matching the empty string at the beginning or
;; end of a word.
;; - the symbol `not-word-boundary'
;; Stands for "\\B", matching the empty string not at the beginning
;; or end of a word.
;; - the symbol `bow'
;; Stands for "\\<", matching the empty string at the beginning of a
;; word.
;; - the symbol `eow'
;; Stands for "\\>", matching the empty string at the end of a word.
;; - the symbol `wordchar'
;; Stands for the regex "\\w", matching a word-constituent character
;; (as determined by the current syntax table)
;; - the symbol `not-wordchar'
;; Stands for the regex "\\W", matching a non-word-constituent
;; character.
;; - (syntax CODE)
;; Stands for the regex "\\sCODE", where CODE is a syntax table code
;; (a single character). Matches any character with the requested
;; syntax.
;; - (not-syntax CODE)
;; Stands for the regex "\\SCODE", where CODE is a syntax table code
;; (a single character). Matches any character without the
;; requested syntax.
;; - (regex REGEX)
;; This is a "trapdoor" for including ordinary regular expression
;; strings in the result. Some regular expressions are clearer when
;; written the old way: "[a-z]" vs. (sregexq (char (?a . ?z))), for
;; instance. However, see the note under "Bugs," below.
;; Each CHAR-CLAUSE that is passed to (char ...) and (not-char ...)
;; has one of the following forms:
;; - a character
;; Adds that character to the set.
;; - a string
;; Adds all the characters in the string to the set.
;; - A pair (MIN . MAX)
;; Where MIN and MAX are characters, adds the range of characters
;; from MIN through MAX to the set.
;;; To do:
;; An earlier version of this package could optionally translate the
;; symbolic regex into other languages' syntaxes, e.g. Perl. For
;; instance, with Perl syntax selected, (sregexq (or "ab" "cd")) would
;; yield "ab|cd" instead of "ab\\|cd". It might be useful to restore
;; such a facility.
;; - handle multibyte chars in sregex--char-aux
;; - add support for character classes ([:blank:], ...)
;; - add support for non-greedy operators *? and +?
;; - bug: (sregexq (opt (opt ?a))) returns "a??" which is a non-greedy "a?"
;;; Bugs:
;;; Code:
(eval-when-compile (require 'cl))
;; Compatibility code for when we didn't have shy-groups
(defvar sregex--current-sregex nil)
(defun sregex-info () nil)
(defmacro sregex-save-match-data (&rest forms) (cons 'save-match-data forms))
(defun sregex-replace-match (r &optional f l str subexp x)
(replace-match r f l str subexp))
(defun sregex-match-string (c &optional i x) (match-string c i))
(defun sregex-match-string-no-properties (count &optional in-string sregex)
(match-string-no-properties count in-string))
(defun sregex-match-beginning (count &optional sregex) (match-beginning count))
(defun sregex-match-end (count &optional sregex) (match-end count))
(defun sregex-match-data (&optional sregex) (match-data))
(defun sregex-backref-num (n &optional sregex) n)
(defun sregex (&rest exps)
"Symbolic regular expression interpreter.
This is exactly like `sregexq' (q.v.) except that it evaluates all its
arguments, so literal sregex clauses must be quoted. For example:
(sregex '(or \"Bob\" \"Robert\")) => \"Bob\\\\|Robert\"
An argument-evaluating sregex interpreter lets you reuse sregex
subexpressions:
(let ((dotstar '(0+ any))
(whitespace '(1+ (syntax ?-)))
(digits '(1+ (char (?0 . ?9)))))
(sregex 'bol dotstar \":\" whitespace digits)) => \"^.*:\\\\s-+[0-9]+\""
(sregex--sequence exps nil))
(defmacro sregexq (&rest exps)
"Symbolic regular expression interpreter.
This macro allows you to specify a regular expression (regexp) in
symbolic form, and converts it into the string form required by Emacs's
regex functions such as `re-search-forward' and `looking-at'. Here is
a simple example:
(sregexq (or \"Bob\" \"Robert\")) => \"Bob\\\\|Robert\"
As you can see, an sregex is specified by placing one or more special
clauses in a call to `sregexq'. The clause in this case is the `or'
of two strings (not to be confused with the Lisp function `or'). The
list of allowable clauses appears below.
With `sregex', it is never necessary to \"escape\" magic characters
that are meant to be taken literally; that happens automatically.
For example:
(sregexq \"M*A*S*H\") => \"M\\\\*A\\\\*S\\\\*H\"
It is also unnecessary to \"group\" parts of the expression together
to overcome operator precedence; that also happens automatically.
For example:
(sregexq (opt (or \"Bob\" \"Robert\"))) => \"\\\\(Bob\\\\|Robert\\\\)?\"
It *is* possible to group parts of the expression in order to refer
to them with numbered backreferences:
(sregexq (group (or \"Go\" \"Run\"))
\", Spot, \"
(backref 1)) => \"\\\\(Go\\\\|Run\\\\), Spot, \\\\1\"
If `sregexq' needs to introduce its own grouping parentheses, it will
automatically renumber your backreferences:
(sregexq (opt \"resent-\")
(group (or \"to\" \"cc\" \"bcc\"))
\": \"
(backref 1)) => \"\\\\(resent-\\\\)?\\\\(to\\\\|cc\\\\|bcc\\\\): \\\\2\"
`sregexq' is a macro. Each time it is used, it constructs a simple
Lisp expression that then invokes a moderately complex engine to
interpret the sregex and render the string form. Because of this, I
don't recommend sprinkling calls to `sregexq' throughout your code,
the way one normally does with string regexes (which are cheap to
evaluate). Instead, it's wiser to precompute the regexes you need
wherever possible instead of repeatedly constructing the same ones
over and over. Example:
(let ((field-regex (sregexq (opt \"resent-\")
(or \"to\" \"cc\" \"bcc\"))))
...
(while ...
...
(re-search-forward field-regex ...)
...))
The arguments to `sregexq' are automatically quoted, but the
flipside of this is that it is not straightforward to include
computed (i.e., non-constant) values in `sregexq' expressions. So
`sregex' is a function that is like `sregexq' but which does not
automatically quote its values. Literal sregex clauses must be
explicitly quoted like so:
(sregex '(or \"Bob\" \"Robert\")) => \"Bob\\\\|Robert\"
but computed clauses can be included easily, allowing for the reuse
of common clauses:
(let ((dotstar '(0+ any))
(whitespace '(1+ (syntax ?-)))
(digits '(1+ (char (?0 . ?9)))))
(sregex 'bol dotstar \":\" whitespace digits)) => \"^.*:\\\\s-+[0-9]+\"
Here are the clauses allowed in an `sregex' or `sregexq' expression:
- a string
This stands for the literal string. If it contains
metacharacters, they will be escaped in the resulting regex
(using `regexp-quote').
- the symbol `any'
This stands for \".\", a regex matching any character except
newline.
- the symbol `bol'
Stands for \"^\", matching the empty string at the beginning of a line
- the symbol `eol'
Stands for \"$\", matching the empty string at the end of a line
- (group CLAUSE ...)
Groups the given CLAUSEs using \"\\\\(\" and \"\\\\)\".
- (sequence CLAUSE ...)
Groups the given CLAUSEs; may or may not use \"\\\\(\" and \"\\\\)\".
Clauses grouped by `sequence' do not count for purposes of
numbering backreferences. Use `sequence' in situations like
this:
(sregexq (or \"dog\" \"cat\"
(sequence (opt \"sea \") \"monkey\")))
=> \"dog\\\\|cat\\\\|\\\\(?:sea \\\\)?monkey\"
where a single `or' alternate needs to contain multiple
subclauses.
- (backref N)
Matches the same string previously matched by the Nth \"group\" in
the same sregex. N is a positive integer.
- (or CLAUSE ...)
Matches any one of the CLAUSEs by separating them with \"\\\\|\".
- (0+ CLAUSE ...)
Concatenates the given CLAUSEs and matches zero or more
occurrences by appending \"*\".
- (1+ CLAUSE ...)
Concatenates the given CLAUSEs and matches one or more
occurrences by appending \"+\".
- (opt CLAUSE ...)
Concatenates the given CLAUSEs and matches zero or one occurrence
by appending \"?\".
- (repeat MIN MAX CLAUSE ...)
Concatenates the given CLAUSEs and constructs a regex matching at
least MIN occurrences and at most MAX occurrences. MIN must be a
non-negative integer. MAX must be a non-negative integer greater
than or equal to MIN; or MAX can be nil to mean \"infinity.\"
- (char CHAR-CLAUSE ...)
Creates a \"character class\" matching one character from the given
set. See below for how to construct a CHAR-CLAUSE.
- (not-char CHAR-CLAUSE ...)
Creates a \"character class\" matching any one character not in the
given set. See below for how to construct a CHAR-CLAUSE.
- the symbol `bot'
Stands for \"\\\\`\", matching the empty string at the beginning of
text (beginning of a string or of a buffer).
- the symbol `eot'
Stands for \"\\\\'\", matching the empty string at the end of text.
- the symbol `point'
Stands for \"\\\\=\\=\", matching the empty string at point.
- the symbol `word-boundary'
Stands for \"\\\\b\", matching the empty string at the beginning or
end of a word.
- the symbol `not-word-boundary'
Stands for \"\\\\B\", matching the empty string not at the beginning
or end of a word.
- the symbol `bow'
Stands for \"\\\\=\\<\", matching the empty string at the beginning of a
word.
- the symbol `eow'
Stands for \"\\\\=\\>\", matching the empty string at the end of a word.
- the symbol `wordchar'
Stands for the regex \"\\\\w\", matching a word-constituent character
(as determined by the current syntax table)
- the symbol `not-wordchar'
Stands for the regex \"\\\\W\", matching a non-word-constituent
character.
- (syntax CODE)
Stands for the regex \"\\\\sCODE\", where CODE is a syntax table code
(a single character). Matches any character with the requested
syntax.
- (not-syntax CODE)
Stands for the regex \"\\\\SCODE\", where CODE is a syntax table code
(a single character). Matches any character without the
requested syntax.
- (regex REGEX)
This is a \"trapdoor\" for including ordinary regular expression
strings in the result. Some regular expressions are clearer when
written the old way: \"[a-z]\" vs. (sregexq (char (?a . ?z))), for
instance.
Each CHAR-CLAUSE that is passed to (char ...) and (not-char ...)
has one of the following forms:
- a character
Adds that character to the set.
- a string
Adds all the characters in the string to the set.
- A pair (MIN . MAX)
Where MIN and MAX are characters, adds the range of characters
from MIN through MAX to the set."
`(apply 'sregex ',exps))
(defun sregex--engine (exp combine)
(cond
((stringp exp)
(if (and combine
(eq combine 'suffix)
(/= (length exp) 1))
(concat "\\(?:" (regexp-quote exp) "\\)")
(regexp-quote exp)))
((symbolp exp)
(ecase exp
(any ".")
(bol "^")
(eol "$")
(wordchar "\\w")
(not-wordchar "\\W")
(bot "\\`")
(eot "\\'")
(point "\\=")
(word-boundary "\\b")
(not-word-boundary "\\B")
(bow "\\<")
(eow "\\>")))
((consp exp)
(funcall (intern (concat "sregex--"
(symbol-name (car exp))))
(cdr exp)
combine))
(t (error "Invalid expression: %s" exp))))
(defun sregex--sequence (exps combine)
(if (= (length exps) 1) (sregex--engine (car exps) combine)
(let ((re (mapconcat
(lambda (e) (sregex--engine e 'concat))
exps "")))
(if (eq combine 'suffix)
(concat "\\(?:" re "\\)")
re))))
(defun sregex--or (exps combine)
(if (= (length exps) 1) (sregex--engine (car exps) combine)
(let ((re (mapconcat
(lambda (e) (sregex--engine e 'or))
exps "\\|")))
(if (not (eq combine 'or))
(concat "\\(?:" re "\\)")
re))))
(defun sregex--group (exps combine) (concat "\\(" (sregex--sequence exps nil) "\\)"))
(defun sregex--backref (exps combine) (concat "\\" (int-to-string (car exps))))
(defun sregex--opt (exps combine) (concat (sregex--sequence exps 'suffix) "?"))
(defun sregex--0+ (exps combine) (concat (sregex--sequence exps 'suffix) "*"))
(defun sregex--1+ (exps combine) (concat (sregex--sequence exps 'suffix) "+"))
(defun sregex--char (exps combine) (sregex--char-aux nil exps))
(defun sregex--not-char (exps combine) (sregex--char-aux t exps))
(defun sregex--syntax (exps combine) (format "\\s%c" (car exps)))
(defun sregex--not-syntax (exps combine) (format "\\S%c" (car exps)))
(defun sregex--regex (exps combine)
(if combine (concat "\\(?:" (car exps) "\\)") (car exps)))
(defun sregex--repeat (exps combine)
(let* ((min (or (pop exps) 0))
(minstr (number-to-string min))
(max (pop exps)))
(concat (sregex--sequence exps 'suffix)
(concat "\\{" minstr ","
(when max (number-to-string max)) "\\}"))))
(defun sregex--char-range (start end)
(let ((startc (char-to-string start))
(endc (char-to-string end)))
(cond
((> end (+ start 2)) (concat startc "-" endc))
((> end (+ start 1)) (concat startc (char-to-string (1+ start)) endc))
((> end start) (concat startc endc))
(t startc))))
(defun sregex--char-aux (complement args)
;; regex-opt does the same, we should join effort.
(let ((chars (make-bool-vector 256 nil))) ; Yeah, right!
(dolist (arg args)
(cond ((integerp arg) (aset chars arg t))
((stringp arg) (mapc (lambda (c) (aset chars c t)) arg))
((consp arg)
(let ((start (car arg))
(end (cdr arg)))
(when (> start end)
(let ((tmp start)) (setq start end) (setq end tmp)))
;; now start <= end
(let ((i start))
(while (<= i end)
(aset chars i t)
(setq i (1+ i))))))))
;; now chars is a map of the characters in the class
(let ((caret (aref chars ?^))
(dash (aref chars ?-))
(class (if (aref chars ?\]) "]" "")))
(aset chars ?^ nil)
(aset chars ?- nil)
(aset chars ?\] nil)
(let (start end)
(dotimes (i 256)
(if (aref chars i)
(progn
(unless start (setq start i))
(setq end i)
(aset chars i nil))
(when start
(setq class (concat class (sregex--char-range start end)))
(setq start nil))))
(if start
(setq class (concat class (sregex--char-range start end)))))
(if (> (length class) 0)
(setq class (concat class (if caret "^") (if dash "-")))
(setq class (concat class (if dash "-") (if caret "^"))))
(if (and (not complement) (= (length class) 1))
(regexp-quote class)
(concat "[" (if complement "^") class "]")))))
(provide 'sregex)
;; arch-tag: 460c1f5a-eb6e-42ec-a451-ffac78bdf492
;;; sregex.el ends here

4
lisp/emacs-lisp/syntax.el
View file

@ -1,7 +1,6 @@
;;; syntax.el --- helper functions to find syntactic context
;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
@ -578,5 +577,4 @@ Point is at POS when this function returns."
(provide 'syntax)
;; arch-tag: 302f1eeb-e77c-4680-a8c5-c543e01161a5
;;; syntax.el ends here

4
lisp/emacs-lisp/tcover-ses.el
View file

@ -1,7 +1,6 @@
;;;; testcover-ses.el -- Example use of `testcover' to test "SES"
;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
;; Author: Jonathan Yavner <jyavner@engineer.com>
;; Maintainer: Jonathan Yavner <jyavner@engineer.com>
@ -722,5 +721,4 @@ spreadsheet files with invalid formatting."
;;Could do this here: (testcover-end "ses.el")
(message "Done"))
;; arch-tag: 87052ba4-5cf8-46cf-9375-fe245f3360b8
;; testcover-ses.el ends here.

3
lisp/emacs-lisp/tcover-unsafep.el
View file

@ -1,6 +1,6 @@
;;;; testcover-unsafep.el -- Use testcover to test unsafep's code coverage
;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
;; Author: Jonathan Yavner <jyavner@engineer.com>
;; Maintainer: Jonathan Yavner <jyavner@engineer.com>
@ -138,5 +138,4 @@
(testcover-end "unsafep.el")
(message "Done"))
;; arch-tag: a7616c27-1998-47ae-9304-76d1439dbf29
;; testcover-unsafep.el ends here.

3
lisp/emacs-lisp/testcover.el
View file

@ -1,6 +1,6 @@
;;;; testcover.el -- Visual code-coverage tool
;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
;; Author: Jonathan Yavner <jyavner@member.fsf.org>
;; Maintainer: Jonathan Yavner <jyavner@member.fsf.org>
@ -534,5 +534,4 @@ coverage tests. This function creates many overlays."
(goto-char (next-overlay-change (point)))
(end-of-line))
;; arch-tag: 72324a4a-4a2e-4142-9249-cc56d6757588
;; testcover.el ends here.

3
lisp/emacs-lisp/timer.el
View file

@ -1,7 +1,6 @@
;;; timer.el --- run a function with args at some time in future
;; Copyright (C) 1996, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
;; 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1996, 2001-2011 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Package: emacs

4
lisp/emacs-lisp/tq.el
View file

@ -1,7 +1,6 @@
;;; tq.el --- utility to maintain a transaction queue
;; Copyright (C) 1985, 1986, 1987, 1992, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1985-1987, 1992, 2001-2011 Free Software Foundation, Inc.
;; Author: Scott Draves <spot@cs.cmu.edu>
;; Maintainer: FSF
@ -167,5 +166,4 @@ This produces more reliable results with some processes."
(provide 'tq)
;; arch-tag: 65dea08c-4edd-4cde-83a5-e8a15b993b79
;;; tq.el ends here

4
lisp/emacs-lisp/trace.el
View file

@ -1,7 +1,6 @@
;;; trace.el --- tracing facility for Emacs Lisp functions
;; Copyright (C) 1993, 1998, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 1993, 1998, 2000-2011 Free Software Foundation, Inc.
;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
;; Maintainer: FSF
@ -299,5 +298,4 @@ was not traced this is a noop."
(provide 'trace)
;; arch-tag: cfd170a7-4932-4331-8c8b-b7151942e5a1
;;; trace.el ends here

6
lisp/emacs-lisp/unsafep.el
View file

@ -1,6 +1,6 @@
;;;; unsafep.el -- Determine whether a Lisp form is safe to evaluate
;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
;; Author: Jonathan Yavner <jyavner@member.fsf.org>
;; Maintainer: Jonathan Yavner <jyavner@member.fsf.org>
@ -202,6 +202,9 @@ UNSAFEP-VARS is a list of symbols with local bindings."
(dolist (x (nthcdr 3 form))
(setq reason (unsafep-progn (cdr x)))
(if reason (throw 'unsafep reason))))))
((eq fun '\`)
;; Backquoted form - safe if its expansion is.
(unsafep (cdr (backquote-process (cadr form)))))
(t
;;First unsafep-function call above wasn't nil, no special case applies
reason)))))
@ -258,5 +261,4 @@ If TO-BIND is t, check whether SYM is safe to bind."
(local-variable-p sym)))
`(global-variable ,sym))))
;; arch-tag: 6216f98b-eb8f-467a-9c33-7a7644f50658
;;; unsafep.el ends here

3
lisp/emacs-lisp/warnings.el
View file

@ -1,6 +1,6 @@
;;; warnings.el --- log and display warnings
;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
@ -337,5 +337,4 @@ this is equivalent to `display-warning', using
(provide 'warnings)
;; arch-tag: faaad1c8-7b2a-4161-af38-5ab4afde0496
;;; warnings.el ends here