diff options
Diffstat (limited to 'lisp/emacs-lisp')
75 files changed, 1256 insertions, 839 deletions
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index a245a91c5c1..09dde2c1c17 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -1,6 +1,6 @@ ;;; advice.el --- an overloading mechanism for Emacs Lisp functions -;; Copyright (C) 1993-1994, 2000-2011 Free Software Foundation, Inc. +;; Copyright (C) 1993-1994, 2000-2012 Free Software Foundation, Inc. ;; Author: Hans Chalupsky <hans@cs.buffalo.edu> ;; Maintainer: FSF @@ -348,10 +348,7 @@ ;; first argument list defined in the list of before/around/after advices. ;; The values of <arglist> variables can be accessed/changed in the body of ;; an advice by simply referring to them by their original name, however, -;; more portable argument access macros are also provided (see below). For -;; subrs/special-forms for which neither explicit argument list definitions -;; are available, nor their documentation strings contain such definitions -;; (as they do v19s), `(&rest ad-subr-args)' will be used. +;; more portable argument access macros are also provided (see below). ;; <advised-docstring> is an optional, special documentation string which will ;; be expanded into a proper documentation string upon call of `documentation'. @@ -491,17 +488,15 @@ ;; @@@ Argument list mapping: ;; ========================== -;; Because `defadvice' allows the specification of the argument list of the -;; advised function we need a mapping mechanism that maps this argument list -;; onto that of the original function. For example, somebody might specify -;; `(sym newdef)' as the argument list of `fset', while advice might use -;; `(&rest ad-subr-args)' as the argument list of the original function -;; (depending on what Emacs version is used). Hence SYM and NEWDEF have to -;; be properly mapped onto the &rest variable when the original definition is -;; called. Advice automatically takes care of that mapping, hence, the advice -;; programmer can specify an argument list without having to know about the -;; exact structure of the original argument list as long as the new argument -;; list takes a compatible number/magnitude of actual arguments. +;; Because `defadvice' allows the specification of the argument list +;; of the advised function we need a mapping mechanism that maps this +;; argument list onto that of the original function. Hence SYM and +;; NEWDEF have to be properly mapped onto the &rest variable when the +;; original definition is called. Advice automatically takes care of +;; that mapping, hence, the advice programmer can specify an argument +;; list without having to know about the exact structure of the +;; original argument list as long as the new argument list takes a +;; compatible number/magnitude of actual arguments. ;; @@ Activation and deactivation: ;; =============================== @@ -625,12 +620,12 @@ ;; ;; (ad-activate-regexp "^ange-ftp-") ;; -;; A saver way would have been to use +;; A safer way would have been to use ;; ;; (ad-update-regexp "^ange-ftp-") ;; ;; instead which would have only reactivated currently actively advised -;; functions, but not functions that were currently deactivated. All these +;; functions, but not functions that were currently inactive. All these ;; functions can also be called interactively. ;; A certain piece of advice is considered a match if its name contains a @@ -664,8 +659,8 @@ ;; @@@ Enabling automatic advice activation: ;; ========================================= -;; Automatic advice activation is enabled by default. It can be disabled by -;; doint `M-x ad-stop-advice' and enabled again with `M-x ad-start-advice'. +;; Automatic advice activation is enabled by default. It can be disabled with +;; `M-x ad-stop-advice' and enabled again with `M-x ad-start-advice'. ;; @@ Caching of advised definitions: ;; ================================== @@ -833,7 +828,7 @@ ;; Reactivate an advised function but only if its advice is currently ;; active. This can be used to bring all currently advised function up ;; to date with the current state of advice without also activating -;; currently deactivated functions. +;; currently inactive functions. ;; - Caching: ;; Is the saving of an advised definition and an identifying cache-id so ;; it can be reused, for example, for activation after deactivation. @@ -853,7 +848,7 @@ ;; - ad-activate to activate the advice of a FUNCTION ;; - ad-deactivate to deactivate the advice of a FUNCTION ;; - ad-update to activate the advice of a FUNCTION unless it was not -;; yet activated or is currently deactivated. +;; yet activated or is currently inactive. ;; - ad-unadvise deactivates a FUNCTION and removes all of its advice ;; information, hence, it cannot be activated again ;; - ad-recover tries to redefine a FUNCTION to its original definition and @@ -884,9 +879,6 @@ ;; @@ Summary of forms with special meanings when used within an advice: ;; ===================================================================== ;; ad-return-value name of the return value variable (get/settable) -;; ad-subr-args name of &rest argument variable used for advised -;; subrs whose actual argument list cannot be -;; determined (get/settable) ;; (ad-get-arg <pos>), (ad-get-args <pos>), ;; (ad-set-arg <pos> <value>), (ad-set-args <pos> <value-list>) ;; argument access text macros to get/set the values of @@ -1261,7 +1253,7 @@ ;; contain some advice matched by the regular expression. This is a save ;; way to update the activation of advised functions whose advice changed ;; in some way or other without accidentally also activating currently -;; deactivated functions: +;; inactive functions: ;; ;; (ad-update-regexp "^fg-") ;; nil @@ -1608,7 +1600,7 @@ ;; fii ;; ;; Now we advise `fii' to use an optional second argument that controls the -;; amount of incrementation. A list following the (optional) position +;; amount of incrementing. A list following the (optional) position ;; argument of the advice will be interpreted as an argument list ;; specification. This means you cannot specify an empty argument list, and ;; why would you want to anyway? @@ -2594,36 +2586,6 @@ For that it has to be fbound with a non-autoload definition." (byte-compile symbol) (fset function (symbol-function symbol)))))) - -;; @@ Constructing advised definitions: -;; ==================================== -;; -;; Main design decisions about the form of advised definitions: -;; -;; A) How will original definitions be called? -;; B) What will argument lists of advised functions look like? -;; -;; Ad A) -;; I chose to use function indirection for all four types of original -;; definitions (functions, macros, subrs and special forms), i.e., create -;; a unique symbol `ad-Orig-<name>' which is fbound to the original -;; definition and call it according to type and arguments. Functions and -;; subrs that don't have any &rest arguments can be called directly in a -;; `(ad-Orig-<name> ....)' form. If they have a &rest argument we have to -;; use `apply'. Macros will be called with -;; `(macroexpand '(ad-Orig-<name> ....))', and special forms also need a -;; form like that with `eval' instead of `macroexpand'. -;; -;; Ad B) -;; Use original arguments where possible and `(&rest ad-subr-args)' -;; otherwise, even though this seems to be more complicated and less -;; uniform than a general `(&rest args)' approach. My reason to still -;; do it that way is that in most cases my approach leads to the more -;; efficient form for the advised function, and portability (e.g., to -;; make the same advice work regardless of whether something is a -;; function or a subr) can still be achieved with argument access macros. - - (defun ad-prognify (forms) (cond ((<= (length forms) 1) (car forms)) diff --git a/lisp/emacs-lisp/assoc.el b/lisp/emacs-lisp/assoc.el index 31be851f2dd..264374ed721 100644 --- a/lisp/emacs-lisp/assoc.el +++ b/lisp/emacs-lisp/assoc.el @@ -1,6 +1,6 @@ ;;; assoc.el --- insert/delete functions on association lists -;; Copyright (C) 1996, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1996, 2001-2012 Free Software Foundation, Inc. ;; Author: Barry A. Warsaw <bwarsaw@cen.com> ;; Keywords: extensions @@ -61,10 +61,9 @@ pair is not at the head of alist. ALIST is not altered." (defun aput (alist-symbol key &optional value) - "Inserts a key-value pair into an alist. + "Insert a key-value pair into an alist. The alist is referenced by ALIST-SYMBOL. The key-value pair is made -from KEY and optionally, VALUE. Returns the altered alist or nil if -ALIST is nil. +from KEY and optionally, VALUE. Returns the altered alist. If the key-value pair referenced by KEY can be found in the alist, and VALUE is supplied non-nil, then the value of KEY will be set to VALUE. @@ -78,7 +77,7 @@ of the alist (with value nil if VALUE is nil or not supplied)." (setq alist (symbol-value alist-symbol)) (cond ((null alist) (set alist-symbol elem)) ((anot-head-p alist key) (set alist-symbol (nconc elem alist))) - (value (setcar alist (car elem))) + (value (setcar alist (car elem)) alist) (t alist)))) diff --git a/lisp/emacs-lisp/authors.el b/lisp/emacs-lisp/authors.el index 596b32f24c3..22e0ade987d 100644 --- a/lisp/emacs-lisp/authors.el +++ b/lisp/emacs-lisp/authors.el @@ -1,6 +1,6 @@ -;;; authors.el --- utility for maintaining Emacs' AUTHORS file -*-coding: utf-8;-*- +;;; authors.el --- utility for maintaining Emacs's AUTHORS file -*-coding: utf-8;-*- -;; Copyright (C) 2000-2011 Free Software Foundation, Inc. +;; Copyright (C) 2000-2012 Free Software Foundation, Inc. ;; Author: Gerd Moellmann <gerd@gnu.org> ;; Maintainer: Kim F. Storm <storm@cua.dk> @@ -25,7 +25,7 @@ ;;; Commentary: ;; Use M-x authors RET to create an *Authors* buffer that can used as -;; or merged with Emacs' AUTHORS file. +;; or merged with Emacs's AUTHORS file. ;;; Code: @@ -41,23 +41,28 @@ files.") (defconst authors-aliases '( ("Aaron S. Hawley" "Aaron Hawley") + ("Alexandru Harsanyi" "Alex Harsanyi") ("Andrew Csillag" "Drew Csillag") ("Anna M. Bigatti" "Anna Bigatti") ("Barry A. Warsaw" "Barry A. Warsaw, Century Computing, Inc." "Barry A. Warsaw, ITB" "Barry Warsaw") + ("Bill Carpenter" "WJ Carpenter") ("Bill Mann" "William F. Mann") ("Bill Rozas" "Guillermo J. Rozas") ("Björn Torkelsson" "Bjorn Torkelsson") ("Brian Fox" "Brian J. Fox") + ("Brian Sniffen" "Brian T. Sniffen") ("Christoph Wedler" "Christoph.Wedler@sap.com") ("Daniel Pfeiffer" "<Daniel.Pfeiffer@Informatik.START.db.de>" "<Daniel.Pfeiffer@Informatik.START.dbp.de>") + ("David Abrahams" "Dave Abrahams") ("David De La Harpe Golden" "David Golden") ("David Gillespie" "Dave Gillespie") ("David Kågedal" "David K..edal") ("David M. Koppelman" "David M. Koppelman, Koppel@Ec?e.Lsu.Edu" "David Koppelman") ("David M. Smith" "David Smith" "David M Smith") + ("David O'Toole" "David T. O'Toole") ("Deepak Goel" "D. Goel") ("Ed L. Cashin" "Ed L Cashin") ("Edward M. Reingold" "Ed Reingold" "Edward M Reingold" @@ -76,6 +81,8 @@ files.") ("Gerd Möllmann" "Gerd Moellmann") ("Hallvard B. Furuseth" "Hallvard B Furuseth" "Hallvard Furuseth") ("Hrvoje Nikšić" "Hrvoje Niksic") + ;; lisp/org/ChangeLog 2010-11-11. + (nil "aaa bbb") ;; src/ChangeLog.4, 1994-01-11, since fixed. ;;; (nil "(afs@hplb.hpl.hp.com)") ;; lisp/gnus/ChangeLog.1, 1998-01-15. @@ -92,6 +99,7 @@ files.") ("Jens-Ulrik Holger Petersen" "Jens-Ulrik Petersen") ("Jeremy Bertram Maitin-Shepard" "Jeremy Maitin-Shepard") ("Johan Bockgård" "Johan Bockgard") + ("John J Foerch" "John Foerch") ("John W. Eaton" "John Eaton") ("Jonathan I. Kamens" "Jonathan Kamens") ("Joseph Arceneaux" "Joe Arceneaux") @@ -109,10 +117,11 @@ files.") ("Kevin Greiner" "Kevin J. Greiner") ("Kim F. Storm" "Kim Storm") ("Kyle Jones" "Kyle E. Jones") + ("Lars Magne Ingebrigtsen" "Lars Ingebrigtsen") ("Marcus G. Daniels" "Marcus Daniels") ("Mark D. Baushke" "Mark D Baushke") ("Marko Kohtala" "Kohtala Marko") - ("Agustín Martín" "Agustin Martin") + ("Agustín Martín" "Agustin Martin" "Agustín Martín Domingo") ("Martin Lorentzon" "Martin Lorentzson") ("Matt Swift" "Matthew Swift") ("Maxime Edouard Robert Froumentin" "Max Froumentin") @@ -124,12 +133,14 @@ files.") ("Michael Sperber" "Michael Sperber \\[Mr. Preprocessor\\]") ("Mikio Nakajima" "Nakajima Mikio") ("Nelson Jose dos Santos Ferreira" "Nelson Ferreira") + ("Noorul Islam" "Noorul Islam K M") ("Paul Eggert" "eggert") ("Paul Reilly" "(pmr@legacy.pajato.com)") ("Pavel Janík" "Pavel Janík Ml." "Pavel Janik Ml." "Pavel Janik" "Pavel Janík" "Pavel@Janik.Cz") ("Pavel Kobiakov" "Pavel Kobyakov") ("Per Abrahamsen" "Per Abhiddenware") ("Per Starbäck" "Per Starback") + ("Peter J. Weisberg" "PJ Weisberg") ("Peter S. Galbraith" "Peter Galbraith") ("Peter Runestig" "Peter 'luna' Runestig") ("Peter S. Galbraith" "Peter S Galbraith") @@ -144,16 +155,19 @@ files.") ("Sacha Chua" "Sandra Jean Chua") ("Sam Steingold" "Sam Shteingold") ("Satyaki Das" "Indexed search by Satyaki Das") + ("Sébastien Vauban" "Sebastien Vauban") ;; There are other Stefans. ;;; ("Stefan Monnier" "Stefan") ("Stephen A. Wood" "(saw@cebaf.gov)") ("Steven L. Baur" "SL Baur" "Steven L Baur") ("Stewart M. Clamen" "Stewart Clamen") ("Stuart D. Herring" "Stuart Herring" "Davis Herring") + ("T.V. Raman" "T\\. V\\. Raman") ("Taichi Kawabata" "KAWABATA,? Taichi") ("Takaaki Ota" "Tak Ota") ("Takahashi Naoto" "Naoto Takahashi") ("Teodor Zlatanov" "Ted Zlatanov") + ("Thomas Dye" "Tom Dye") ("Thomas Horsley" "Tom Horsley") ; FIXME ? ("Thomas Wurgler" "Tom Wurgler") ("Tomohiko Morioka" "MORIOKA Tomohiko") @@ -174,6 +188,7 @@ Each entry is of the form (REALNAME REGEXP...). If an author's name matches one of the REGEXPs, use REALNAME instead. If REALNAME is nil, ignore that author.") +;; FIXME seems it would be less fragile to check for O', Mc, etc. (defconst authors-fixed-case '("Bryan O'Sullivan" "Christian von Roques" @@ -182,6 +197,7 @@ If REALNAME is nil, ignore that author.") "David J. MacKenzie" "David McCabe" "David O'Toole" + "Devon Sean McCullough" "Dominique de Waleffe" "Edward O'Connor" "Exal de Jesus Garcia Carrillo" @@ -194,8 +210,11 @@ If REALNAME is nil, ignore that author.") "Nelson Jose dos Santos Ferreira" "Peter von der Ahe" "Peter O'Gorman" + "Piet van Oostrum" "Roland McGrath" - "Sean O'Rourke") + "Sean O'Halpin" + "Sean O'Rourke" + "Tijs van Bakel") "List of authors whose names cannot be simply capitalized.") (defvar authors-public-domain-files @@ -222,11 +241,12 @@ If REALNAME is nil, ignore that author.") ".*loaddefs.el$" ; not obsolete, but auto-generated "\\.\\(cvs\\|git\\)ignore$" ; obsolete or uninteresting "\\.arch-inventory$" + ;; TODO lib/? Matches other things? + "build-aux/" "m4/" "Emacs.xcodeproj" "charsets" "mapfiles" "preferences\\.\\(nib\\|gorm\\)" "vc-\\(rcs\\|cvs\\|sccs\\)-hooks\\.el$") "List of regexps matching obsolete files. -Changes to files matching one of the regexps in this list are not -listed.") +Changes to files matching one of the regexps in this list are not listed.") (defconst authors-ignored-files '("external-lisp" @@ -257,7 +277,12 @@ listed.") "*.el" ;; Autogen: "cus-load.el" "finder-inf.el" "ldefs-boot.el" + "compile" "config.guess" "config.sub" "depcomp" + ;; Only existed briefly, then renamed: + "images/icons/allout-widgets-dark-bg" + "images/icons/allout-widgets-light-bg" ;; Never had any meaningful changes logged, now deleted: + "unidata/bidimirror.awk" "unidata/biditype.awk" "split-man" "Xkeymap.txt" "ms-7bkermit" "ulimit.hack" "gnu-hp300" "refcard.bit" "ledit.l" "forms.README" "forms-d2.dat" "CXTERM-DIC/PY.tit" "CXTERM-DIC/ZIRANMA.tit" @@ -308,29 +333,47 @@ Changes to files in this list are not listed.") "complete.el" "cpp.el" "ctxt.el" + "custom.el" + "cyrillic.el" + "czech.el" "debug.el" "dired.el" "el.el" + "eshell.el" + "ethiopic.el" + "f90.el" "files.el" "find.el" "format.el" + "generic.el" + "georgian.el" + "greek.el" "grep.el" + "hebrew.el" "imenu.el" + "indian.el" + "japanese.el" "java.el" + "lao.el" "linux.el" "locate.el" "make.el" "mode.el" "python.el" + "rmailmm.el" "semantic.el" "shell.el" "simple.el" + "slovak.el" "sort.el" "speedbar.el" "srecode.el" "table.el" "texi.el" + "thai.el" + "tibetan.el" "util.el" + "vc-bzr.el" "wisent.el") "List of basenames occurring more than once in the source.") @@ -421,7 +464,8 @@ Changes to files in this list are not listed.") "vt220.el" "vt240.el") ("Motorola" :changed "buff-menu.el") ("Hiroshi Nakano" :changed "ralloc.c") - ("Sundar Narasimhan" :changed "rnewspost.el") + ;; File removed in Emacs 24.1. +;;; ("Sundar Narasimhan" :changed "rnewspost.el") ;; No longer distributed. ;;; ("NeXT, Inc." :wrote "unexnext.c") ("Mark Neale" :changed "fortran.el") @@ -452,7 +496,7 @@ Changes to files in this list are not listed.") ("William Sommerfeld" :wrote "emacsclient.c" "scribe.el") ;; No longer distributed: emacsserver.c. ("Leigh Stoller" :changed "emacsclient.c" "server.el") - ("Steve Strassman" :wrote "spook.el") + ("Steve Strassmann" :wrote "spook.el") ("Shinichirou Sugou" :changed "etags.c") ;; No longer distributed: emacsserver.c. ("Sun Microsystems, Inc" :changed "emacsclient.c" "server.el" @@ -587,6 +631,7 @@ in the repository.") ("texi/url.txi" . "url.texi") ("edt-user.doc" . "edt.texi") ("DEV-NOTES" . "nextstep") + ("org/COPYRIGHT-AND-LICENSE" . "org/README") ;; Moved to different directories. ("ctags.1" . "ctags.1") ("etags.1" . "etags.1") diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 6d5067151d3..5af666b9ded 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -1,6 +1,6 @@ ;; autoload.el --- maintain autoloads in loaddefs.el -;; Copyright (C) 1991-1997, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1991-1997, 2001-2012 Free Software Foundation, Inc. ;; Author: Roland McGrath <roland@gnu.org> ;; Keywords: maint @@ -446,7 +446,11 @@ Return non-nil if and only if FILE adds no autoloads to OUTFILE generated-autoload-load-name (autoload-file-load-name absfile))) (when (and outfile - (not (equal outfile (autoload-generated-file)))) + (not + (if (memq system-type '(ms-dos windows-nt)) + (equal (downcase outfile) + (downcase (autoload-generated-file))) + (equal outfile (autoload-generated-file))))) (setq otherbuf t)) (save-excursion (save-restriction @@ -512,8 +516,7 @@ Return non-nil if and only if FILE adds no autoloads to OUTFILE (when output-start (let ((secondary-autoloads-file-buf - (if (local-variable-p 'generated-autoload-file) - (current-buffer)))) + (if otherbuf (current-buffer)))) (with-current-buffer (marker-buffer output-start) (save-excursion ;; Insert the section-header line which lists the file name diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el index e8b7a1f9a8b..cb5ea048999 100644 --- a/lisp/emacs-lisp/avl-tree.el +++ b/lisp/emacs-lisp/avl-tree.el @@ -1,6 +1,6 @@ ;;; avl-tree.el --- balanced binary trees, AVL-trees -;; Copyright (C) 1995, 2007-2011 Free Software Foundation, Inc. +;; Copyright (C) 1995, 2007-2012 Free Software Foundation, Inc. ;; Author: Per Cederqvist <ceder@lysator.liu.se> ;; Inge Wallin <inge@lysator.liu.se> @@ -31,7 +31,7 @@ ;; deleting, and retrieving data from an AVL tree containing n elements ;; is O(log n). It is somewhat more rigidly balanced than other ;; self-balancing binary trees (such as red-black trees and AA trees), -;; making insertion slighty slower, deletion somewhat slower, and +;; making insertion slightly slower, deletion somewhat slower, and ;; retrieval somewhat faster (the asymptotic scaling is of course the ;; same for all types). Thus it may be a good choice when the tree will ;; be relatively static, i.e. data will be retrieved more often than @@ -74,7 +74,7 @@ cmpfun) (defmacro avl-tree--root (tree) - ;; Return the root node for an avl-tree. INTERNAL USE ONLY. + ;; Return the root node for an AVL tree. INTERNAL USE ONLY. `(avl-tree--node-left (avl-tree--dummyroot ,tree))) (defsetf avl-tree--root (tree) (node) @@ -206,7 +206,7 @@ Return t if the height of the tree has shrunk." Return cons cell (SHRUNK . DATA), where SHRUNK is t if the height of the tree has shrunk and nil otherwise, and DATA is -the releted data." +the related data." (let ((br (avl-tree--node-branch root branch))) (cond ;; DATA not in tree. @@ -372,7 +372,7 @@ itself." ;;; INTERNAL USE ONLY (defun avl-tree--do-copy (root) - "Copy the avl tree with ROOT as root. Highly recursive." + "Copy the AVL tree with ROOT as root. Highly recursive." (if (null root) nil (avl-tree--node-create @@ -401,7 +401,7 @@ itself." ;; front of the STACK, until a leaf is reached. (let ((node (car (avl-tree--stack-store stack))) (dir (if (avl-tree--stack-reverse stack) 1 0))) - (when node ; check for emtpy stack + (when node ; check for empty stack (while (setq node (avl-tree--node-branch node dir)) (push node (avl-tree--stack-store stack)))))) @@ -411,21 +411,21 @@ itself." ;; define public alias for constructors so that we can set docstring (defalias 'avl-tree-create 'avl-tree--create - "Create an empty avl tree. + "Create an empty AVL tree. COMPARE-FUNCTION is a function which takes two arguments, A and B, and returns non-nil if A is less than B, and nil otherwise.") (defalias 'avl-tree-compare-function 'avl-tree--cmpfun - "Return the comparison function for the avl tree TREE. + "Return the comparison function for the AVL tree TREE. \(fn TREE)") (defun avl-tree-empty (tree) - "Return t if avl tree TREE is emtpy, otherwise return nil." + "Return t if AVL tree TREE is empty, otherwise return nil." (null (avl-tree--root tree))) (defun avl-tree-enter (tree data &optional updatefun) - "Insert DATA into the avl tree TREE. + "Insert DATA into the AVL tree TREE. If an element that matches DATA (according to the tree's comparison function, see `avl-tree-create') already exists in @@ -433,8 +433,8 @@ TREE, it will be replaced by DATA by default. If UPDATEFUN is supplied and an element matching DATA already exists in TREE, UPDATEFUN is called with two arguments: DATA, and -the matching element. Its return value replaces the existing -element. This value *must* itself match DATA (and hence the +the matching element. Its return value replaces the existing +element. This value *must* itself match DATA (and hence the pre-existing data), or an error will occur. Returns the new data." @@ -443,7 +443,7 @@ Returns the new data." 0 data updatefun))) (defun avl-tree-delete (tree data &optional test nilflag) - "Delete the element matching DATA from the avl tree TREE. + "Delete the element matching DATA from the AVL tree TREE. Matching uses the comparison function previously specified in `avl-tree-create' when TREE was created. @@ -456,7 +456,7 @@ distinguished from the case of a successfully deleted null element. If supplied, TEST specifies a test that a matching element must -pass before it is deleted. If a matching element is found, it is +pass before it is deleted. If a matching element is found, it is passed as an argument to TEST, and is deleted only if the return value is non-nil." (cdr (avl-tree--do-delete (avl-tree--cmpfun tree) @@ -465,14 +465,14 @@ value is non-nil." (defun avl-tree-member (tree data &optional nilflag) - "Return the element in the avl tree TREE which matches DATA. + "Return the element in the AVL tree TREE which matches DATA. Matching uses the comparison function previously specified in `avl-tree-create' when TREE was created. If there is no such element in the tree, nil is -returned. Optional argument NILFLAG specifies a value to return -instead of nil in this case. This allows non-existent elements to -be distinguished from a null element. (See also +returned. Optional argument NILFLAG specifies a value to return +instead of nil in this case. This allows non-existent elements to +be distinguished from a null element. (See also `avl-tree-member-p', which does this for you.)" (let ((node (avl-tree--root tree)) (compare-function (avl-tree--cmpfun tree))) @@ -488,15 +488,15 @@ be distinguished from a null element. (See also (defun avl-tree-member-p (tree data) - "Return t if an element matching DATA exists in the avl tree TREE, -otherwise return nil. Matching uses the comparison function + "Return t if an element matching DATA exists in the AVL tree TREE. +Otherwise return nil. Matching uses the comparison function previously specified in `avl-tree-create' when TREE was created." (let ((flag '(nil))) (not (eq (avl-tree-member tree data flag) flag)))) (defun avl-tree-map (__map-function__ tree &optional reverse) - "Modify all elements in the avl tree TREE by applying FUNCTION. + "Modify all elements in the AVL tree TREE by applying FUNCTION. Each element is replaced by the return value of FUNCTION applied to that element. @@ -512,7 +512,7 @@ descending order if REVERSE is non-nil." (defun avl-tree-mapc (__map-function__ tree &optional reverse) - "Apply FUNCTION to all elements in avl tree TREE, + "Apply FUNCTION to all elements in AVL tree TREE, for side-effect only. FUNCTION is applied to the elements in ascending order, or @@ -526,7 +526,7 @@ descending order if REVERSE is non-nil." (defun avl-tree-mapf (__map-function__ combinator tree &optional reverse) - "Apply FUNCTION to all elements in avl tree TREE, + "Apply FUNCTION to all elements in AVL tree TREE, and combine the results using COMBINATOR. The FUNCTION is applied and the results are combined in ascending @@ -545,7 +545,7 @@ order, or descending order if REVERSE is non-nil." (defun avl-tree-mapcar (__map-function__ tree &optional reverse) - "Apply FUNCTION to all elements in avl tree TREE, + "Apply FUNCTION to all elements in AVL tree TREE, and make a list of the results. The FUNCTION is applied and the list constructed in ascending @@ -578,7 +578,7 @@ is more efficient." (avl-tree--node-data node)))) (defun avl-tree-copy (tree) - "Return a copy of the avl tree TREE." + "Return a copy of the AVL tree TREE." (let ((new-tree (avl-tree-create (avl-tree--cmpfun tree)))) (setf (avl-tree--root new-tree) (avl-tree--do-copy (avl-tree--root tree))) new-tree)) @@ -600,7 +600,7 @@ is more efficient." treesize)) (defun avl-tree-clear (tree) - "Clear the avl tree TREE." + "Clear the AVL tree TREE." (setf (avl-tree--root tree) nil)) @@ -617,8 +617,8 @@ calling `avl-tree-stack-pop' will give unpredictable results). Operations on these objects are significantly more efficient than constructing a real stack with `avl-tree-flatten' and using -standard stack functions. As such, they can be useful in -implementing efficient algorithms of AVL trees. However, in cases +standard stack functions. As such, they can be useful in +implementing efficient algorithms of AVL trees. However, in cases where mapping functions `avl-tree-mapc', `avl-tree-mapcar' or `avl-tree-mapf' would be sufficient, it is better to use one of those instead." @@ -629,11 +629,11 @@ those instead." (defun avl-tree-stack-pop (avl-tree-stack &optional nilflag) "Pop the first element from AVL-TREE-STACK. -\(See also `avl-tree-stack'\). +\(See also `avl-tree-stack'). -Returns nil if the stack is empty, or NILFLAG if specified. (The -latter allows an empty stack to be distinguished from a null -element stored in the AVL tree.)" +Returns nil if the stack is empty, or NILFLAG if specified. +\(The latter allows an empty stack to be distinguished from +a null element stored in the AVL tree.)" (let (node next) (if (not (setq node (pop (avl-tree--stack-store avl-tree-stack)))) nilflag @@ -650,9 +650,9 @@ element stored in the AVL tree.)" "Return the first element of AVL-TREE-STACK, without removing it from the stack. -Returns nil if the stack is empty, or NILFLAG if specified. (The -latter allows an empty stack to be distinguished from a null -element stored in the AVL tree.)" +Returns nil if the stack is empty, or NILFLAG if specified. +\(The latter allows an empty stack to be distinguished from +a null element stored in the AVL tree.)" (or (car (avl-tree--stack-store avl-tree-stack)) nilflag)) diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el index 34e316b2e48..870127ceac8 100644 --- a/lisp/emacs-lisp/backquote.el +++ b/lisp/emacs-lisp/backquote.el @@ -1,6 +1,6 @@ ;;; backquote.el --- implement the ` Lisp construct -;; Copyright (C) 1990, 1992, 1994, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1992, 1994, 2001-2012 Free Software Foundation, Inc. ;; Author: Rick Sladkey <jrs@world.std.com> ;; Maintainer: FSF diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el index aa84a075b76..646be3e1b71 100644 --- a/lisp/emacs-lisp/benchmark.el +++ b/lisp/emacs-lisp/benchmark.el @@ -1,6 +1,6 @@ ;;; benchmark.el --- support for benchmarking code -;; Copyright (C) 2003-2011 Free Software Foundation, Inc. +;; Copyright (C) 2003-2012 Free Software Foundation, Inc. ;; Author: Dave Love <fx@gnu.org> ;; Keywords: lisp, extensions diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index fd98b5f41a7..03d55f376af 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -1,6 +1,6 @@ ;;; bindat.el --- binary data structure packing and unpacking. -;; Copyright (C) 2002-2011 Free Software Foundation, Inc. +;; Copyright (C) 2002-2012 Free Software Foundation, Inc. ;; Author: Kim F. Storm <storm@cua.dk> ;; Assignment name: struct.el diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 7b98ade2422..78ac29d89df 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1,6 +1,6 @@ ;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler -*- lexical-binding: t -*- -;; Copyright (C) 1991, 1994, 2000-2011 Free Software Foundation, Inc. +;; Copyright (C) 1991, 1994, 2000-2012 Free Software Foundation, Inc. ;; Author: Jamie Zawinski <jwz@lucid.com> ;; Hallvard Furuseth <hbf@ulrik.uio.no> @@ -135,7 +135,7 @@ ;; We'd have to notice defvars and defconsts, since those variables should ;; always be dynamic, and attempting to do a lexical binding of them ;; should simply do a dynamic binding instead. -;; But! We need to know about variables that were not necessarily defvarred +;; But! We need to know about variables that were not necessarily defvared ;; in the file being compiled (doing a boundp check isn't good enough.) ;; Fdefvar() would have to be modified to add something to the plist. ;; @@ -527,7 +527,7 @@ ;; However, don't actually bother calling `ignore'. `(prog1 nil . ,(mapcar 'byte-optimize-form (cdr form)))) - ;; Neeeded as long as we run byte-optimize-form after cconv. + ;; Needed as long as we run byte-optimize-form after cconv. ((eq fn 'internal-make-closure) form) ((byte-code-function-p fn) @@ -1574,7 +1574,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; stack-set-X+1 stack-ref-X --> dup stack-set-X+2 ;; but this is a very minor gain, since dup is stack-ref-0, ;; i.e. it's only better if X>5, and even then it comes - ;; at the cost cost of an extra stack slot. Let's not bother. + ;; at the cost of an extra stack slot. Let's not bother. ((and (eq 'byte-varref (car lap2)) (eq (cdr lap1) (cdr lap2)) (memq (car lap1) '(byte-varset byte-varbind))) diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index f79add14836..dc7166bc2ea 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -1,6 +1,6 @@ ;;; byte-run.el --- byte-compiler support for inlining -;; Copyright (C) 1992, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc. ;; Author: Jamie Zawinski <jwz@lucid.com> ;; Hallvard Furuseth <hbf@ulrik.uio.no> diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 223e9667ac3..2ee878e5213 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1,6 +1,6 @@ ;;; bytecomp.el --- compilation of Lisp code into byte code -*- lexical-binding: t -*- -;; Copyright (C) 1985-1987, 1992, 1994, 1998, 2000-2011 +;; Copyright (C) 1985-1987, 1992, 1994, 1998, 2000-2012 ;; Free Software Foundation, Inc. ;; Author: Jamie Zawinski <jwz@lucid.com> @@ -178,9 +178,9 @@ adds `c' to it; otherwise adds `.elc'." ;; This can be the 'byte-compile property of any symbol. (autoload 'byte-compile-inline-expand "byte-opt") -;; This is the entrypoint to the lapcode optimizer pass1. +;; This is the entry point to the lapcode optimizer pass1. (autoload 'byte-optimize-form "byte-opt") -;; This is the entrypoint to the lapcode optimizer pass2. +;; This is the entry point to the lapcode optimizer pass2. (autoload 'byte-optimize-lapcode "byte-opt") (autoload 'byte-compile-unfold-lambda "byte-opt") @@ -355,14 +355,16 @@ else the global value will be modified." (defvar byte-compile-interactive-only-functions '(beginning-of-buffer end-of-buffer replace-string replace-regexp insert-file insert-buffer insert-file-literally previous-line next-line - goto-line comint-run delete-backward-char switch-to-buffer) + goto-line comint-run delete-backward-char toggle-read-only) "List of commands that are not meant to be called from Lisp.") (defvar byte-compile-not-obsolete-vars nil - "If non-nil, a list of variables that shouldn't be reported as obsolete.") + "List of variables that shouldn't be reported as obsolete.") +(defvar byte-compile-global-not-obsolete-vars nil + "Global list of variables that shouldn't be reported as obsolete.") (defvar byte-compile-not-obsolete-funcs nil - "If non-nil, a list of functions that shouldn't be reported as obsolete.") + "List of functions that shouldn't be reported as obsolete.") (defcustom byte-compile-generate-call-tree nil "Non-nil means collect call-graph information when compiling. @@ -743,7 +745,7 @@ BYTES and PC are updated after evaluating all the arguments." (defmacro byte-compile-push-bytecode-const2 (opcode const2 bytes pc) "Push OPCODE and the two-byte constant CONST2 onto BYTES, and add 3 to PC. -CONST2 may be evaulated multiple times." +CONST2 may be evaluated multiple times." `(byte-compile-push-bytecodes ,opcode (logand ,const2 255) (lsh ,const2 -8) ,bytes ,pc)) @@ -834,7 +836,7 @@ CONST2 may be evaulated multiple times." (setcar (cdr bytes-tail) (logand pc 255)) (setcar bytes-tail (lsh pc -8)) ;; FIXME: Replace this by some workaround. - (if (> (car bytes) 255) (error "Bytecode overflow"))) + (if (> (car bytes-tail) 255) (error "Bytecode overflow"))) (apply 'unibyte-string (nreverse bytes)))) @@ -1113,7 +1115,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (unless (and funcp (memq symbol byte-compile-not-obsolete-funcs)) (byte-compile-warn "`%s' is an obsolete %s%s%s" symbol (if funcp "function" "variable") - (if asof (concat " (as of Emacs " asof ")") "") + (if asof (concat " (as of " asof ")") "") (cond ((stringp instead) (concat "; " instead)) (instead @@ -1743,7 +1745,9 @@ The value is non-nil if there were no errors, nil if errors." (enable-local-eval nil)) ;; Arg of t means don't alter enable-local-variables. (normal-mode t) - (setq filename buffer-file-name)) + ;; There may be a file local variable setting (bug#10419). + (setq buffer-read-only nil + filename buffer-file-name)) ;; Set the default directory, in case an eval-when-compile uses it. (setq default-directory (file-name-directory filename))) ;; Check if the file's local variables explicitly specify not to @@ -1777,37 +1781,37 @@ The value is non-nil if there were no errors, nil if errors." (with-current-buffer output-buffer (goto-char (point-max)) (insert "\n") ; aaah, unix. - (if (file-writable-p target-file) - ;; We must disable any code conversion here. - (let* ((coding-system-for-write 'no-conversion) - ;; Write to a tempfile so that if another Emacs - ;; process is trying to load target-file (eg in a - ;; parallel bootstrap), it does not risk getting a - ;; half-finished file. (Bug#4196) - (tempfile (make-temp-name target-file)) - (kill-emacs-hook - (cons (lambda () (ignore-errors (delete-file tempfile))) - kill-emacs-hook))) - (if (memq system-type '(ms-dos 'windows-nt)) - (setq buffer-file-type t)) - (write-region (point-min) (point-max) tempfile nil 1) - ;; This has the intentional side effect that any - ;; hard-links to target-file continue to - ;; point to the old file (this makes it possible - ;; for installed files to share disk space with - ;; the build tree, without causing problems when - ;; emacs-lisp files in the build tree are - ;; recompiled). Previously this was accomplished by - ;; deleting target-file before writing it. - (rename-file tempfile target-file t) - (message "Wrote %s" target-file)) - ;; This is just to give a better error message than write-region - (signal 'file-error - (list "Opening output file" - (if (file-exists-p target-file) - "cannot overwrite file" - "directory not writable or nonexistent") - target-file))) + (if (file-writable-p target-file) + ;; We must disable any code conversion here. + (let* ((coding-system-for-write 'no-conversion) + ;; Write to a tempfile so that if another Emacs + ;; process is trying to load target-file (eg in a + ;; parallel bootstrap), it does not risk getting a + ;; half-finished file. (Bug#4196) + (tempfile (make-temp-name target-file)) + (kill-emacs-hook + (cons (lambda () (ignore-errors (delete-file tempfile))) + kill-emacs-hook))) + (if (memq system-type '(ms-dos 'windows-nt)) + (setq buffer-file-type t)) + (write-region (point-min) (point-max) tempfile nil 1) + ;; This has the intentional side effect that any + ;; hard-links to target-file continue to + ;; point to the old file (this makes it possible + ;; for installed files to share disk space with + ;; the build tree, without causing problems when + ;; emacs-lisp files in the build tree are + ;; recompiled). Previously this was accomplished by + ;; deleting target-file before writing it. + (rename-file tempfile target-file t) + (message "Wrote %s" target-file)) + ;; This is just to give a better error message than write-region + (signal 'file-error + (list "Opening output file" + (if (file-exists-p target-file) + "cannot overwrite file" + "directory not writable or nonexistent") + target-file))) (kill-buffer (current-buffer))) (if (and byte-compile-generate-call-tree (or (eq t byte-compile-generate-call-tree) @@ -2195,7 +2199,7 @@ list that represents a doc string reference. (byte-compile-keep-pending form))))) ;; Functions and variables with doc strings must be output separately, -;; so make-docfile can recognise them. Most other things can be output +;; so make-docfile can recognize them. Most other things can be output ;; as byte-code. (put 'autoload 'byte-hunk-handler 'byte-compile-file-form-autoload) @@ -2233,22 +2237,21 @@ list that represents a doc string reference. (put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar) (put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar) (defun byte-compile-file-form-defvar (form) - (if (null (nth 3 form)) - ;; Since there is no doc string, we can compile this as a normal form, - ;; and not do a file-boundary. - (byte-compile-keep-pending form) - (when (and (symbolp (nth 1 form)) - (not (string-match "[-*/:$]" (symbol-name (nth 1 form)))) - (byte-compile-warning-enabled-p 'lexical)) - (byte-compile-warn "global/dynamic var `%s' lacks a prefix" - (nth 1 form))) - (push (nth 1 form) byte-compile-bound-variables) - (if (eq (car form) 'defconst) - (push (nth 1 form) byte-compile-const-variables)) + (when (and (symbolp (nth 1 form)) + (not (string-match "[-*/:$]" (symbol-name (nth 1 form)))) + (byte-compile-warning-enabled-p 'lexical)) + (byte-compile-warn "global/dynamic var `%s' lacks a prefix" + (nth 1 form))) + (push (nth 1 form) byte-compile-bound-variables) + (if (eq (car form) 'defconst) + (push (nth 1 form) byte-compile-const-variables)) + (if (and (null (cddr form)) ;No `value' provided. + (eq (car form) 'defvar)) ;Just a declaration. + nil (cond ((consp (nth 2 form)) - (setq form (copy-sequence form)) - (setcar (cdr (cdr form)) - (byte-compile-top-level (nth 2 form) nil 'file)))) + (setq form (copy-sequence form)) + (setcar (cdr (cdr form)) + (byte-compile-top-level (nth 2 form) nil 'file)))) form)) (put 'define-abbrev-table 'byte-hunk-handler @@ -2635,7 +2638,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." (setq form (cdr form))) (setq form (car form))) (if (and (eq (car-safe form) 'list) - ;; The spec is evaled in callint.c in dynamic-scoping + ;; The spec is evalled in callint.c in dynamic-scoping ;; mode, so just leaving the form unchanged would mean ;; it won't be eval'd in the right mode. (not lexical-binding)) @@ -3030,6 +3033,7 @@ That command is designed for interactive use only" fn)) ((let ((od (get var 'byte-obsolete-variable))) (and od (not (memq var byte-compile-not-obsolete-vars)) + (not (memq var byte-compile-global-not-obsolete-vars)) (or (case (nth 1 od) (set (not (eq access-type 'reference))) (get (eq access-type 'reference)) @@ -3722,7 +3726,7 @@ that suppresses all warnings during execution of BODY." (defun byte-compile-if (form) (byte-compile-form (car (cdr form))) ;; Check whether we have `(if (fboundp ...' or `(if (boundp ...' - ;; and avoid warnings about the relevent symbols in the consequent. + ;; and avoid warnings about the relevant symbols in the consequent. (let ((clause (nth 1 form)) (donetag (byte-compile-make-tag))) (if (null (nthcdr 3 form)) @@ -4116,11 +4120,13 @@ binding slots have been popped." (byte-defop-compiler-1 make-obsolete-variable) (defun byte-compile-make-obsolete-variable (form) (when (eq 'quote (car-safe (nth 1 form))) - (push (nth 1 (nth 1 form)) byte-compile-not-obsolete-vars)) + (push (nth 1 (nth 1 form)) byte-compile-global-not-obsolete-vars)) (byte-compile-normal-call form)) +(defconst byte-compile-tmp-var (make-symbol "def-tmp-var")) + (defun byte-compile-defvar (form) - ;; This is not used for file-level defvar/consts with doc strings. + ;; This is not used for file-level defvar/consts. (when (and (symbolp (nth 1 form)) (not (string-match "[-*/:$]" (symbol-name (nth 1 form)))) (byte-compile-warning-enabled-p 'lexical)) @@ -4143,32 +4149,21 @@ binding slots have been popped." (push var byte-compile-bound-variables) (if (eq fun 'defconst) (push var byte-compile-const-variables)) - (byte-compile-body-do-effect - (list - ;; Put the defined variable in this library's load-history entry - ;; just as a real defvar would, but only in top-level forms. - (when (and (cddr form) (null byte-compile-current-form)) - `(setq current-load-list (cons ',var current-load-list))) - (when (> (length form) 3) - (when (and string (not (stringp string))) - (byte-compile-warn "third arg to `%s %s' is not a string: %s" - fun var string)) - `(put ',var 'variable-documentation ,string)) - (if (cddr form) ; `value' provided - (let ((byte-compile-not-obsolete-vars (list var))) - (if (eq fun 'defconst) - ;; `defconst' sets `var' unconditionally. - (let ((tmp (make-symbol "defconst-tmp-var"))) - ;; Quote with `quote' to prevent byte-compiling the body, - ;; which would lead to an inf-loop. - `(funcall '(lambda (,tmp) (defconst ,var ,tmp)) - ,value)) - ;; `defvar' sets `var' only when unbound. - `(if (not (default-boundp ',var)) (setq-default ,var ,value)))) - (when (eq fun 'defconst) - ;; This will signal an appropriate error at runtime. - `(eval ',form))) - `',var)))) + (when (and string (not (stringp string))) + (byte-compile-warn "third arg to `%s %s' is not a string: %s" + fun var string)) + (byte-compile-form-do-effect + (if (cddr form) ; `value' provided + ;; Quote with `quote' to prevent byte-compiling the body, + ;; which would lead to an inf-loop. + `(funcall '(lambda (,byte-compile-tmp-var) + (,fun ,var ,byte-compile-tmp-var ,@(nthcdr 3 form))) + ,value) + (if (eq fun 'defconst) + ;; This will signal an appropriate error at runtime. + `(eval ',form) + ;; A simple (defvar foo) just returns foo. + `',var))))) (defun byte-compile-autoload (form) (byte-compile-set-symbol-position 'autoload) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 742a98f5e7b..b6b6a78a9bb 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -1,6 +1,6 @@ ;;; cconv.el --- Closure conversion for statically scoped Emacs lisp. -*- lexical-binding: t; coding: utf-8 -*- -;; Copyright (C) 2011 Free Software Foundation, Inc. +;; Copyright (C) 2011-2012 Free Software Foundation, Inc. ;; Author: Igor Kuzmin <kzuminig@iro.umontreal.ca> ;; Maintainer: FSF @@ -26,21 +26,21 @@ ;; This takes a piece of Elisp code, and eliminates all free variables from ;; lambda expressions. The user entry points are cconv-closure-convert and -;; cconv-closure-convert-toplevel(for toplevel forms). +;; cconv-closure-convert-toplevel (for toplevel forms). ;; All macros should be expanded beforehand. ;; ;; Here is a brief explanation how this code works. -;; Firstly, we analyse the tree by calling cconv-analyse-form. +;; Firstly, we analyze the tree by calling cconv-analyse-form. ;; This function finds all mutated variables, all functions that are suitable ;; for lambda lifting and all variables captured by closure. It passes the tree ;; once, returning a list of three lists. ;; -;; Then we calculate the intersection of first and third lists returned by +;; Then we calculate the intersection of the first and third lists returned by ;; cconv-analyse form to find all mutated variables that are captured by ;; closure. ;; Armed with this data, we call cconv-closure-convert-rec, that rewrites the -;; tree recursivly, lifting lambdas where possible, building closures where it +;; tree recursively, lifting lambdas where possible, building closures where it ;; is needed and eliminating mutable variables used in closure. ;; ;; We do following replacements : @@ -67,7 +67,7 @@ ;; TODO: (not just for cconv but also for the lexbind changes in general) ;; - let (e)debug find the value of lexical variables from the stack. -;; - make eval-region do the eval-sexp-add-defvars danse. +;; - make eval-region do the eval-sexp-add-defvars dance. ;; - byte-optimize-form should be applied before cconv. ;; OTOH, the warnings emitted by cconv-analyze need to come before optimize ;; since afterwards they can because obnoxious (warnings about an "unused @@ -142,7 +142,7 @@ Returns a form where all lambdas don't have any free variables." (let ((cconv-freevars-alist '()) (cconv-lambda-candidates '()) (cconv-captured+mutated '())) - ;; Analyse form - fill these variables with new information. + ;; Analyze form - fill these variables with new information. (cconv-analyse-form form '()) (setq cconv-freevars-alist (nreverse cconv-freevars-alist)) (cconv-convert form nil nil))) ; Env initially empty. @@ -507,7 +507,7 @@ places where they originally did not directly appear." (defalias 'byte-compile-not-lexical-var-p 'boundp)) (defun cconv--analyse-use (vardata form varkind) - "Analyse the use of a variable. + "Analyze the use of a variable. VARDATA should be (BINDER READ MUTATED CAPTURED CALLED). VARKIND is the name of the kind of variable. FORM is the parent form that binds this var." @@ -559,7 +559,7 @@ FORM is the parent form that binds this var." (t (let ((varstruct (list arg nil nil nil nil))) (push (cons (list arg) (cdr varstruct)) newvars) (push varstruct newenv))))) - (dolist (form body) ;Analyse body forms. + (dolist (form body) ;Analyze body forms. (cconv-analyse-form form newenv)) ;; Summarize resulting data about arguments. (dolist (vardata newvars) @@ -581,7 +581,7 @@ FORM is the parent form that binds this var." (defun cconv-analyse-form (form env) "Find mutated variables and variables captured by closure. -Analyse lambdas if they are suitable for lambda lifting. +Analyze lambdas if they are suitable for lambda lifting. - FORM is a piece of Elisp code after macroexpansion. - ENV is an alist mapping each enclosing lexical variable to its info. I.e. each element has the form (VAR . (READ MUTATED CAPTURED CALLED)). @@ -612,7 +612,7 @@ and updates the data stored in ENV." (push (cons binder (cdr varstruct)) newvars) (push varstruct env)))) - (dolist (form body-forms) ; Analyse body forms. + (dolist (form body-forms) ; Analyze body forms. (cconv-analyse-form form env)) (dolist (vardata newvars) diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el index 56930a74693..19766feac5a 100644 --- a/lisp/emacs-lisp/chart.el +++ b/lisp/emacs-lisp/chart.el @@ -1,6 +1,6 @@ ;;; chart.el --- Draw charts (bar charts, etc) -;; Copyright (C) 1996, 1998-1999, 2001, 2004-2005, 2007-2011 +;; Copyright (C) 1996, 1998-1999, 2001, 2004-2005, 2007-2012 ;; Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> @@ -169,7 +169,7 @@ Make sure the width/height is correct." :initform t) (name-face :initarg :name-face :initform 'bold) - (labels-face :initarg :lables-face + (labels-face :initarg :labels-face :initform 'italic) (chart :initarg :chart :initform nil) @@ -634,7 +634,7 @@ SORT-PRED if desired." (setq extlst (cons s extlst) cntlst (cons 1 cntlst))))) (setq flst (cdr flst))) - ;; Lets create the chart! + ;; Let's create the chart! (chart-bar-quickie 'vertical "Files Extension Distribution" extlst "File Extensions" cntlst "# of occurrences" @@ -693,7 +693,7 @@ SORT-PRED if desired." ;(car (nth 5 data)) ; floats are Emacs only ;(cdr (nth 5 data)) ))) - ;; Lets create the chart! + ;; Let's create the chart! (chart-bar-quickie 'vertical "Emacs Runtime Storage Usage" names "Storage Items" nums "Objects"))) @@ -710,7 +710,7 @@ SORT-PRED if desired." (if (fboundp 'x-display-list) (setq names (append names '("x-displays")) nums (append nums (list (length (x-display-list)))))) - ;; Lets create the chart! + ;; Let's create the chart! (chart-bar-quickie 'vertical "Emacs List Size Chart" names "Various Lists" nums "Objects"))) diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el index e15920ef009..3135b9b5827 100644 --- a/lisp/emacs-lisp/check-declare.el +++ b/lisp/emacs-lisp/check-declare.el @@ -1,6 +1,6 @@ ;;; check-declare.el --- Check declare-function statements -;; Copyright (C) 2007-2011 Free Software Foundation, Inc. +;; Copyright (C) 2007-2012 Free Software Foundation, Inc. ;; Author: Glenn Morris <rgm@gnu.org> ;; Keywords: lisp, tools, maint diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 7eb6e6ef765..7a9a33fc2cc 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -1,6 +1,6 @@ ;;; checkdoc.el --- check documentation strings for style requirements -;; Copyright (C) 1997-1998, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1997-1998, 2001-2012 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Version: 0.6.2 @@ -1237,9 +1237,10 @@ generating a buffered list of errors." ;;;###autoload (define-minor-mode checkdoc-minor-mode - "Toggle Checkdoc minor mode, a mode for checking Lisp doc strings. -With prefix ARG, turn Checkdoc minor mode on if ARG is positive, otherwise -turn it off. + "Toggle automatic docstring checking (Checkdoc minor mode). +With a prefix argument ARG, enable Checkdoc minor mode if ARG is +positive, and disable it otherwise. If called from Lisp, enable +the mode if ARG is omitted or nil. In Checkdoc minor mode, the usual bindings for `eval-defun' which is bound to \\<checkdoc-minor-mode-map>\\[checkdoc-eval-defun] and `checkdoc-eval-current-buffer' are overridden to include @@ -1942,7 +1943,7 @@ from the comment." A code fragment is identified by an open parenthesis followed by a symbol which is a valid function or a word in all CAPS, or a parenthesis that is quoted with the ' character. Only the region from START to LIMIT -is is allowed while searching for the bounding parenthesis." +is allowed while searching for the bounding parenthesis." (save-match-data (save-restriction (narrow-to-region start limit) @@ -2117,7 +2118,7 @@ before using the Ispell engine on it." ;; Find out how we spell-check this word. (if (or ;; All caps w/ option th, or s tacked on the end - ;; for pluralization or numberthness. + ;; for pluralization or number. (string-match "^[A-Z][A-Z]+\\(s\\|th\\)?$" word) (looking-at "}") ; a keymap expression ) diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 7468a0237cf..9ac5ce7d2f0 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -1,6 +1,6 @@ ;;; cl-extra.el --- Common Lisp features, part 2 -;; Copyright (C) 1993, 2000-2011 Free Software Foundation, Inc. +;; Copyright (C) 1993, 2000-2012 Free Software Foundation, Inc. ;; Author: Dave Gillespie <daveg@synaptics.com> ;; Keywords: extensions @@ -480,17 +480,13 @@ If STATE is t, return a new state object seeded from the time of day." (and (numberp res) (/= res (/ res 2)) res)) (arith-error nil))) -(defvar most-positive-float) -(defvar most-negative-float) -(defvar least-positive-float) -(defvar least-negative-float) -(defvar least-positive-normalized-float) -(defvar least-negative-normalized-float) -(defvar float-epsilon) -(defvar float-negative-epsilon) - ;;;###autoload (defun cl-float-limits () + "Initialize the Common Lisp floating-point parameters. +This sets the values of: `most-positive-float', `most-negative-float', +`least-positive-float', `least-negative-float', `float-epsilon', +`float-negative-epsilon', `least-positive-normalized-float', and +`least-negative-normalized-float'." (or most-positive-float (not (numberp '2e1)) (let ((x '2e0) y z) ;; Find maximum exponent (first two loops are optimizations) diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el index 40434636e62..01bdfbf4bf2 100644 --- a/lisp/emacs-lisp/cl-indent.el +++ b/lisp/emacs-lisp/cl-indent.el @@ -1,6 +1,6 @@ ;;; cl-indent.el --- enhanced lisp-indent mode -;; Copyright (C) 1987, 2000-2011 Free Software Foundation, Inc. +;; Copyright (C) 1987, 2000-2012 Free Software Foundation, Inc. ;; Author: Richard Mlynarik <mly@eddie.mit.edu> ;; Created: July 1987 @@ -104,6 +104,7 @@ If non-nil, alignment is done with the first keyword \(defun foo (arg1 arg2 &rest rest &key key1 key2) #|...|#)" + :version "24.1" :type 'boolean :group 'lisp-indent) @@ -111,6 +112,7 @@ If non-nil, alignment is done with the first keyword "Indentation of lambda list keyword parameters. See `lisp-lambda-list-keyword-parameter-alignment' for more information." + :version "24.1" :type 'integer :group 'lisp-indent) @@ -130,6 +132,7 @@ If non-nil, alignment is done with the first parameter \(defun foo (arg1 arg2 &key key1 key2 key3 key4) #|...|#)" + :version "24.1" :type 'boolean :group 'lisp-indent) @@ -159,14 +162,19 @@ is set to `defun'.") (current-column)))) (goto-char indent-point) (beginning-of-line) - (cond ((not (extended-loop-p (elt state 1))) - (+ loop-indentation lisp-simple-loop-indentation)) - ((looking-at "^\\s-*\\(:?\\sw+\\|;\\)") - (+ loop-indentation lisp-loop-keyword-indentation)) - (t - (+ loop-indentation lisp-loop-forms-indentation))))) - - + (list + (cond ((not (extended-loop-p (elt state 1))) + (+ loop-indentation lisp-simple-loop-indentation)) + ((looking-at "^\\s-*\\(:?\\sw+\\|;\\)") + (+ loop-indentation lisp-loop-keyword-indentation)) + (t + (+ loop-indentation lisp-loop-forms-indentation))) + ;; Tell the caller that the next line needs recomputation, even + ;; though it doesn't start a sexp. + loop-indentation))) + + +;; Cf (info "(elisp)Specification List") ;;;###autoload (defun common-lisp-indent-function (indent-point state) "Function to indent the arguments of a Lisp function call. diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 48c7386bd43..5bb86628bb8 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -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" "26339d9571f9485bf34fa6d2ae38fc84") +;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "c172dda6770ce18b556561481bfefbb2") ;;; Generated autoloads from cl-extra.el (autoload 'coerce "cl-extra" "\ @@ -28,7 +28,7 @@ strings case-insensitively. \(fn X Y)" nil nil) (autoload 'cl-mapcar-many "cl-extra" "\ -Not documented + \(fn CL-FUNC CL-SEQS)" nil nil) @@ -84,27 +84,27 @@ Return true if PREDICATE is false of some element of SEQ or SEQs. (defalias 'cl-map-keymap 'map-keymap) (autoload 'cl-map-keymap-recursively "cl-extra" "\ -Not documented + \(fn CL-FUNC-REC CL-MAP &optional CL-BASE)" nil nil) (autoload 'cl-map-intervals "cl-extra" "\ -Not documented + \(fn CL-FUNC &optional CL-WHAT CL-PROP CL-START CL-END)" nil nil) (autoload 'cl-map-overlays "cl-extra" "\ -Not documented + \(fn CL-FUNC &optional CL-BUFFER CL-START CL-END CL-ARG)" nil nil) (autoload 'cl-set-frame-visible-p "cl-extra" "\ -Not documented + \(fn FRAME VAL)" nil nil) (autoload 'cl-progv-before "cl-extra" "\ -Not documented + \(fn SYMS VALUES)" nil nil) @@ -180,7 +180,11 @@ Return t if OBJECT is a random-state object. \(fn OBJECT)" nil nil) (autoload 'cl-float-limits "cl-extra" "\ -Not documented +Initialize the Common Lisp floating-point parameters. +This sets the values of: `most-positive-float', `most-negative-float', +`least-positive-float', `least-negative-float', `float-epsilon', +`float-negative-epsilon', `least-positive-normalized-float', and +`least-negative-normalized-float'. \(fn)" nil nil) @@ -228,12 +232,12 @@ PROPLIST is a list of the sort returned by `symbol-plist'. \(fn PROPLIST PROPNAME &optional DEFAULT)" nil nil) (autoload 'cl-set-getf "cl-extra" "\ -Not documented + \(fn PLIST TAG VAL)" nil nil) (autoload 'cl-do-remf "cl-extra" "\ -Not documented + \(fn PLIST TAG)" nil nil) @@ -267,7 +271,7 @@ This also does some trivial optimizations to make the form prettier. \(fn FORM &optional ENV)" nil nil) (autoload 'cl-prettyexpand "cl-extra" "\ -Not documented + \(fn FORM &optional FULL)" nil nil) @@ -282,7 +286,7 @@ Not documented ;;;;;; flet progv psetq 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" "9f551dc739a39b3c8b420fbd1ab71879") +;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "91b45885535a73dd8015973cb8c988e1") ;;; Generated autoloads from cl-macs.el (autoload 'gensym "cl-macs" "\ @@ -426,6 +430,7 @@ The Common Lisp `do*' loop. Loop over a list. Evaluate BODY with VAR bound to each `car' from LIST, in turn. Then evaluate RESULT to get return value, default nil. +An implicit nil block is established around the loop. \(fn (VAR LIST [RESULT]) BODY...)" nil (quote macro)) @@ -541,7 +546,13 @@ values. For compatibility, (values A B C) is a synonym for (list A B C). \(fn TYPE FORM)" nil (quote macro)) (autoload 'declare "cl-macs" "\ +Declare SPECS about the current function while compiling. +For instance + (declare (warn 0)) + +will turn off byte-compile warnings in the function. +See Info node `(cl)Declarations' for details. \(fn &rest SPECS)" nil (quote macro)) @@ -759,7 +770,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" "df375ddc313f0c1c262cacab5cffd3e4") +;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "99095e49c83af1c8bec0fdcf517b3f95") ;;; Generated autoloads from cl-seq.el (autoload 'reduce "cl-seq" "\ @@ -1037,7 +1048,7 @@ Keywords supported: :key \(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil) (autoload 'cl-adjoin "cl-seq" "\ -Not documented + \(fn CL-ITEM CL-LIST &rest CL-KEYS)" nil nil) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 2813cc4f065..4fc71bbbc60 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -1,6 +1,6 @@ ;;; cl-macs.el --- Common Lisp macros -;; Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc. ;; Author: Dave Gillespie <daveg@synaptics.com> ;; Version: 2.02 @@ -238,6 +238,37 @@ It is a list of elements of the form either: (declare-function help-add-fundoc-usage "help-fns" (docstring arglist)) +(defun cl--make-usage-var (x) + "X can be a var or a (destructuring) lambda-list." + (cond + ((symbolp x) (make-symbol (upcase (symbol-name x)))) + ((consp x) (cl--make-usage-args x)) + (t x))) + +(defun cl--make-usage-args (arglist) + ;; `orig-args' can contain &cl-defs (an internal + ;; CL thingy I don't understand), so remove it. + (let ((x (memq '&cl-defs arglist))) + (when x (setq arglist (delq (car x) (remq (cadr x) arglist))))) + (let ((state nil)) + (mapcar (lambda (x) + (cond + ((symbolp x) + (if (eq ?\& (aref (symbol-name x) 0)) + (setq state x) + (make-symbol (upcase (symbol-name x))))) + ((not (consp x)) x) + ((memq state '(nil &rest)) (cl--make-usage-args x)) + (t ;(VAR INITFORM SVAR) or ((KEYWORD VAR) INITFORM SVAR). + (list* + (if (and (consp (car x)) (eq state '&key)) + (list (caar x) (cl--make-usage-var (nth 1 (car x)))) + (cl--make-usage-var (car x))) + (nth 1 x) ;INITFORM. + (cl--make-usage-args (nthcdr 2 x)) ;SVAR. + )))) + arglist))) + (defun cl-transform-lambda (form bind-block) (let* ((args (car form)) (body (cdr form)) (orig-args args) (bind-defs nil) (bind-enquote nil) @@ -282,11 +313,8 @@ It is a list of elements of the form either: (require 'help-fns) (cons (help-add-fundoc-usage (if (stringp (car hdr)) (pop hdr)) - ;; orig-args can contain &cl-defs (an internal - ;; CL thingy I don't understand), so remove it. - (let ((x (memq '&cl-defs orig-args))) - (if (null x) orig-args - (delq (car x) (remq (cadr x) orig-args))))) + (format "(fn %S)" + (cl--make-usage-args orig-args))) hdr))) (list (nconc (list 'let* bind-lets) (nreverse bind-forms) body))))))) @@ -1233,6 +1261,7 @@ Valid clauses are: "Loop over a list. Evaluate BODY with VAR bound to each `car' from LIST, in turn. Then evaluate RESULT to get return value, default nil. +An implicit nil block is established around the loop. \(fn (VAR LIST [RESULT]) BODY...)" (let ((temp (make-symbol "--cl-dolist-temp--"))) @@ -1601,6 +1630,13 @@ values. For compatibility, (values A B C) is a synonym for (list A B C). ;;;###autoload (defmacro declare (&rest specs) + "Declare SPECS about the current function while compiling. +For instance + + \(declare (warn 0)) + +will turn off byte-compile warnings in the function. +See Info node `(cl)Declarations' for details." (if (cl-compiling-file) (while specs (if (listp cl-declare-stack) (push (car specs) cl-declare-stack)) @@ -2380,17 +2416,17 @@ value, that slot cannot be set via `setf'. (append (and pred-check (list (list 'or pred-check - (list 'error - (format "%s accessing a non-%s" - accessor name))))) + `(error "%s accessing a non-%s" + ',accessor ',name)))) (list (if (eq type 'vector) (list 'aref 'cl-x pos) (if (= pos 0) '(car cl-x) (list 'nth pos 'cl-x)))))) forms) (push (cons accessor t) side-eff) (push (list 'define-setf-method accessor '(cl-x) (if (cadr (memq :read-only (cddr desc))) - (list 'error (format "%s is a read-only slot" - accessor)) + (list 'progn '(ignore cl-x) + `(error "%s is a read-only slot" + ',accessor)) ;; If cl is loaded only for compilation, ;; the call to cl-struct-setf-expander would ;; cause a warning because it may not be diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el index 1c578556835..f1890fbccf6 100644 --- a/lisp/emacs-lisp/cl-seq.el +++ b/lisp/emacs-lisp/cl-seq.el @@ -1,6 +1,6 @@ ;;; cl-seq.el --- Common Lisp features, part 3 -;; Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc. ;; Author: Dave Gillespie <daveg@synaptics.com> ;; Version: 2.02 diff --git a/lisp/emacs-lisp/cl-specs.el b/lisp/emacs-lisp/cl-specs.el index 3556b6c1ecf..dbadf06944f 100644 --- a/lisp/emacs-lisp/cl-specs.el +++ b/lisp/emacs-lisp/cl-specs.el @@ -1,6 +1,6 @@ ;;; cl-specs.el --- Edebug specs for cl.el -*- no-byte-compile: t -*- -;; Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc. ;; Author: Daniel LaLiberte <liberte@holonexus.org> ;; Keywords: lisp, tools, maint ;; Package: emacs diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index 526475eb1bd..971024fcbba 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -1,6 +1,6 @@ ;;; cl.el --- Common Lisp extensions for Emacs -;; Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc. ;; Author: Dave Gillespie <daveg@synaptics.com> ;; Version: 2.02 @@ -333,15 +333,51 @@ always returns nil." (defvar *random-state* (vector 'cl-random-state-tag -1 30 (cl-random-time))) -;; The following are actually set by cl-float-limits. -(defconst most-positive-float nil) -(defconst most-negative-float nil) -(defconst least-positive-float nil) -(defconst least-negative-float nil) -(defconst least-positive-normalized-float nil) -(defconst least-negative-normalized-float nil) -(defconst float-epsilon nil) -(defconst float-negative-epsilon nil) +(defconst most-positive-float nil + "The largest value that a Lisp float can hold. +If your system supports infinities, this is the largest finite value. +For IEEE machines, this is approximately 1.79e+308. +Call `cl-float-limits' to set this.") + +(defconst most-negative-float nil + "The largest negative value that a Lisp float can hold. +This is simply -`most-positive-float'. +Call `cl-float-limits' to set this.") + +(defconst least-positive-float nil + "The smallest value greater than zero that a Lisp float can hold. +For IEEE machines, it is about 4.94e-324 if denormals are supported, +or 2.22e-308 if they are not. +Call `cl-float-limits' to set this.") + +(defconst least-negative-float nil + "The smallest value less than zero that a Lisp float can hold. +This is simply -`least-positive-float'. +Call `cl-float-limits' to set this.") + +(defconst least-positive-normalized-float nil + "The smallest normalized Lisp float greater than zero. +This is the smallest value for which IEEE denormalization does not lose +precision. For IEEE machines, this value is about 2.22e-308. +For machines that do not support the concept of denormalization +and gradual underflow, this constant equals `least-positive-float'. +Call `cl-float-limits' to set this.") + +(defconst least-negative-normalized-float nil + "The smallest normalized Lisp float less than zero. +This is simply -`least-positive-normalized-float'. +Call `cl-float-limits' to set this.") + +(defconst float-epsilon nil + "The smallest positive float that adds to 1.0 to give a distinct value. +Adding a number less than this to 1.0 returns 1.0 due to roundoff. +For IEEE machines, epsilon is about 2.22e-16. +Call `cl-float-limits' to set this.") + +(defconst float-negative-epsilon nil + "The smallest positive float that subtracts from 1.0 to give a distinct value. +For IEEE machines, it is about 1.11e-16. +Call `cl-float-limits' to set this.") ;;; Sequence functions. diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el index 582785a0e90..09b456b54ba 100644 --- a/lisp/emacs-lisp/copyright.el +++ b/lisp/emacs-lisp/copyright.el @@ -1,6 +1,6 @@ ;;; copyright.el --- update the copyright notice in current buffer -;; Copyright (C) 1991-1995, 1998, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1991-1995, 1998, 2001-2012 Free Software Foundation, Inc. ;; Author: Daniel Pfeiffer <occitan@esperanto.org> ;; Keywords: maint, tools @@ -85,7 +85,7 @@ The second \\( \\) construct must match the years." "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." +The function `copyright-fix-years' respects this variable." :group 'copyright :type 'boolean :version "24.1") diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el index 3848ab7e6ea..87c9b280bea 100644 --- a/lisp/emacs-lisp/crm.el +++ b/lisp/emacs-lisp/crm.el @@ -1,6 +1,6 @@ ;;; crm.el --- read multiple strings with completion -;; Copyright (C) 1985-1986, 1993-2011 Free Software Foundation, Inc. +;; Copyright (C) 1985-1986, 1993-2012 Free Software Foundation, Inc. ;; Author: Sen Nagata <sen@eccosys.com> ;; Keywords: completion, minibuffer, multiple elements @@ -143,7 +143,7 @@ nil if none. The value of FLAG is used to specify the type of completion operation. A value of nil specifies `try-completion'. A value of t specifies -`all-completions'. A value of lambda specifes a test for an exact match. +`all-completions'. A value of lambda specifies a test for an exact match. For more information on STRING, PREDICATE, and FLAG, see the Elisp Reference sections on 'Programmed Completion' and 'Basic Completion diff --git a/lisp/emacs-lisp/cust-print.el b/lisp/emacs-lisp/cust-print.el index e7f9aae1c60..b456d59e8da 100644 --- a/lisp/emacs-lisp/cust-print.el +++ b/lisp/emacs-lisp/cust-print.el @@ -1,6 +1,6 @@ ;;; cust-print.el --- handles print-level and print-circle -;; Copyright (C) 1992, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc. ;; Author: Daniel LaLiberte <liberte@holonexus.org> ;; Adapted-By: ESR diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 2fa339e62fe..b0813aebef6 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -1,6 +1,6 @@ ;;; debug.el --- debuggers and related commands for Emacs -;; Copyright (C) 1985-1986, 1994, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1985-1986, 1994, 2001-2012 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: lisp, tools, maint @@ -98,11 +98,21 @@ and `debugger-reenable' to temporarily disable debug-on-entry.") (defvar inhibit-trace) ;Not yet implemented. +(defvar debugger-args nil + "Arguments with which the debugger was called. +It is a list expected to take the form (CAUSE . REST) +where CAUSE can be: +- debug: called for entry to a flagged function. +- t: called because of debug-on-next-call. +- lambda: same thing but via `funcall'. +- exit: called because of exit of a flagged function. +- error: called because of `debug-on-error'.") + ;;;###autoload (setq debugger 'debug) ;;;###autoload (defun debug (&rest debugger-args) - "Enter debugger. To return, type \\<debugger-mode-map>`\\[debugger-continue]'. + "Enter debugger. \\<debugger-mode-map>`\\[debugger-continue]' returns from the debugger. Arguments are mainly for use when this is called from the internals of the evaluator. @@ -296,32 +306,33 @@ That buffer should be current already." (insert "Debugger entered") ;; lambda is for debug-on-call when a function call is next. ;; debug is for debug-on-entry function called. - (cond ((memq (car debugger-args) '(lambda debug)) - (insert "--entering a function:\n")) - ;; Exiting a function. - ((eq (car debugger-args) 'exit) - (insert "--returning value: ") - (setq debugger-value (nth 1 debugger-args)) - (prin1 debugger-value (current-buffer)) - (insert ?\n) - (delete-char 1) - (insert ? ) - (beginning-of-line)) - ;; Debugger entered for an error. - ((eq (car debugger-args) 'error) - (insert "--Lisp error: ") - (prin1 (nth 1 debugger-args) (current-buffer)) - (insert ?\n)) - ;; debug-on-call, when the next thing is an eval. - ((eq (car debugger-args) t) - (insert "--beginning evaluation of function call form:\n")) - ;; User calls debug directly. - (t - (insert ": ") - (prin1 (if (eq (car debugger-args) 'nil) - (cdr debugger-args) debugger-args) - (current-buffer)) - (insert ?\n))) + (pcase (car debugger-args) + ((or `lambda `debug) + (insert "--entering a function:\n")) + ;; Exiting a function. + (`exit + (insert "--returning value: ") + (setq debugger-value (nth 1 debugger-args)) + (prin1 debugger-value (current-buffer)) + (insert ?\n) + (delete-char 1) + (insert ? ) + (beginning-of-line)) + ;; Debugger entered for an error. + (`error + (insert "--Lisp error: ") + (prin1 (nth 1 debugger-args) (current-buffer)) + (insert ?\n)) + ;; debug-on-call, when the next thing is an eval. + (`t + (insert "--beginning evaluation of function call form:\n")) + ;; User calls debug directly. + (_ + (insert ": ") + (prin1 (if (eq (car debugger-args) 'nil) + (cdr debugger-args) debugger-args) + (current-buffer)) + (insert ?\n))) ;; After any frame that uses eval-buffer, ;; insert a line that states the buffer position it's reading at. (save-excursion @@ -342,71 +353,72 @@ That buffer should be current already." "Attach cross-references to function names in the `*Backtrace*' buffer." (interactive "b") (with-current-buffer (or buffer (current-buffer)) - (setq buffer (current-buffer)) - (let ((inhibit-read-only t) - (old-end (point-min)) (new-end (point-min))) - ;; If we saved an old backtrace, find the common part - ;; between the new and the old. - ;; Compare line by line, starting from the end, - ;; because that's the part that is likely to be unchanged. - (if debugger-previous-backtrace - (let (old-start new-start (all-match t)) - (goto-char (point-max)) - (with-temp-buffer - (insert debugger-previous-backtrace) - (while (and all-match (not (bobp))) - (setq old-end (point)) - (forward-line -1) - (setq old-start (point)) - (with-current-buffer buffer - (setq new-end (point)) + (save-excursion + (setq buffer (current-buffer)) + (let ((inhibit-read-only t) + (old-end (point-min)) (new-end (point-min))) + ;; If we saved an old backtrace, find the common part + ;; between the new and the old. + ;; Compare line by line, starting from the end, + ;; because that's the part that is likely to be unchanged. + (if debugger-previous-backtrace + (let (old-start new-start (all-match t)) + (goto-char (point-max)) + (with-temp-buffer + (insert debugger-previous-backtrace) + (while (and all-match (not (bobp))) + (setq old-end (point)) (forward-line -1) - (setq new-start (point))) - (if (not (zerop - (let ((case-fold-search nil)) - (compare-buffer-substrings - (current-buffer) old-start old-end - buffer new-start new-end)))) - (setq all-match nil)))) - ;; Now new-end is the position of the start of the - ;; unchanged part in the current buffer, and old-end is - ;; the position of that same text in the saved old - ;; backtrace. But we must subtract (point-min) since strings are - ;; indexed in origin 0. - - ;; Replace the unchanged part of the backtrace - ;; with the text from debugger-previous-backtrace, - ;; since that already has the proper xrefs. - ;; With this optimization, we only need to scan - ;; the changed part of the backtrace. - (delete-region new-end (point-max)) - (goto-char (point-max)) - (insert (substring debugger-previous-backtrace - (- old-end (point-min)))) - ;; Make the unchanged part of the backtrace inaccessible - ;; so it won't be scanned. - (narrow-to-region (point-min) new-end))) - - ;; Scan the new part of the backtrace, inserting xrefs. - (goto-char (point-min)) - (while (progn - (goto-char (+ (point) 2)) - (skip-syntax-forward "^w_") - (not (eobp))) - (let* ((beg (point)) - (end (progn (skip-syntax-forward "w_") (point))) - (sym (intern-soft (buffer-substring-no-properties - beg end))) - (file (and sym (symbol-file sym 'defun)))) - (when file - (goto-char beg) - ;; help-xref-button needs to operate on something matched - ;; by a regexp, so set that up for it. - (re-search-forward "\\(\\sw\\|\\s_\\)+") - (help-xref-button 0 'help-function-def sym file))) - (forward-line 1)) - (widen)) - (setq debugger-previous-backtrace (buffer-string)))) + (setq old-start (point)) + (with-current-buffer buffer + (setq new-end (point)) + (forward-line -1) + (setq new-start (point))) + (if (not (zerop + (let ((case-fold-search nil)) + (compare-buffer-substrings + (current-buffer) old-start old-end + buffer new-start new-end)))) + (setq all-match nil)))) + ;; Now new-end is the position of the start of the + ;; unchanged part in the current buffer, and old-end is + ;; the position of that same text in the saved old + ;; backtrace. But we must subtract (point-min) since strings are + ;; indexed in origin 0. + + ;; Replace the unchanged part of the backtrace + ;; with the text from debugger-previous-backtrace, + ;; since that already has the proper xrefs. + ;; With this optimization, we only need to scan + ;; the changed part of the backtrace. + (delete-region new-end (point-max)) + (goto-char (point-max)) + (insert (substring debugger-previous-backtrace + (- old-end (point-min)))) + ;; Make the unchanged part of the backtrace inaccessible + ;; so it won't be scanned. + (narrow-to-region (point-min) new-end))) + + ;; Scan the new part of the backtrace, inserting xrefs. + (goto-char (point-min)) + (while (progn + (goto-char (+ (point) 2)) + (skip-syntax-forward "^w_") + (not (eobp))) + (let* ((beg (point)) + (end (progn (skip-syntax-forward "w_") (point))) + (sym (intern-soft (buffer-substring-no-properties + beg end))) + (file (and sym (symbol-file sym 'defun)))) + (when file + (goto-char beg) + ;; help-xref-button needs to operate on something matched + ;; by a regexp, so set that up for it. + (re-search-forward "\\(\\sw\\|\\s_\\)+") + (help-xref-button 0 'help-function-def sym file))) + (forward-line 1)) + (widen)) + (setq debugger-previous-backtrace (buffer-string))))) (defun debugger-step-through () "Proceed, stepping through subexpressions of this expression. @@ -438,6 +450,10 @@ Enter another debugger on next entry to eval, apply or funcall." This is only useful when the value returned from the debugger will be used, such as in a debug on exit from a frame." (interactive "XReturn value (evaluated): ") + (when (memq (car debugger-args) '(t lambda error debug)) + (error "Cannot return a value %s" + (if (eq (car debugger-args) 'error) + "from an error" "at function entrance"))) (setq debugger-value val) (princ "Returning " t) (prin1 debugger-value) @@ -778,6 +794,7 @@ Redefining FUNCTION also cancels it." (not (debugger-special-form-p symbol)))) t nil nil (symbol-name fn))) (list (if (equal val "") fn (intern val))))) + ;; FIXME: Use advice.el. (when (debugger-special-form-p function) (error "Function %s is a special form" function)) (if (or (symbolp (symbol-function function)) @@ -835,24 +852,32 @@ To specify a nil argument interactively, exit with an empty minibuffer." (message "Cancelling debug-on-entry for all functions") (mapcar 'cancel-debug-on-entry debug-function-list))) +(defun debug-arglist (definition) + ;; FIXME: copied from ad-arglist. + "Return the argument list of DEFINITION." + (require 'help-fns) + (help-function-arglist definition 'preserve-names)) + (defun debug-convert-byte-code (function) (let* ((defn (symbol-function function)) (macro (eq (car-safe defn) 'macro))) (when macro (setq defn (cdr defn))) - (unless (consp defn) - ;; Assume a compiled code object. - (let* ((contents (append defn nil)) + (when (byte-code-function-p defn) + (let* ((args (debug-arglist defn)) (body - (list (list 'byte-code (nth 1 contents) - (nth 2 contents) (nth 3 contents))))) - (if (nthcdr 5 contents) - (setq body (cons (list 'interactive (nth 5 contents)) body))) - (if (nth 4 contents) + `((,(if (memq '&rest args) #'apply #'funcall) + ,defn + ,@(remq '&rest (remq '&optional args)))))) + (if (> (length defn) 5) + ;; The mere presence of field 5 is sufficient to make + ;; it interactive. + (push `(interactive ,(aref defn 5)) body)) + (if (and (> (length defn) 4) (aref defn 4)) ;; Use `documentation' here, to get the actual string, ;; in case the compiled function has a reference ;; to the .elc file. (setq body (cons (documentation function) body))) - (setq defn (cons 'lambda (cons (car contents) body)))) + (setq defn `(closure (t) ,args ,@body))) (when macro (setq defn (cons 'macro defn))) (fset function defn)))) @@ -861,11 +886,12 @@ To specify a nil argument interactively, exit with an empty minibuffer." (tail defn)) (when (eq (car-safe tail) 'macro) (setq tail (cdr tail))) - (if (not (eq (car-safe tail) 'lambda)) + (if (not (memq (car-safe tail) '(closure lambda))) ;; Only signal an error when we try to set debug-on-entry. ;; When we try to clear debug-on-entry, we are now done. (when flag (error "%s is not a user-defined Lisp function" function)) + (if (eq (car tail) 'closure) (setq tail (cdr tail))) (setq tail (cdr tail)) ;; Skip the docstring. (when (and (stringp (cadr tail)) (cddr tail)) @@ -875,9 +901,9 @@ To specify a nil argument interactively, exit with an empty minibuffer." (setq tail (cdr tail))) (unless (eq flag (equal (cadr tail) '(implement-debug-on-entry))) ;; Add/remove debug statement as needed. - (if flag - (setcdr tail (cons '(implement-debug-on-entry) (cdr tail))) - (setcdr tail (cddr tail))))) + (setcdr tail (if flag + (cons '(implement-debug-on-entry) (cdr tail)) + (cddr tail))))) defn)) (defun debugger-list-functions () diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index 4fda2bf1d52..119479b2c0a 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -1,7 +1,7 @@ ;;; derived.el --- allow inheritance of major modes ;; (formerly mode-clone.el) -;; Copyright (C) 1993-1994, 1999, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1993-1994, 1999, 2001-2012 Free Software Foundation, Inc. ;; Author: David Megginson (dmeggins@aix1.uottawa.ca) ;; Maintainer: FSF @@ -133,10 +133,10 @@ BODY can start with a bunch of keyword arguments. The following keyword Declare the customization group that corresponds to this mode. The command `customize-mode' uses this. :syntax-table TABLE - Use TABLE instead of the default. + Use TABLE instead of the default (CHILD-syntax-table). A nil value means to simply use the same syntax-table as the parent. :abbrev-table TABLE - Use TABLE instead of the default. + Use TABLE instead of the default (CHILD-abbrev-table). A nil value means to simply use the same abbrev-table as the parent. Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode: @@ -230,7 +230,7 @@ No problems result if this variable is not bound. ; Run the parent. (delay-mode-hooks - (,(or parent 'fundamental-mode)) + (,(or parent 'kill-all-local-variables)) ; Identify the child mode. (setq major-mode (quote ,child)) (setq mode-name ,name) diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el index 2a41e611dc0..506a737d36d 100644 --- a/lisp/emacs-lisp/disass.el +++ b/lisp/emacs-lisp/disass.el @@ -1,6 +1,6 @@ ;;; disass.el --- disassembler for compiled Emacs Lisp code -;; Copyright (C) 1986, 1991, 2002-2011 Free Software Foundation, Inc. +;; Copyright (C) 1986, 1991, 2002-2012 Free Software Foundation, Inc. ;; Author: Doug Cutting <doug@csli.stanford.edu> ;; Jamie Zawinski <jwz@lucid.com> diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 46dc1f162ba..88698a1f069 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -1,6 +1,6 @@ ;;; easy-mmode.el --- easy definition for major and minor modes -;; Copyright (C) 1997, 2000-2011 Free Software Foundation, Inc. +;; Copyright (C) 1997, 2000-2012 Free Software Foundation, Inc. ;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr> ;; Maintainer: Stefan Monnier <monnier@gnu.org> @@ -86,16 +86,26 @@ replacing its case-insensitive matches with the literal string in LIGHTER." ;;;###autoload (defmacro define-minor-mode (mode doc &optional init-value lighter keymap &rest body) "Define a new minor mode MODE. -This defines the control variable MODE and the toggle command MODE. +This defines the toggle command MODE and (by default) a control variable +MODE (you can override this with the :variable keyword, see below). DOC is the documentation for the mode toggle command. +The defined mode command takes one optional (prefix) argument. +Interactively with no prefix argument it toggles the mode. +With a prefix argument, it enables the mode if the argument is +positive and otherwise disables it. When called from Lisp, it +enables the mode if the argument is omitted or nil, and toggles +the mode if the argument is `toggle'. If DOC is nil this +function adds a basic doc-string stating these facts. + 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), 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. + arguments for `easy-mmode-define-keymap'. If you supply a KEYMAP + argument that is not a symbol, this macro defines the variable + MODE-map and gives it the value that KEYMAP specifies. 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. @@ -112,15 +122,21 @@ BODY contains code to execute each time the mode is enabled or disabled. buffer-local, so don't make the variable MODE buffer-local. By default, the mode is buffer-local. :init-value VAL Same as the INIT-VALUE argument. + Not used if you also specify :variable. :lighter SPEC Same as the LIGHTER argument. :keymap MAP Same as the KEYMAP argument. :require SYM Same as in `defcustom'. -:variable PLACE The location (as can be used with `setf') to use instead - of the variable MODE to store the state of the mode. PLACE - can also be of the form (GET . SET) where GET is an expression - that returns the current state and SET is a function that takes - a new state and sets it. If you specify a :variable, this - function assumes it is defined elsewhere. +:variable PLACE The location to use instead of the variable MODE to store + the state of the mode. This can be simply a different + named variable, or more generally anything that can be used + with the CL macro `setf'. PLACE can also be of the form + \(GET . SET), where GET is an expression that returns the + current state, and SET is a function that takes one argument, + the new state, and sets it. If you specify a :variable, + this function does not define a MODE variable (nor any of + the terms used in :variable). +:after-hook A single lisp form which is evaluated after the mode hooks + have been run. It should not be quoted. For example, you could write (define-minor-mode foo-mode \"If enabled, foo on you!\" @@ -156,10 +172,11 @@ For example, you could write (setter nil) ;The function (if any) to set the mode var. (modefun mode) ;The minor mode function name we're defining. (require t) + (after-hook nil) (hook (intern (concat mode-name "-hook"))) (hook-on (intern (concat mode-name "-on-hook"))) (hook-off (intern (concat mode-name "-off-hook"))) - keyw keymap-sym) + keyw keymap-sym tmp) ;; Check keys. (while (keywordp (setq keyw (car body))) @@ -176,11 +193,14 @@ For example, you could write (:require (setq require (pop body))) (:keymap (setq keymap (pop body))) (:variable (setq variable (pop body)) - (if (not (functionp (cdr-safe variable))) + (if (not (and (setq tmp (cdr-safe variable)) + (or (symbolp tmp) + (functionp tmp)))) ;; PLACE is not of the form (GET . SET). (setq mode variable) (setq mode (car variable)) (setq setter (cdr variable)))) + (:after-hook (setq after-hook (pop body))) (t (push keyw extra-keywords) (push (pop body) extra-keywords)))) (setq keymap-sym (if (and keymap (symbolp keymap)) keymap @@ -232,10 +252,10 @@ or call the function `%s'.")))) (defun ,modefun (&optional arg ,@extra-args) ,(or doc (format (concat "Toggle %s on or off. -Interactively, with no prefix argument, toggle the mode. -With universal prefix ARG turn mode on. -With zero or negative ARG turn mode off. -\\{%s}") pretty-name keymap-sym)) +With a prefix argument ARG, enable %s if ARG is +positive, and disable it otherwise. If called from Lisp, enable +the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. +\\{%s}") pretty-name pretty-name keymap-sym)) ;; Use `toggle' rather than (if ,mode 0 1) so that using ;; repeat-command still does the toggling correctly. (interactive (list (or current-prefix-arg 'toggle))) @@ -259,7 +279,8 @@ With zero or negative ARG turn mode off. (not (equal ,last-message (current-message)))) (message ,(format "%s %%sabled" pretty-name) - (if ,mode "en" "dis")))))) + (if ,mode "en" "dis"))))) + ,@(when after-hook `(,after-hook))) (force-mode-line-update) ;; Return the new setting. ,mode) @@ -285,7 +306,7 @@ With zero or negative ARG turn mode off. ,(if keymap keymap-sym `(if (boundp ',keymap-sym) ,keymap-sym)) nil - ,(unless (eq mode modefun) 'modefun))))))) + ,(unless (eq mode modefun) `',modefun))))))) ;;; ;;; make global minor mode @@ -350,14 +371,16 @@ call another major mode in their body." (define-minor-mode ,global-mode ;; Very short lines to avoid too long lines in the generated ;; doc string. - ,(format "Toggle %s in every possible buffer. -With prefix ARG, turn %s on if and only if -ARG is positive. + ,(format "Toggle %s in all buffers. +With prefix ARG, enable %s if ARG is positive; +otherwise, disable it. If called from Lisp, enable the mode if +ARG is omitted or nil. + %s is enabled in all buffers where \`%s' would do it. See `%s' for more information on %s." - pretty-name pretty-global-name pretty-name turn-on - mode pretty-name) + pretty-name pretty-global-name + pretty-name turn-on mode pretty-name) :global t ,@group ,@(nreverse extra-keywords) ;; Setup hook to handle future mode changes and new buffers. @@ -365,11 +388,13 @@ See `%s' for more information on %s." (progn (add-hook 'after-change-major-mode-hook ',MODE-enable-in-buffers) - (add-hook 'fundamental-mode-hook ',MODE-enable-in-buffers) + (add-hook 'change-major-mode-after-body-hook + ',MODE-enable-in-buffers) (add-hook 'find-file-hook ',MODE-check-buffers) (add-hook 'change-major-mode-hook ',MODE-cmhh)) (remove-hook 'after-change-major-mode-hook ',MODE-enable-in-buffers) - (remove-hook 'fundamental-mode-hook ',MODE-enable-in-buffers) + (remove-hook 'change-major-mode-after-body-hook + ',MODE-enable-in-buffers) (remove-hook 'find-file-hook ',MODE-check-buffers) (remove-hook 'change-major-mode-hook ',MODE-cmhh)) diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index 79573437146..b3e54b415d8 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el @@ -1,6 +1,6 @@ ;;; easymenu.el --- support the easymenu interface for defining a menu -;; Copyright (C) 1994, 1996, 1998-2011 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1996, 1998-2012 Free Software Foundation, Inc. ;; Keywords: emulations ;; Author: Richard Stallman <rms@gnu.org> @@ -99,7 +99,7 @@ KEYS is expanded with `substitute-command-keys' before it is used. KEYS is nil, a string or a vector; nil or a keyboard equivalent to this menu item. -This is a hint that will considerably speed up Emacs' first display of +This is a hint that will considerably speed up Emacs's first display of a menu. Use `:key-sequence nil' when you know that this menu item has no keyboard equivalent. diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index f84de0308bf..c241ac710cf 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1,6 +1,6 @@ ;;; edebug.el --- a source-level debugger for Emacs Lisp -;; Copyright (C) 1988-1995, 1997, 1999-2011 Free Software Foundation, Inc. +;; Copyright (C) 1988-1995, 1997, 1999-2012 Free Software Foundation, Inc. ;; Author: Daniel LaLiberte <liberte@holonexus.org> ;; Maintainer: FSF @@ -1285,7 +1285,7 @@ expressions; a `progn' form will be returned enclosing these forms." ;; Wrap a form, usually a defining form, but any evaluated one. ;; If speclist is non-nil, this is being called by edebug-defining-form. ;; Otherwise it is being called from edebug-read-and-maybe-wrap-form1. - ;; This is a hack, but I havent figured out a simpler way yet. + ;; This is a hack, but I haven't figured out a simpler way yet. (let* ((form-data-entry (edebug-get-form-data-entry form-begin form-end)) ;; Set this marker before parsing. (edebug-form-begin-marker @@ -1557,7 +1557,7 @@ expressions; a `progn' form will be returned enclosing these forms." ;; The first spec is handled and the remainder-handler handles the rest. (let ((edebug-matching-depth (if (> edebug-matching-depth edebug-max-depth) - (error "too deep - perhaps infinite loop in spec?") + (error "Too deep - perhaps infinite loop in spec?") (1+ edebug-matching-depth)))) (cond ((null specs) nil) @@ -3201,7 +3201,7 @@ before returning. The default is one second." "Modify the breakpoint for the form at point or after it. Set it if FLAG is non-nil, clear it otherwise. Then move to that point. If CONDITION or TEMPORARY are non-nil, add those attributes to -the breakpoint. " +the breakpoint." (let ((edebug-stop-point (edebug-find-stop-point))) (if edebug-stop-point (let* ((edebug-def-name (car edebug-stop-point)) @@ -3408,7 +3408,7 @@ go to the end of the last sexp, or if that is the same point, then step." (message "%s is already instrumented." func) func) (t - (let ((loc (find-function-noselect func))) + (let ((loc (find-function-noselect func t))) (unless (cdr loc) (error "Could not find the definition in its file")) (with-current-buffer (car loc) @@ -3448,7 +3448,7 @@ instrumented. Then it does `edebug-on-entry' and switches to `go' mode." (defun edebug-on-entry (function &optional flag) "Cause Edebug to stop when FUNCTION is called. With prefix argument, make this temporary so it is automatically -cancelled the first time the function is entered." +canceled the first time the function is entered." (interactive "aEdebug on entry to: \nP") ;; Could store this in the edebug data instead. (put function 'edebug-on-entry (if flag 'temp t))) @@ -3879,24 +3879,23 @@ Global commands prefixed by `global-edebug-prefix': \\{global-edebug-map} Options: -edebug-setup-hook -edebug-all-defs -edebug-all-forms -edebug-save-windows -edebug-save-displayed-buffer-points -edebug-initial-mode -edebug-trace -edebug-test-coverage -edebug-continue-kbd-macro -edebug-print-length -edebug-print-level -edebug-print-circle -edebug-on-error -edebug-on-quit -edebug-on-signal -edebug-unwrap-results -edebug-global-break-condition -" +`edebug-setup-hook' +`edebug-all-defs' +`edebug-all-forms' +`edebug-save-windows' +`edebug-save-displayed-buffer-points' +`edebug-initial-mode' +`edebug-trace' +`edebug-test-coverage' +`edebug-continue-kbd-macro' +`edebug-print-length' +`edebug-print-level' +`edebug-print-circle' +`edebug-on-error' +`edebug-on-quit' +`edebug-on-signal' +`edebug-unwrap-results' +`edebug-global-break-condition'" ;; If the user kills the buffer in which edebug is currently active, ;; exit to top level, because the edebug command loop can't usefully ;; continue running in such a case. diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index 139f5e6a4ce..b5600560cdd 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el @@ -1,6 +1,6 @@ ;;; eieio-base.el --- Base classes for EIEIO. -;;; Copyright (C) 2000-2002, 2004-2005, 2007-2011 +;;; Copyright (C) 2000-2002, 2004-2005, 2007-2012 ;;; Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> @@ -54,7 +54,7 @@ not been set, use values from the parent." (defmethod slot-unbound ((object eieio-instance-inheritor) class slot-name fn) "If a slot OBJECT in this CLASS is unbound, try to inherit, or throw a signal. -SLOT-NAME is the offending slot. FN is the function signalling the error." +SLOT-NAME is the offending slot. FN is the function signaling the error." (if (slot-boundp object 'parent-instance) ;; It may not look like it, but this line recurses back into this ;; method if the parent instance's slot is unbound. @@ -178,7 +178,7 @@ only one object ever exists." ;; calculate path names relative to a given instance. This will ;; make the saved object location independent by converting all file ;; references to be relative to the directory the object is saved to. -;; You must call `eieio-peristent-path-relative' on each file name +;; You must call `eieio-persistent-path-relative' on each file name ;; saved in your object. (defclass eieio-persistent () ((file :initarg :file diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el index e8d7bea50fa..b09f6b6a0e9 100644 --- a/lisp/emacs-lisp/eieio-custom.el +++ b/lisp/emacs-lisp/eieio-custom.el @@ -1,6 +1,6 @@ ;;; eieio-custom.el -- eieio object customization -;; Copyright (C) 1999-2001, 2005, 2007-2011 Free Software Foundation, Inc. +;; Copyright (C) 1999-2001, 2005, 2007-2012 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Version: 0.2 diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el index 60510e1816c..b7f0deb0ee2 100644 --- a/lisp/emacs-lisp/eieio-datadebug.el +++ b/lisp/emacs-lisp/eieio-datadebug.el @@ -1,6 +1,6 @@ ;;; eieio-datadebug.el --- EIEIO extensions to the data debugger. -;; Copyright (C) 2007-2011 Free Software Foundation, Inc. +;; Copyright (C) 2007-2012 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: OO, lisp diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el index 1b101cef875..10816aaa43c 100644 --- a/lisp/emacs-lisp/eieio-opt.el +++ b/lisp/emacs-lisp/eieio-opt.el @@ -1,6 +1,6 @@ ;;; eieio-opt.el -- eieio optional functions (debug, printing, speedbar) -;; Copyright (C) 1996, 1998-2003, 2005, 2008-2011 +;; Copyright (C) 1996, 1998-2003, 2005, 2008-2012 ;; Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> @@ -92,7 +92,7 @@ Optional HEADERFCN should be called to insert a few bits of info first." (princ "Class ") (prin1 class) (terpri) - ;; Inheritence tree information + ;; Inheritance tree information (let ((pl (class-parents class))) (when pl (princ " Inherits from ") diff --git a/lisp/emacs-lisp/eieio-speedbar.el b/lisp/emacs-lisp/eieio-speedbar.el index d28ecd9615b..f169e3f0cd2 100644 --- a/lisp/emacs-lisp/eieio-speedbar.el +++ b/lisp/emacs-lisp/eieio-speedbar.el @@ -1,6 +1,6 @@ ;;; eieio-speedbar.el -- Classes for managing speedbar displays. -;; Copyright (C) 1999-2002, 2005, 2007-2011 Free Software Foundation, Inc. +;; Copyright (C) 1999-2002, 2005, 2007-2012 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Version: 0.2 @@ -282,7 +282,7 @@ Add one of the child classes to this class to the parent list of a class." :abstract t) -;;; Methods to eieio-speedbar-* which do not need to be overriden +;;; Methods to eieio-speedbar-* which do not need to be overridden ;; (defmethod eieio-speedbar-make-tag-line ((object eieio-speedbar) depth) @@ -409,7 +409,7 @@ Optional DEPTH is the depth we start at." default-directory)))) -;;; Methods to the eieio-speedbar-* classes which need to be overriden. +;;; Methods to the eieio-speedbar-* classes which need to be overridden. ;; (defmethod eieio-speedbar-object-children ((object eieio-speedbar)) "Return a list of children to be displayed in speedbar. diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 83c09b6fe0f..cdf7237b766 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -1,7 +1,7 @@ ;;; eieio.el --- Enhanced Implementation of Emacs Interpreted Objects -;;; or maybe Eric's Implementation of Emacs Intrepreted Objects +;;; or maybe Eric's Implementation of Emacs Interpreted Objects -;; Copyright (C) 1995-1996, 1998-2011 Free Software Foundation, Inc. +;; Copyright (C) 1995-1996, 1998-2012 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Version: 1.3 @@ -57,7 +57,7 @@ (eval-and-compile ;; About the above. EIEIO must process its own code when it compiles -;; itself, thus, by eval-and-compiling outselves, we solve the problem. +;; itself, thus, by eval-and-compiling ourselves, we solve the problem. ;; Compatibility (if (fboundp 'compiled-function-arglist) @@ -395,7 +395,7 @@ It creates an autoload function for CNAME's constructor." (aset newc class-parent (cons SC (aref newc class-parent))) ) - ;; turn this into a useable self-pointing symbol + ;; turn this into a usable self-pointing symbol (set cname cname) ;; Store the new class vector definition into the symbol. We need to @@ -509,7 +509,7 @@ See `defclass' for more information." ;; save parent in child (aset newc class-parent (list eieio-default-superclass)))) - ;; turn this into a useable self-pointing symbol + ;; turn this into a usable self-pointing symbol (set cname cname) ;; These two tests must be created right away so we can have self- @@ -553,7 +553,7 @@ See `defclass' for more information." (put cname 'cl-deftype-handler (list 'lambda () `(list 'satisfies (quote ,csym))))) - ;; before adding new slots, lets add all the methods and classes + ;; before adding new slots, let's add all the methods and classes ;; in from the parent class (eieio-copy-parents-into-subclass newc superclasses) @@ -826,7 +826,7 @@ if default value is nil." ;; Make sure we duplicate those items that are sequences. (condition-case nil (if (sequencep d) (setq d (copy-sequence d))) - ;; This copy can fail on a cons cell with a non-cons in the cdr. Lets skip it if it doesn't work. + ;; This copy can fail on a cons cell with a non-cons in the cdr. Let's skip it if it doesn't work. (error nil)) (if (sequencep type) (setq type (copy-sequence type))) (if (sequencep cust) (setq cust (copy-sequence cust))) @@ -958,7 +958,7 @@ if default value is nil." (progn (eieio-perform-slot-validation-for-default a type value skipnil) ;; Here we have found a :class version of a slot. This - ;; requires a very different aproach. + ;; requires a very different approach. (aset newc class-class-allocation-a (cons a (aref newc class-class-allocation-a))) (aset newc class-class-allocation-doc (cons doc (aref newc class-class-allocation-doc))) (aset newc class-class-allocation-type (cons type (aref newc class-class-allocation-type))) @@ -992,7 +992,7 @@ if default value is nil." ;; EML - Note: the only reason to override a class bound slot ;; is to change the default, so allow unbound in. - ;; If we have a repeat, only update the vlaue... + ;; If we have a repeat, only update the value... (eieio-perform-slot-validation-for-default a tp value skipnil) (setcar dp value)) @@ -1312,20 +1312,20 @@ Summary: (defun eieio--defmethod (method kind argclass code) "Work part of the `defmethod' macro defining METHOD with ARGS." (let ((key - ;; find optional keys + ;; find optional keys (cond ((or (eq ':BEFORE kind) (eq ':before kind)) - method-before) + method-before) ((or (eq ':AFTER kind) (eq ':after kind)) - method-after) + method-after) ((or (eq ':PRIMARY kind) (eq ':primary kind)) - method-primary) + method-primary) ((or (eq ':STATIC kind) (eq ':static kind)) - method-static) - ;; Primary key + method-static) + ;; Primary key (t method-primary)))) ;; Make sure there is a generic (when called from defclass). (eieio--defalias @@ -1338,8 +1338,8 @@ Summary: ;; under the type `primary' which is a non-specific calling of the ;; function. (if argclass - (if (not (class-p argclass)) - (error "Unknown class type %s in method parameters" + (if (not (class-p argclass)) + (error "Unknown class type %s in method parameters" argclass)) (if (= key -1) (signal 'wrong-type-argument (list :static 'non-class-arg))) @@ -1470,7 +1470,7 @@ created by the :initarg tag." (c (eieio-slot-name-index class obj slot))) (if (not c) ;; It might be missing because it is a :class allocated slot. - ;; Lets check that info out. + ;; Let's check that info out. (if (setq c (eieio-class-slot-name-index class slot)) ;; Oref that slot. (aref (aref (class-v class) class-class-allocation-values) c) @@ -1503,7 +1503,7 @@ Fills in OBJ's SLOT with its default value." (c (eieio-slot-name-index cl obj slot))) (if (not c) ;; It might be missing because it is a :class allocated slot. - ;; Lets check that info out. + ;; Let's check that info out. (if (setq c (eieio-class-slot-name-index cl slot)) ;; Oref that slot. @@ -1549,7 +1549,7 @@ Fills in OBJ's SLOT with VALUE." (let ((c (eieio-slot-name-index (object-class-fast obj) obj slot))) (if (not c) ;; It might be missing because it is a :class allocated slot. - ;; Lets check that info out. + ;; Let's check that info out. (if (setq c (eieio-class-slot-name-index (aref obj object-class) slot)) ;; Oset that slot. @@ -1581,7 +1581,7 @@ Fills in the default value in CLASS' in SLOT with VALUE." (c (eieio-slot-name-index class nil slot))) (if (not c) ;; It might be missing because it is a :class allocated slot. - ;; Lets check that info out. + ;; Let's check that info out. (if (setq c (eieio-class-slot-name-index class slot)) (progn ;; Oref that slot. @@ -2563,7 +2563,7 @@ This is usually a symbol that starts with `:'." ;;; ;; We want all objects created by EIEIO to have some default set of -;; behaviours so we can create object utilities, and allow various +;; behaviors so we can create object utilities, and allow various ;; types of error checking. To do this, create the default EIEIO ;; class, and when no parent class is specified, use this as the ;; default. (But don't store it in the other classes as the default, @@ -2864,6 +2864,106 @@ of `eq'." ) +;;; Obsolete backward compatibility functions. +;; Needed to run byte-code compiled with the EIEIO of Emacs-23. + +(defun eieio-defmethod (method args) + "Obsolete work part of an old version of the `defmethod' macro." + (let ((key nil) (body nil) (firstarg nil) (argfix nil) (argclass nil) loopa) + ;; find optional keys + (setq key + (cond ((or (eq ':BEFORE (car args)) + (eq ':before (car args))) + (setq args (cdr args)) + method-before) + ((or (eq ':AFTER (car args)) + (eq ':after (car args))) + (setq args (cdr args)) + method-after) + ((or (eq ':PRIMARY (car args)) + (eq ':primary (car args))) + (setq args (cdr args)) + method-primary) + ((or (eq ':STATIC (car args)) + (eq ':static (car args))) + (setq args (cdr args)) + method-static) + ;; Primary key + (t method-primary))) + ;; get body, and fix contents of args to be the arguments of the fn. + (setq body (cdr args) + args (car args)) + (setq loopa args) + ;; Create a fixed version of the arguments + (while loopa + (setq argfix (cons (if (listp (car loopa)) (car (car loopa)) (car loopa)) + argfix)) + (setq loopa (cdr loopa))) + ;; make sure there is a generic + (eieio-defgeneric + method + (if (stringp (car body)) + (car body) (format "Generically created method `%s'." method))) + ;; create symbol for property to bind to. If the first arg is of + ;; the form (varname vartype) and `vartype' is a class, then + ;; that class will be the type symbol. If not, then it will fall + ;; under the type `primary' which is a non-specific calling of the + ;; function. + (setq firstarg (car args)) + (if (listp firstarg) + (progn + (setq argclass (nth 1 firstarg)) + (if (not (class-p argclass)) + (error "Unknown class type %s in method parameters" + (nth 1 firstarg)))) + (if (= key -1) + (signal 'wrong-type-argument (list :static 'non-class-arg))) + ;; generics are higher + (setq key (eieio-specialized-key-to-generic-key key))) + ;; Put this lambda into the symbol so we can find it + (if (byte-code-function-p (car-safe body)) + (eieiomt-add method (car-safe body) key argclass) + (eieiomt-add method (append (list 'lambda (reverse argfix)) body) + key argclass)) + ) + + (when eieio-optimize-primary-methods-flag + ;; Optimizing step: + ;; + ;; If this method, after this setup, only has primary methods, then + ;; we can setup the generic that way. + (if (generic-primary-only-p method) + ;; If there is only one primary method, then we can go one more + ;; optimization step. + (if (generic-primary-only-one-p method) + (eieio-defgeneric-reset-generic-form-primary-only-one method) + (eieio-defgeneric-reset-generic-form-primary-only method)) + (eieio-defgeneric-reset-generic-form method))) + + method) +(make-obsolete 'eieio-defmethod 'eieio--defmethod "24.1") + +(defun eieio-defgeneric (method doc-string) + "Obsolete work part of an old version of the `defgeneric' macro." + (if (and (fboundp method) (not (generic-p method)) + (or (byte-code-function-p (symbol-function method)) + (not (eq 'autoload (car (symbol-function method))))) + ) + (error "You cannot create a generic/method over an existing symbol: %s" + method)) + ;; Don't do this over and over. + (unless (fboundp 'method) + ;; This defun tells emacs where the first definition of this + ;; method is defined. + `(defun ,method nil) + ;; Make sure the method tables are installed. + (eieiomt-install method) + ;; Apply the actual body of this function. + (fset method (eieio-defgeneric-form method doc-string)) + ;; Return the method + 'method)) +(make-obsolete 'eieio-defgeneric nil "24.1") + ;;; Interfacing with edebug ;; (defun eieio-edebug-prin1-to-string (object &optional noescape) @@ -2938,7 +3038,7 @@ Optional argument NOESCAPE is passed to `prin1-to-string' when appropriate." ;;; Start of automatically extracted autoloads. ;;;### (autoloads (customize-object) "eieio-custom" "eieio-custom.el" -;;;;;; "cf1bd64c76a6e6406545e8c5a5530d43") +;;;;;; "9cf80224540c52045d515a4c2c833543") ;;; Generated autoloads from eieio-custom.el (autoload 'customize-object "eieio-custom" "\ @@ -2951,7 +3051,7 @@ Optional argument GROUP is the sub-group of slots to display. ;;;### (autoloads (eieio-help-mode-augmentation-maybee eieio-describe-generic ;;;;;; eieio-describe-constructor eieio-describe-class eieio-browse) -;;;;;; "eieio-opt" "eieio-opt.el" "1bed0a56310f402683419139ebc18d7f") +;;;;;; "eieio-opt" "eieio-opt.el" "e2814881441ad23759409687502f0ee1") ;;; Generated autoloads from eieio-opt.el (autoload 'eieio-browse "eieio-opt" "\ diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index cd9b779bee9..6e5b8e92fb8 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -1,6 +1,6 @@ ;;; eldoc.el --- show function arglist or variable docstring in echo area -;; Copyright (C) 1996-2011 Free Software Foundation, Inc. +;; Copyright (C) 1996-2012 Free Software Foundation, Inc. ;; Author: Noah Friedman <friedman@splode.com> ;; Maintainer: friedman@splode.com @@ -149,14 +149,17 @@ This is used to determine if `eldoc-idle-delay' is changed by the user.") ;;;###autoload (define-minor-mode eldoc-mode - "Toggle ElDoc mode on or off. -In ElDoc mode, the echo area displays information about a -function or variable in the text where point is. If point is -on a documented variable, it displays the first line of that -variable's doc string. Otherwise it displays the argument list -of the function called in the expression point is on. - -With prefix ARG, turn ElDoc mode on if and only if ARG is positive." + "Toggle echo area display of Lisp objects at point (ElDoc mode). +With a prefix argument ARG, enable ElDoc mode if ARG is positive, +and disable it otherwise. If called from Lisp, enable ElDoc mode +if ARG is omitted or nil. + +ElDoc mode is a buffer-local minor mode. When enabled, the echo +area displays information about a function or variable in the +text where point is. If point is on a documented variable, it +displays the first line of that variable's doc string. Otherwise +it displays the argument list of the function called in the +expression point is on." :group 'eldoc :lighter eldoc-minor-mode-string (setq eldoc-last-message nil) (if eldoc-mode @@ -431,7 +434,7 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'." nil (list (eldoc-current-symbol) argument-index))))) -;; Move to the beginnig of current sexp. Return the number of nested +;; Move to the beginning of current sexp. Return the number of nested ;; sexp the point was over or after. (defun eldoc-beginning-of-sexp () (let ((parse-sexp-ignore-comments t) diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el index 0b8aa034500..5b82cd477f9 100644 --- a/lisp/emacs-lisp/elint.el +++ b/lisp/emacs-lisp/elint.el @@ -1,6 +1,6 @@ ;;; elint.el --- Lint Emacs Lisp -;; Copyright (C) 1997, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc. ;; Author: Peter Liljenberg <petli@lysator.liu.se> ;; Created: May 1997 @@ -296,7 +296,7 @@ If necessary, this first calls `elint-initialize'." (elint-display-log) (elint-set-mode-line t) (mapc 'elint-top-form (elint-update-env)) - ;; Tell the user we're finished. This is terribly klugy: we set + ;; Tell the user we're finished. This is terribly kludgy: we set ;; elint-top-form-logged so elint-log-message doesn't print the ;; ** top form ** header... (elint-set-mode-line) @@ -335,7 +335,7 @@ Will be local in linted buffers.") Is measured in buffer-modified-ticks and is local in linted buffers.") ;; This is a minor optimization. It is local to every buffer, and so -;; does not prevent recursive requirs. It does not list the requires +;; does not prevent recursive requires. It does not list the requires ;; of requires. (defvar elint-features nil "List of all libraries this buffer has required, or that have been provided.") @@ -1098,7 +1098,7 @@ optional prefix argument REINIT is non-nil." ;; This includes all the built-in and dumped things with documentation. (defun elint-scan-doc-file () "Scan the DOC file for function and variables. -Marks the function wih their arguments, and returns a list of variables." +Marks the function with their arguments, and returns a list of variables." ;; Cribbed from help-fns.el. (let ((docbuf " *DOC*") vars sym args) diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index b89b6decfc9..08390327414 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -1,6 +1,6 @@ ;;; elp.el --- Emacs Lisp Profiler -;; Copyright (C) 1994-1995, 1997-1998, 2001-2011 +;; Copyright (C) 1994-1995, 1997-1998, 2001-2012 ;; Free Software Foundation, Inc. ;; Author: Barry A. Warsaw diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 39d4a4e814a..257d0528cbc 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -1,6 +1,6 @@ ;;; ert-x.el --- Staging area for experimental extensions to ERT -;; Copyright (C) 2008, 2010-2011 Free Software Foundation, Inc. +;; Copyright (C) 2008, 2010-2012 Free Software Foundation, Inc. ;; Author: Lennart Borgman (lennart O borgman A gmail O com) ;; Author: Christian Ohler <ohler@gnu.org> @@ -167,8 +167,9 @@ test for `called-interactively' in the command will fail." (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)) + (and (boundp 'deferred-action-list) + deferred-action-list + (run-hooks 'deferred-action-function)) (setq real-last-command (car command) last-command this-command) (when (boundp 'last-repeatable-command) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index b2e20843856..9cbe29bf322 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -1,6 +1,6 @@ ;;; ert.el --- Emacs Lisp Regression Testing -;; Copyright (C) 2007-2008, 2010-2011 Free Software Foundation, Inc. +;; Copyright (C) 2007-2008, 2010-2012 Free Software Foundation, Inc. ;; Author: Christian Ohler <ohler@gnu.org> ;; Keywords: lisp, tools @@ -248,7 +248,7 @@ Emacs bug 6581 at URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'." ;; We disallow nil since `ert-test-at-point' and related functions ;; want to return a test name, but also need an out-of-band value ;; on failure. Nil is the most natural out-of-band value; using 0 - ;; or "" or signalling an error would be too awkward. + ;; or "" or signaling an error would be too awkward. ;; ;; Note that nil is still a valid value for the `name' slot in ;; ert-test objects. It designates an anonymous test. @@ -392,7 +392,7 @@ DATA is displayed to the user and should state the reason of the failure." ;; compiling doesn't depend on cl and thus doesn't need an ;; environment arg for `macroexpand'. (if (fboundp 'cl-macroexpand) - ;; Suppress warning about run-time call to cl funtion: we + ;; Suppress warning about run-time call to cl function: we ;; only call it if it's fboundp. (with-no-warnings (cl-macroexpand form (and (boundp 'cl-macro-environment) @@ -448,7 +448,7 @@ arguments: INNER-FORM and FORM-DESCRIPTION-FORM, where INNER-FORM is an expression equivalent to FORM, and FORM-DESCRIPTION-FORM is an expression that returns a description of FORM. INNER-EXPANDER should return code that calls INNER-FORM and performs the checks -and error signalling specific to the particular variant of +and error signaling specific to the particular variant of `should'. The code that INNER-EXPANDER returns must not call FORM-DESCRIPTION-FORM before it has called INNER-FORM." (lexical-let ((inner-expander inner-expander)) @@ -489,17 +489,17 @@ Returns nil." Determines whether CONDITION matches TYPE and EXCLUDE-SUBTYPES, and aborts the current test as failed if it doesn't." - (let ((signalled-conditions (get (car condition) 'error-conditions)) + (let ((signaled-conditions (get (car condition) 'error-conditions)) (handled-conditions (etypecase type (list type) (symbol (list type))))) - (assert signalled-conditions) - (unless (ert--intersection signalled-conditions handled-conditions) + (assert signaled-conditions) + (unless (ert--intersection signaled-conditions handled-conditions) (ert-fail (append (funcall form-description-fn) (list :condition condition - :fail-reason (concat "the error signalled did not" + :fail-reason (concat "the error signaled did not" " have the expected type"))))) (when exclude-subtypes (unless (member (car condition) handled-conditions) @@ -507,7 +507,7 @@ and aborts the current test as failed if it doesn't." (funcall form-description-fn) (list :condition condition - :fail-reason (concat "the error signalled was a subtype" + :fail-reason (concat "the error signaled was a subtype" " of the expected type")))))))) ;; FIXME: The expansion will evaluate the keyword args (if any) in @@ -515,7 +515,7 @@ and aborts the current test as failed if it doesn't." (defmacro* should-error (form &rest keys &key type exclude-subtypes) "Evaluate FORM and check that it signals an error. -The error signalled needs to match TYPE. TYPE should be a list +The error signaled needs to match TYPE. TYPE should be a list of condition names. (It can also be a non-nil symbol, which is equivalent to a singleton list containing that symbol.) If EXCLUDE-SUBTYPES is nil, the error matches TYPE if one of its @@ -523,7 +523,7 @@ condition names is an element of TYPE. If EXCLUDE-SUBTYPES is non-nil, the error matches TYPE if it is an element of TYPE. If the error matches, returns (ERROR-SYMBOL . DATA) from the -error. If not, or if no error was signalled, abort the test as +error. If not, or if no error was signaled, abort the test as failed." (unless type (setq type ''error)) (ert--expand-should @@ -577,8 +577,7 @@ failed." (t x))) (defun ert--explain-equal-rec (a b) - "Returns a programmer-readable explanation of why A and B are not `equal'. - + "Return a programmer-readable explanation of why A and B are not `equal'. Returns nil if they are." (if (not (equal (type-of a) (type-of b))) `(different-types ,a ,b) @@ -863,7 +862,7 @@ run. DEBUGGER-ARGS are the arguments to `debugger'." (make-ert-test-failed :condition condition :backtrace backtrace :infos infos)))) - ;; Work around Emacs' heuristic (in eval.c) for detecting + ;; Work around Emacs's heuristic (in eval.c) for detecting ;; errors in the debugger. (incf num-nonmacro-input-events) ;; FIXME: We should probably implement more fine-grained @@ -1020,36 +1019,36 @@ t -- Always matches. (ert-test-result-type-p result (ert-test-expected-result-type test))) (defun ert-select-tests (selector universe) - "Return the tests that match SELECTOR. - -UNIVERSE specifies the set of tests to select from; it should be -a list of tests, or t, which refers to all tests named by symbols -in `obarray'. + "Return a list of tests that match SELECTOR. -Returns the set of tests as a list. +UNIVERSE specifies the set of tests to select from; it should be a list +of tests, or t, which refers to all tests named by symbols in `obarray'. -Valid selectors: +Valid SELECTORs: -nil -- Selects the empty set. -t -- Selects UNIVERSE. +nil -- Selects the empty set. +t -- Selects UNIVERSE. :new -- Selects all tests that have not been run yet. -:failed, :passed -- Select tests according to their most recent result. +:failed, :passed -- Select tests according to their most recent result. :expected, :unexpected -- Select tests according to their most recent result. -a string -- Selects all tests that have a name that matches the string, - a regexp. -a test -- Selects that test. +a string -- A regular expression selecting all tests with matching names. +a test -- (i.e., an object of the ert-test data-type) Selects that test. a symbol -- Selects the test that the symbol names, errors if none. -\(member TESTS...\) -- Selects TESTS, a list of tests or symbols naming tests. +\(member TESTS...) -- Selects the elements of TESTS, a list of tests + or symbols naming tests. \(eql TEST\) -- Selects TEST, a test or a symbol naming a test. -\(and SELECTORS...\) -- Selects the tests that match all SELECTORS. -\(or SELECTORS...\) -- Selects the tests that match any SELECTOR. -\(not SELECTOR\) -- Selects all tests that do not match SELECTOR. +\(and SELECTORS...) -- Selects the tests that match all SELECTORS. +\(or SELECTORS...) -- Selects the tests that match any of the SELECTORS. +\(not SELECTOR) -- Selects all tests that do not match SELECTOR. \(tag TAG) -- Selects all tests that have TAG on their tags list. -\(satisfies PREDICATE\) -- Selects all tests that satisfy PREDICATE. + A tag is an arbitrary label you can apply when you define a test. +\(satisfies PREDICATE) -- Selects all tests that satisfy PREDICATE. + PREDICATE is a function that takes an ert-test object as argument, + and returns non-nil if it is selected. Only selectors that require a superset of tests, such as (satisfies ...), strings, :new, etc. make use of UNIVERSE. -Selectors that do not, such as \(member ...\), just return the +Selectors that do not, such as (member ...), just return the set implied by them without checking whether it is really contained in UNIVERSE." ;; This code needs to match the etypecase in @@ -2121,7 +2120,7 @@ To be used in the ERT results buffer." EWOC-FN specifies the direction and should be either `ewoc-prev' or `ewoc-next'. If there are no more nodes in that direction, an -error is signalled with the message ERROR-MESSAGE." +error is signaled with the message ERROR-MESSAGE." (loop (setq node (funcall ewoc-fn ert--results-ewoc node)) (when (null node) diff --git a/lisp/emacs-lisp/ewoc.el b/lisp/emacs-lisp/ewoc.el index a71f3c7244c..4fd87209b38 100644 --- a/lisp/emacs-lisp/ewoc.el +++ b/lisp/emacs-lisp/ewoc.el @@ -1,6 +1,6 @@ ;;; ewoc.el --- utility to maintain a view of a list of objects in a buffer -;; Copyright (C) 1991-2011 Free Software Foundation, Inc. +;; Copyright (C) 1991-2012 Free Software Foundation, Inc. ;; Author: Per Cederqvist <ceder@lysator.liu.se> ;; Inge Wallin <inge@lysator.liu.se> @@ -26,7 +26,7 @@ ;;; Commentary: ;; Ewoc Was Once Cookie -;; But now it's Emacs' Widget for Object Collections +;; But now it's Emacs's Widget for Object Collections ;; As the name implies this derives from the `cookie' package (part ;; of Elib). The changes are pervasive though mostly superficial: diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 0194af2e3a8..d64281d0e81 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -1,6 +1,6 @@ ;;; find-func.el --- find the definition of the Emacs Lisp function near point -;; Copyright (C) 1997, 1999, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1999, 2001-2012 Free Software Foundation, Inc. ;; Author: Jens Petersen <petersen@kurims.kyoto-u.ac.jp> ;; Maintainer: petersen@kurims.kyoto-u.ac.jp @@ -198,13 +198,14 @@ If FUNC is not the symbol of an advised function, just returns FUNC." (defun find-function-C-source (fun-or-var file type) "Find the source location where FUN-OR-VAR is defined in FILE. TYPE should be nil to find a function, or `defvar' to find a variable." - (unless find-function-C-source-directory - (setq find-function-C-source-directory - (read-directory-name "Emacs C source dir: " nil nil t))) - (setq file (expand-file-name file find-function-C-source-directory)) - (unless (file-readable-p file) - (error "The C source file %s is not available" - (file-name-nondirectory file))) + (let ((dir (or find-function-C-source-directory + (read-directory-name "Emacs C source dir: " nil nil t)))) + (setq file (expand-file-name file dir)) + (if (file-readable-p file) + (if (null find-function-C-source-directory) + (setq find-function-C-source-directory dir)) + (error "The C source file %s is not available" + (file-name-nondirectory file)))) (unless type ;; Either or both an alias and its target might be advised. (setq fun-or-var (find-function-advised-original @@ -312,7 +313,7 @@ The search is done in the source for library LIBRARY." (cons (current-buffer) nil)))))))) ;;;###autoload -(defun find-function-noselect (function) +(defun find-function-noselect (function &optional lisp-only) "Return a pair (BUFFER . POINT) pointing to the definition of FUNCTION. Finds the source file containing the definition of FUNCTION @@ -320,6 +321,10 @@ in a buffer and the point of the definition. The buffer is not selected. If the function definition can't be found in the buffer, returns (BUFFER). +If FUNCTION is a built-in function, this function normally +attempts to find it in the Emacs C sources; however, if LISP-ONLY +is non-nil, signal an error instead. + If the file where FUNCTION is defined is not known, then it is searched for in `find-function-source-path' if non-nil, otherwise in `load-path'." @@ -345,6 +350,8 @@ in `load-path'." (cond ((eq (car-safe def) 'autoload) (nth 1 def)) ((subrp def) + (if lisp-only + (error "%s is a built-in function" function)) (help-C-file-name def 'subr)) ((symbol-file function 'defun))))) (find-function-search-for-symbol function nil library)))) @@ -356,29 +363,23 @@ If TYPE is nil, insist on a symbol with a function definition. Otherwise TYPE should be `defvar' or `defface'. If TYPE is nil, defaults using `function-called-at-point', otherwise uses `variable-at-point'." - (let ((symb (if (null type) - (function-called-at-point) - (if (eq type 'defvar) - (variable-at-point) - (variable-at-point t)))) - (predicate (cdr (assq type '((nil . fboundp) (defvar . boundp) - (defface . facep))))) - (prompt (cdr (assq type '((nil . "function") (defvar . "variable") - (defface . "face"))))) - (enable-recursive-minibuffers t) - val) - (if (equal symb 0) - (setq symb nil)) - (setq val (completing-read - (concat "Find " - prompt - (if symb - (format " (default %s)" symb)) - ": ") - obarray predicate t nil)) - (list (if (equal val "") - symb - (intern val))))) + (let* ((symb1 (cond ((null type) (function-called-at-point)) + ((eq type 'defvar) (variable-at-point)) + (t (variable-at-point t)))) + (symb (unless (eq symb1 0) symb1)) + (predicate (cdr (assq type '((nil . fboundp) + (defvar . boundp) + (defface . facep))))) + (prompt-type (cdr (assq type '((nil . "function") + (defvar . "variable") + (defface . "face"))))) + (prompt (concat "Find " prompt-type + (and symb (format " (default %s)" symb)) + ": ")) + (enable-recursive-minibuffers t)) + (list (intern (completing-read + prompt obarray predicate + t nil nil (and symb (symbol-name symb))))))) (defun find-function-do-it (symbol type switch-fn) "Find Emacs Lisp SYMBOL in a buffer and display it. diff --git a/lisp/emacs-lisp/find-gc.el b/lisp/emacs-lisp/find-gc.el index 1de38625243..39797fb5433 100644 --- a/lisp/emacs-lisp/find-gc.el +++ b/lisp/emacs-lisp/find-gc.el @@ -1,6 +1,6 @@ ;;; find-gc.el --- detect functions that call the garbage collector -;; Copyright (C) 1992, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc. ;; Maintainer: FSF diff --git a/lisp/emacs-lisp/float-sup.el b/lisp/emacs-lisp/float-sup.el index 7e40fdad352..375704ab6df 100644 --- a/lisp/emacs-lisp/float-sup.el +++ b/lisp/emacs-lisp/float-sup.el @@ -1,6 +1,6 @@ ;;; float-sup.el --- define some constants useful for floating point numbers. -;; Copyright (C) 1985-1987, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1985-1987, 2001-2012 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el index 770fe01f91c..6667a101865 100644 --- a/lisp/emacs-lisp/generic.el +++ b/lisp/emacs-lisp/generic.el @@ -1,6 +1,6 @@ ;;; generic.el --- defining simple major modes with comment and font-lock ;; -;; Copyright (C) 1997, 1999, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1999, 2001-2012 Free Software Foundation, Inc. ;; ;; Author: Peter Breton <pbreton@cs.umb.edu> ;; Created: Fri Sep 27 1996 diff --git a/lisp/emacs-lisp/gulp.el b/lisp/emacs-lisp/gulp.el index eca5470fd69..859b7d32b9e 100644 --- a/lisp/emacs-lisp/gulp.el +++ b/lisp/emacs-lisp/gulp.el @@ -1,6 +1,6 @@ ;;; gulp.el --- ask for updates for Lisp packages -;; Copyright (C) 1996, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1996, 2001-2012 Free Software Foundation, Inc. ;; Author: Sam Shteingold <shteingd@math.ucla.edu> ;; Maintainer: FSF diff --git a/lisp/emacs-lisp/helper.el b/lisp/emacs-lisp/helper.el index 113f5849364..e10cbdb3b6e 100644 --- a/lisp/emacs-lisp/helper.el +++ b/lisp/emacs-lisp/helper.el @@ -1,6 +1,6 @@ ;;; helper.el --- utility help package supporting help in electric modes -;; Copyright (C) 1985, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1985, 2001-2012 Free Software Foundation, Inc. ;; Author: K. Shane Hartman ;; Maintainer: FSF diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el index 4d0cacf4ee1..f9a1c5dbf83 100644 --- a/lisp/emacs-lisp/lisp-mnt.el +++ b/lisp/emacs-lisp/lisp-mnt.el @@ -1,6 +1,6 @@ ;;; lisp-mnt.el --- utility functions for Emacs Lisp maintainers -;; Copyright (C) 1992, 1994, 1997, 2000-2011 Free Software Foundation, Inc. +;; Copyright (C) 1992, 1994, 1997, 2000-2012 Free Software Foundation, Inc. ;; Author: Eric S. Raymond <esr@snark.thyrsus.com> ;; Maintainer: FSF diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index c8620aaa439..95eb8c963be 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -1,6 +1,6 @@ ;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands -;; Copyright (C) 1985-1986, 1999-2011 Free Software Foundation, Inc. +;; Copyright (C) 1985-1986, 1999-2012 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: lisp, languages @@ -34,8 +34,14 @@ (defvar font-lock-string-face) (defvar lisp-mode-abbrev-table nil) +(define-abbrev-table 'lisp-mode-abbrev-table () + "Abbrev table for Lisp mode.") -(define-abbrev-table 'lisp-mode-abbrev-table ()) +(defvar emacs-lisp-mode-abbrev-table nil) +(define-abbrev-table 'emacs-lisp-mode-abbrev-table () + "Abbrev table for Emacs Lisp mode. +It has `lisp-mode-abbrev-table' as its parent." + :parents (list lisp-mode-abbrev-table)) (defvar emacs-lisp-mode-syntax-table (let ((table (make-syntax-table)) @@ -131,6 +137,7 @@ (put 'autoload 'doc-string-elt 3) (put 'defun 'doc-string-elt 3) (put 'defun* 'doc-string-elt 3) +(put 'defmethod 'doc-string-elt 3) (put 'defvar 'doc-string-elt 3) (put 'defcustom 'doc-string-elt 3) (put 'deftheme 'doc-string-elt 2) @@ -205,7 +212,6 @@ score-mode.el. KEYWORDS-CASE-INSENSITIVE non-nil means that for font-lock keywords will not be case sensitive." (when lisp-syntax (set-syntax-table lisp-mode-syntax-table)) - (setq local-abbrev-table lisp-mode-abbrev-table) (make-local-variable 'paragraph-ignore-fill-prefix) (setq paragraph-ignore-fill-prefix t) (make-local-variable 'fill-paragraph-function) @@ -297,7 +303,7 @@ font-lock keywords will not be case sensitive." `(menu-item ,(purecopy "Untrace All") untrace-all :help ,(purecopy "Untrace all currently traced functions"))) (define-key tracing-map [tr-uf] - `(menu-item ,(purecopy "Untrace function...") untrace-function + `(menu-item ,(purecopy "Untrace Function...") untrace-function :help ,(purecopy "Untrace function, and possibly activate all remaining advice"))) (define-key tracing-map [tr-sep] menu-bar-separator) (define-key tracing-map [tr-q] @@ -358,7 +364,7 @@ font-lock keywords will not be case sensitive." `(menu-item ,(purecopy "Byte-compile and Load") emacs-lisp-byte-compile-and-load :help ,(purecopy "Byte-compile the current file (if it has changed), then load compiled code"))) (define-key menu-map [byte-compile] - `(menu-item ,(purecopy "Byte-compile this File") emacs-lisp-byte-compile + `(menu-item ,(purecopy "Byte-compile This File") emacs-lisp-byte-compile :help ,(purecopy "Byte compile the file containing the current buffer"))) (define-key menu-map [separator-eval] menu-bar-separator) (define-key menu-map [ielm] @@ -509,7 +515,7 @@ if that value is non-nil." `(menu-item ,(purecopy "Evaluate Defun") eval-defun :help ,(purecopy "Evaluate the top-level form containing point, or after point"))) (define-key menu-map [eval-print-last-sexp] - `(menu-item ,(purecopy "Evaluate and print") eval-print-last-sexp + `(menu-item ,(purecopy "Evaluate and Print") eval-print-last-sexp :help ,(purecopy "Evaluate sexp before point; print value into current buffer"))) (define-key menu-map [edebug-defun-lisp-interaction] `(menu-item ,(purecopy "Instrument Function for Debugging") edebug-defun @@ -539,7 +545,8 @@ Semicolons start comments. \\{lisp-interaction-mode-map} Entry to this mode calls the value of `lisp-interaction-mode-hook' -if that value is non-nil.") +if that value is non-nil." + :abbrev-table nil) (defun eval-print-last-sexp () "Evaluate sexp before point; print value into current buffer. @@ -769,7 +776,7 @@ this command arranges for all errors to enter the debugger." Reset the `defvar' and `defcustom' variables to the initial value. Reinitialize the face according to the `defface' specification." ;; The code in edebug-defun should be consistent with this, but not - ;; the same, since this gets a macroexpended form. + ;; the same, since this gets a macroexpanded form. (cond ((not (listp form)) form) ((and (eq (car form) 'defvar) @@ -1102,25 +1109,31 @@ is the buffer position of the start of the containing expression." (defun lisp-indent-function (indent-point state) "This function is the normal value of the variable `lisp-indent-function'. -It is used when indenting a line within a function call, to see if the -called function says anything special about how to indent the line. +The function `calculate-lisp-indent' calls this to determine +if the arguments of a Lisp function call should be indented specially. INDENT-POINT is the position where the user typed TAB, or equivalent. Point is located at the point to indent under (for default indentation); STATE is the `parse-partial-sexp' state for that position. -If the current line is in a call to a Lisp function -which has a non-nil property `lisp-indent-function', -that specifies how to do the indentation. The property value can be -* `defun', meaning indent `defun'-style; +If the current line is in a call to a Lisp function that has a non-nil +property `lisp-indent-function' (or the deprecated `lisp-indent-hook'), +it specifies how to indent. The property value can be: + +* `defun', meaning indent `defun'-style + \(this is also the case if there is no property and the function + has a name that begins with \"def\", and three or more arguments); + * an integer N, meaning indent the first N arguments specially - like ordinary function arguments and then indent any further + (like ordinary function arguments), and then indent any further arguments like a body; -* a function to call just as this function was called. - If that function returns nil, that means it doesn't specify - the indentation. -This function also returns nil meaning don't specify the indentation." +* a function to call that returns the indentation (or nil). + `lisp-indent-function' calls this function with the same two arguments + that it itself received. + +This function returns either the indentation to use, or nil if the +Lisp function does not specify a special indentation." (let ((normal-indent (current-column))) (goto-char (1+ (elt state 1))) (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t) diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index db6a03333d4..4efdc3240cd 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -1,6 +1,6 @@ ;;; lisp.el --- Lisp editing commands for Emacs -;; Copyright (C) 1985-1986, 1994, 2000-2011 Free Software Foundation, Inc. +;; Copyright (C) 1985-1986, 1994, 2000-2012 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: lisp, languages @@ -257,9 +257,8 @@ is called as a function to find the defun's beginning." (if (> arg 0) (dotimes (i arg) (funcall beginning-of-defun-function)) - ;; Better not call end-of-defun-function directly, in case - ;; it's not defined. - (end-of-defun (- arg)))))) + (dotimes (i (- arg)) + (funcall end-of-defun-function)))))) ((or defun-prompt-regexp open-paren-in-column-0-is-defun-start) (and (< arg 0) (not (eobp)) (forward-char 1)) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index ccfdf2e0551..21c351159c2 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -1,6 +1,6 @@ ;;; macroexp.el --- Additional macro-expansion support -*- lexical-binding: t -*- ;; -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004-2012 Free Software Foundation, Inc. ;; ;; Author: Miles Bader <miles@gnu.org> ;; Keywords: lisp, compiler, macros diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el index 6ef26fef89c..cc4e642daf8 100644 --- a/lisp/emacs-lisp/map-ynp.el +++ b/lisp/emacs-lisp/map-ynp.el @@ -1,6 +1,6 @@ ;;; map-ynp.el --- general-purpose boolean question-asker -;; Copyright (C) 1991-1995, 2000-2011 Free Software Foundation, Inc. +;; Copyright (C) 1991-1995, 2000-2012 Free Software Foundation, Inc. ;; Author: Roland McGrath <roland@gnu.org> ;; Maintainer: FSF diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el index cd4b5ee231c..761d27a2e28 100644 --- a/lisp/emacs-lisp/package-x.el +++ b/lisp/emacs-lisp/package-x.el @@ -1,6 +1,6 @@ ;;; package-x.el --- Package extras -;; Copyright (C) 2007-2011 Free Software Foundation, Inc. +;; Copyright (C) 2007-2012 Free Software Foundation, Inc. ;; Author: Tom Tromey <tromey@redhat.com> ;; Created: 10 Mar 2007 diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index e42103a7a01..5b158eb994f 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1,10 +1,10 @@ ;;; package.el --- Simple package system for Emacs -;; Copyright (C) 2007-2011 Free Software Foundation, Inc. +;; Copyright (C) 2007-2012 Free Software Foundation, Inc. ;; Author: Tom Tromey <tromey@redhat.com> ;; Created: 10 Mar 2007 -;; Version: 0.9 +;; Version: 1.0 ;; Keywords: tools ;; This file is part of GNU Emacs. @@ -113,6 +113,8 @@ ;;; ToDo: +;; - a trust mechanism, since compiling a package can run arbitrary code. +;; For example, download package signatures and check that they match. ;; - putting info dirs at the start of the info path means ;; users see a weird ordering of categories. OTOH we want to ;; override later entries. maybe emacs needs to enforce @@ -224,7 +226,10 @@ Each element has the form (ID . LOCATION). LOCATION specifies the base location for the archive. If it starts with \"http:\", it is treated as a HTTP URL; otherwise it should be an absolute directory name. - (Other types of URL are currently not supported.)" + (Other types of URL are currently not supported.) + +Only add locations that you trust, since fetching and installing +a package can run arbitrary code." :type '(alist :key-type (string :tag "Archive name") :value-type (string :tag "URL or directory name")) :risky t @@ -277,7 +282,7 @@ contrast, `package-user-dir' contains packages for personal use." :version "24.1") ;; The value is precomputed in finder-inf.el, but don't load that -;; until it's needed (i.e. when `package-intialize' is called). +;; until it's needed (i.e. when `package-initialize' is called). (defvar package--builtins nil "Alist of built-in packages. The actual value is initialized by loading the library @@ -309,7 +314,7 @@ The vector DESC has the form [VERSION-LIST REQS DOCSTRING]. This variable is set automatically by `package-load-descriptor', called via `package-initialize'. To change which packages are loaded and/or activated, customize `package-load-list'.") -(put 'package-archive-contents 'risky-local-variable t) +(put 'package-alist 'risky-local-variable t) (defvar package-activated-list nil "List of the names of currently activated packages.") @@ -377,30 +382,37 @@ controls which package subdirectories may be loaded. In each valid package subdirectory, this function loads the description file containing a call to `define-package', which updates `package-alist' and `package-obsolete-alist'." - (let ((all (memq 'all package-load-list)) - (regexp (concat "\\`" package-subdirectory-regexp "\\'")) - name version force) + (let ((regexp (concat "\\`" package-subdirectory-regexp "\\'"))) (dolist (dir (cons package-user-dir package-directory-list)) (when (file-directory-p dir) (dolist (subdir (directory-files dir)) - (when (and (file-directory-p (expand-file-name subdir dir)) - (string-match regexp subdir)) - (setq name (intern (match-string 1 subdir)) - version (match-string 2 subdir) - force (assq name package-load-list)) - (when (cond - ((null force) - all) ; not in package-load-list - ((null (setq force (cadr force))) - nil) ; disabled - ((eq force t) - t) - ((stringp force) ; held - (version-list-= (version-to-list version) - (version-to-list force))) - (t - (error "Invalid element in `package-load-list'"))) - (package-load-descriptor dir subdir)))))))) + (when (string-match regexp subdir) + (package-maybe-load-descriptor (match-string 1 subdir) + (match-string 2 subdir) + dir))))))) + +(defun package-maybe-load-descriptor (name version dir) + "Maybe load a specific package from directory DIR. +NAME and VERSION are the package's name and version strings. +This function checks `package-load-list', before actually loading +the package by calling `package-load-descriptor'." + (let ((force (assq (intern name) package-load-list)) + (subdir (concat name "-" version))) + (and (file-directory-p (expand-file-name subdir dir)) + ;; Check `package-load-list': + (cond ((null force) + (memq 'all package-load-list)) + ((null (setq force (cadr force))) + nil) ; disabled + ((eq force t) + t) + ((stringp force) ; held + (version-list-= (version-to-list version) + (version-to-list force))) + (t + (error "Invalid element in `package-load-list'"))) + ;; Actually load the descriptor: + (package-load-descriptor dir subdir)))) (defsubst package-desc-vers (desc) "Extract version from a package description vector." @@ -570,11 +582,11 @@ EXTRA-PROPERTIES is currently unused." file) (defun package-generate-autoloads (name pkg-dir) + (require 'autoload) ;Load before we let-bind generated-autoload-file! (let* ((auto-name (concat name "-autoloads.el")) (ignore-name (concat name "-pkg.el")) (generated-autoload-file (expand-file-name auto-name pkg-dir)) (version-control 'never)) - (require 'autoload) (unless (fboundp 'autoload-ensure-default-file) (package-autoload-ensure-default-file generated-autoload-file)) (update-directory-autoloads pkg-dir))) @@ -595,16 +607,25 @@ untar into a directory named DIR; otherwise, signal an error." (error "Package does not untar cleanly into directory %s/" dir)))) (tar-untar-buffer)) -(defun package-unpack (name version) - (let* ((dirname (concat (symbol-name name) "-" version)) +(defun package-unpack (package version) + (let* ((name (symbol-name package)) + (dirname (concat name "-" version)) (pkg-dir (expand-file-name dirname package-user-dir))) (make-directory package-user-dir t) ;; FIXME: should we delete PKG-DIR if it exists? (let* ((default-directory (file-name-as-directory package-user-dir))) (package-untar-buffer dirname) - (package-generate-autoloads (symbol-name name) pkg-dir) - (let ((load-path (cons pkg-dir load-path))) - (byte-recompile-directory pkg-dir 0 t))))) + (package--make-autoloads-and-compile name pkg-dir)))) + +(defun package--make-autoloads-and-compile (name pkg-dir) + "Generate autoloads and do byte-compilation for package named NAME. +PKG-DIR is the name of the package directory." + (package-generate-autoloads name pkg-dir) + (let ((load-path (cons pkg-dir load-path))) + ;; We must load the autoloads file before byte compiling, in + ;; case there are magic cookies to set up non-trivial paths. + (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t) + (byte-recompile-directory pkg-dir 0 t))) (defun package--write-file-no-coding (file-name) (let ((buffer-file-coding-system 'no-conversion)) @@ -644,9 +665,7 @@ untar into a directory named DIR; otherwise, signal an error." nil pkg-file nil nil nil 'excl)) - (package-generate-autoloads file-name pkg-dir) - (let ((load-path (cons pkg-dir load-path))) - (byte-recompile-directory pkg-dir 0 t))))) + (package--make-autoloads-and-compile file-name pkg-dir)))) (defmacro package--with-work-buffer (location file &rest body) "Run BODY in a buffer containing the contents of FILE at LOCATION. @@ -738,7 +757,8 @@ not included in this list." hold) (when (setq hold (assq next-pkg package-load-list)) (setq hold (cadr hold)) - (cond ((eq hold nil) + (cond ((eq hold t)) + ((eq hold nil) (error "Required package '%s' is disabled" (symbol-name next-pkg))) ((null (stringp hold)) @@ -820,13 +840,19 @@ If the archive version is too new, signal an error." "Add the PACKAGE from the given ARCHIVE if necessary. Also, add the originating archive to the end of the package vector." (let* ((name (car package)) - (version (aref (cdr package) 0)) - (entry (cons (car package) + (version (package-desc-vers (cdr package))) + (entry (cons name (vconcat (cdr package) (vector archive)))) - (existing-package (cdr (assq name package-archive-contents)))) - (when (or (not existing-package) - (version-list-< (aref existing-package 0) version)) - (add-to-list 'package-archive-contents entry)))) + (existing-package (assq name package-archive-contents))) + (cond ((not existing-package) + (add-to-list 'package-archive-contents entry)) + ((version-list-< (package-desc-vers (cdr existing-package)) + version) + ;; Replace the entry with this one. + (setq package-archive-contents + (cons entry + (delq existing-package + package-archive-contents))))))) (defun package-download-transaction (package-list) "Download and install all the packages in PACKAGE-LIST. @@ -850,29 +876,43 @@ using `package-compute-transaction'." (package-desc-doc desc) (package-desc-reqs desc))) (t - (error "Unknown package kind: %s" (symbol-name kind))))))) + (error "Unknown package kind: %s" (symbol-name kind)))) + ;; If package A depends on package B, then A may `require' B + ;; during byte compilation. So we need to activate B before + ;; unpacking A. + (package-maybe-load-descriptor (symbol-name elt) v-string + package-user-dir) + (package-activate elt (version-to-list v-string))))) + +(defvar package--initialized nil) ;;;###autoload (defun package-install (name) "Install the package named NAME. -Interactively, prompt for the package name. -The package is found on one of the archives in `package-archives'." +NAME should be the name of one of the available packages in an +archive in `package-archives'. Interactively, prompt for NAME." (interactive - (list (intern (completing-read "Install package: " - (mapcar (lambda (elt) - (cons (symbol-name (car elt)) - nil)) - package-archive-contents) - nil t)))) + (progn + ;; Initialize the package system to get the list of package + ;; symbols for completion. + (unless package--initialized + (package-initialize t)) + (unless package-archive-contents + (package-refresh-contents)) + (list (intern (completing-read + "Install package: " + (mapcar (lambda (elt) + (cons (symbol-name (car elt)) + nil)) + package-archive-contents) + nil t))))) (let ((pkg-desc (assq name package-archive-contents))) (unless pkg-desc (error "Package `%s' is not available for installation" (symbol-name name))) (package-download-transaction (package-compute-transaction (list name) - (package-desc-reqs (cdr pkg-desc))))) - ;; Try to activate it. - (package-initialize)) + (package-desc-reqs (cdr pkg-desc)))))) (defun package-strip-rcs-id (str) "Strip RCS version ID from the version string STR. @@ -1062,6 +1102,7 @@ similar to an entry in `package-alist'. Save the cached copy to (let ((version-control 'never)) (save-buffer)))))) +;;;###autoload (defun package-refresh-contents () "Download the ELPA archive description if needed. This informs Emacs about the latest versions of all packages, and @@ -1070,14 +1111,12 @@ makes them available for download." (unless (file-exists-p package-user-dir) (make-directory package-user-dir t)) (dolist (archive package-archives) - (condition-case-no-debug nil + (condition-case-unless-debug nil (package--download-one-archive archive "archive-contents") (error (message "Failed to download `%s' archive." (car archive))))) (package-read-all-archive-contents)) -(defvar package--initialized nil) - ;;;###autoload (defun package-initialize (&optional no-activate) "Load Emacs Lisp packages, and activate them. @@ -1263,6 +1302,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (define-key map "\177" 'package-menu-backup-unmark) (define-key map "d" 'package-menu-mark-delete) (define-key map "i" 'package-menu-mark-install) + (define-key map "U" 'package-menu-mark-upgrades) (define-key map "r" 'package-menu-refresh) (define-key map "~" 'package-menu-mark-obsolete-for-deletion) (define-key map "x" 'package-menu-execute) @@ -1284,27 +1324,30 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." '(menu-item "Unmark" package-menu-mark-unmark :help "Clear any marks on a package and move to the next line")) (define-key menu-map [munm] - '(menu-item "Unmark backwards" package-menu-backup-unmark + '(menu-item "Unmark Backwards" package-menu-backup-unmark :help "Back up one line and clear any marks on that package")) (define-key menu-map [md] - '(menu-item "Mark for deletion" package-menu-mark-delete + '(menu-item "Mark for Deletion" package-menu-mark-delete :help "Mark a package for deletion and move to the next line")) (define-key menu-map [mi] - '(menu-item "Mark for install" package-menu-mark-install + '(menu-item "Mark for Install" package-menu-mark-install :help "Mark a package for installation and move to the next line")) + (define-key menu-map [mupgrades] + '(menu-item "Mark Upgradable Packages" package-menu-mark-upgrades + :help "Mark packages that have a newer version for upgrading")) (define-key menu-map [s3] '("--")) (define-key menu-map [mg] - '(menu-item "Update package list" revert-buffer + '(menu-item "Update Package List" revert-buffer :help "Update the list of packages")) (define-key menu-map [mr] - '(menu-item "Refresh package list" package-menu-refresh + '(menu-item "Refresh Package List" package-menu-refresh :help "Download the ELPA archive")) (define-key menu-map [s4] '("--")) (define-key menu-map [mt] - '(menu-item "Mark obsolete packages" package-menu-mark-obsolete-for-deletion + '(menu-item "Mark Obsolete Packages" package-menu-mark-obsolete-for-deletion :help "Mark all obsolete packages for deletion")) (define-key menu-map [mx] - '(menu-item "Execute actions" package-menu-execute + '(menu-item "Execute Actions" package-menu-execute :help "Perform all the marked actions")) (define-key menu-map [s5] '("--")) (define-key menu-map [mh] @@ -1416,7 +1459,7 @@ identifier (NAME . VERSION-LIST)." This fetches the contents of each archive specified in `package-archives', and then refreshes the package menu." (interactive) - (unless (eq major-mode 'package-menu-mode) + (unless (derived-mode-p 'package-menu-mode) (error "The current buffer is not a Package Menu")) (package-refresh-contents) (package-menu--generate t t)) @@ -1431,21 +1474,21 @@ If optional arg BUTTON is non-nil, describe its associated package." (describe-package package)))) ;; fixme numeric argument -(defun package-menu-mark-delete (num) +(defun package-menu-mark-delete (&optional num) "Mark a package for deletion and move to the next line." (interactive "p") - (if (string-equal (package-menu-get-status) "installed") + (if (member (package-menu-get-status) '("installed" "obsolete")) (tabulated-list-put-tag "D" t) (forward-line))) -(defun package-menu-mark-install (num) +(defun package-menu-mark-install (&optional num) "Mark a package for installation and move to the next line." (interactive "p") (if (string-equal (package-menu-get-status) "available") (tabulated-list-put-tag "I" t) (forward-line))) -(defun package-menu-mark-unmark (num) +(defun package-menu-mark-unmark (&optional num) "Clear any marks on a package and move to the next line." (interactive "p") (tabulated-list-put-tag " " t)) @@ -1461,9 +1504,8 @@ If optional arg BUTTON is non-nil, describe its associated package." (interactive) (save-excursion (goto-char (point-min)) - (forward-line 2) (while (not (eobp)) - (if (looking-at ".*\\s obsolete\\s ") + (if (equal (package-menu-get-status) "obsolete") (tabulated-list-put-tag "D" t) (forward-line 1))))) @@ -1476,17 +1518,66 @@ If optional arg BUTTON is non-nil, describe its associated package." 'package-menu-view-commentary 'package-menu-describe-package "24.1") (defun package-menu-get-status () - (save-excursion - (if (looking-at ". [^ \t]*[ \t]*[^ \t]*[ \t]*\\([^ \t]*\\)") - (match-string 1) + (let* ((pkg (tabulated-list-get-id)) + (entry (and pkg (assq pkg tabulated-list-entries)))) + (if entry + (aref (cadr entry) 2) ""))) +(defun package-menu--find-upgrades () + (let (installed available upgrades) + ;; Build list of installed/available packages in this buffer. + (dolist (entry tabulated-list-entries) + ;; ENTRY is ((NAME . VERSION) [NAME VERSION STATUS DOC]) + (let ((pkg (car entry)) + (status (aref (cadr entry) 2)) + old) + (cond ((equal status "installed") + (push pkg installed)) + ((equal status "available") + (push pkg available))))) + ;; Loop through list of installed packages, finding upgrades + (dolist (pkg installed) + (let ((avail-pkg (assq (car pkg) available))) + (and avail-pkg + (version-list-< (cdr pkg) (cdr avail-pkg)) + (push avail-pkg upgrades)))) + upgrades)) + +(defun package-menu-mark-upgrades () + "Mark all upgradable packages in the Package Menu. +For each installed package with a newer version available, place +an (I)nstall flag on the available version and a (D)elete flag on +the installed version. A subsequent \\[package-menu-execute] +call will upgrade the package." + (interactive) + (unless (derived-mode-p 'package-menu-mode) + (error "The current buffer is not a Package Menu")) + (let ((upgrades (package-menu--find-upgrades))) + (if (null upgrades) + (message "No packages to upgrade.") + (widen) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (let* ((pkg (tabulated-list-get-id)) + (upgrade (assq (car pkg) upgrades))) + (cond ((null upgrade) + (forward-line 1)) + ((equal pkg upgrade) + (package-menu-mark-install)) + (t + (package-menu-mark-delete)))))) + (message "%d package%s marked for upgrading." + (length upgrades) + (if (= (length upgrades) 1) "" "s"))))) + (defun package-menu-execute () "Perform marked Package Menu actions. Packages marked for installation are downloaded and installed; packages marked for deletion are removed." (interactive) - (unless (eq major-mode 'package-menu-mode) + (unless (derived-mode-p 'package-menu-mode) (error "The current buffer is not in Package Menu mode")) (let (install-list delete-list cmd id) (save-excursion @@ -1503,6 +1594,14 @@ packages marked for deletion are removed." ((eq cmd ?I) (push (car id) install-list)))) (forward-line))) + (when install-list + (if (yes-or-no-p + (if (= (length install-list) 1) + (format "Install package `%s'? " (car install-list)) + (format "Install these %d packages (%s)? " + (length install-list) + (mapconcat 'symbol-name install-list ", ")))) + (mapc 'package-install install-list))) ;; Delete packages, prompting if necessary. (when delete-list (if (yes-or-no-p @@ -1517,18 +1616,10 @@ packages marked for deletion are removed." delete-list ", ")))) (dolist (elt delete-list) - (condition-case-no-debug err + (condition-case-unless-debug err (package-delete (car elt) (cdr elt)) (error (message (cadr err))))) (error "Aborted"))) - (when install-list - (if (yes-or-no-p - (if (= (length install-list) 1) - (format "Install package `%s'? " (car install-list)) - (format "Install these %d packages (%s)? " - (length install-list) - (mapconcat 'symbol-name install-list ", ")))) - (mapc 'package-install install-list))) ;; If we deleted anything, regenerate `package-alist'. This is done ;; automatically if we installed a package. (and delete-list (null install-list) @@ -1591,7 +1682,14 @@ The list is displayed in a buffer named `*Packages*'." (package-menu--generate nil t)) ;; The package menu buffer has keybindings. If the user types ;; `M-x list-packages', that suggests it should become current. - (switch-to-buffer buf))) + (switch-to-buffer buf)) + (let ((upgrades (package-menu--find-upgrades))) + (if upgrades + (message "%d package%s can be upgraded; type `%s' to mark %s for upgrading." + (length upgrades) + (if (= (length upgrades) 1) "" "s") + (substitute-command-keys "\\[package-menu-mark-upgrades]") + (if (= (length upgrades) 1) "it" "them"))))) ;;;###autoload (defalias 'package-list-packages 'list-packages) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index e6c4ccbbc50..afbc5df85ce 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -1,6 +1,6 @@ ;;; pcase.el --- ML-style pattern-matching macro for Elisp -*- lexical-binding: t -*- -;; Copyright (C) 2010-2011 Free Software Foundation, Inc. +;; Copyright (C) 2010-2012 Free Software Foundation, Inc. ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> ;; Keywords: @@ -363,12 +363,12 @@ MATCH is the pattern that needs to be matched, of the form: (dolist (branch rest) (let* ((match (car branch)) (code&vars (cdr branch)) - (splitted + (split (pcase--split-match sym splitter match))) - (unless (eq (car splitted) :pcase--fail) - (push (cons (car splitted) code&vars) then-rest)) - (unless (eq (cdr splitted) :pcase--fail) - (push (cons (cdr splitted) code&vars) else-rest)))) + (unless (eq (car split) :pcase--fail) + (push (cons (car split) code&vars) then-rest)) + (unless (eq (cdr split) :pcase--fail) + (push (cons (cdr split) code&vars) else-rest)))) (cons (nreverse then-rest) (nreverse else-rest)))) (defun pcase--split-consp (syma symd pat) @@ -685,7 +685,7 @@ Otherwise, it defers to REST which is a list of branches of the form (pcase--if `(,(if (stringp qpat) #'equal #'eq) ,sym ',qpat) (pcase--u1 matches code vars then-rest) (pcase--u else-rest)))) - (t (error "Unkown QPattern %s" qpat)))) + (t (error "Unknown QPattern %s" qpat)))) (provide 'pcase) diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index 2d1b8860a3c..48e0d6d6a21 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -1,6 +1,6 @@ ;;; pp.el --- pretty printer for Emacs Lisp -;; Copyright (C) 1989, 1993, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1989, 1993, 2001-2012 Free Software Foundation, Inc. ;; Author: Randal Schwartz <merlyn@stonehenge.com> ;; Keywords: lisp @@ -41,17 +41,14 @@ "Return a string containing the pretty-printed representation of OBJECT. OBJECT can be any Lisp object. Quoting characters are used as needed to make output that `read' can handle, whenever this is possible." - (with-current-buffer (generate-new-buffer " pp-to-string") - (unwind-protect - (progn - (lisp-mode-variables nil) - (set-syntax-table emacs-lisp-mode-syntax-table) - (let ((print-escape-newlines pp-escape-newlines) - (print-quoted t)) - (prin1 object (current-buffer))) - (pp-buffer) - (buffer-string)) - (kill-buffer (current-buffer))))) + (with-temp-buffer + (lisp-mode-variables nil) + (set-syntax-table emacs-lisp-mode-syntax-table) + (let ((print-escape-newlines pp-escape-newlines) + (print-quoted t)) + (prin1 object (current-buffer))) + (pp-buffer) + (buffer-string))) ;;;###autoload (defun pp-buffer () @@ -60,9 +57,7 @@ to make output that `read' can handle, whenever this is possible." (while (not (eobp)) ;; (message "%06d" (- (point-max) (point))) (cond - ((condition-case err-var - (prog1 t (down-list 1)) - (error nil)) + ((ignore-errors (down-list 1) t) (save-excursion (backward-char 1) (skip-chars-backward "'`#^") @@ -71,10 +66,8 @@ to make output that `read' can handle, whenever this is possible." (point) (progn (skip-chars-backward " \t\n") (point))) (insert "\n")))) - ((condition-case err-var - (prog1 t (up-list 1)) - (error nil)) - (while (looking-at "\\s)") + ((ignore-errors (up-list 1) t) + (while (looking-at-p "\\s)") (forward-char 1)) (delete-region (point) @@ -154,7 +147,7 @@ Also add the value to the front of the list in the variable `values'." (save-excursion (forward-sexp -1) ;; If first line is commented, ignore all leading comments: - (if (save-excursion (beginning-of-line) (looking-at "[ \t]*;")) + (if (save-excursion (beginning-of-line) (looking-at-p "[ \t]*;")) (progn (setq exp (buffer-substring (point) pt)) (while (string-match "\n[ \t]*;+" exp start) diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el index ebbd6ff1fdf..c8733202f31 100644 --- a/lisp/emacs-lisp/re-builder.el +++ b/lisp/emacs-lisp/re-builder.el @@ -1,6 +1,6 @@ ;;; re-builder.el --- building Regexps with visual feedback -*- lexical-binding: t -*- -;; Copyright (C) 1999-2011 Free Software Foundation, Inc. +;; Copyright (C) 1999-2012 Free Software Foundation, Inc. ;; Author: Detlev Zundel <dzu@gnu.org> ;; Keywords: matching, lisp, tools diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el index b538a7a2943..6d12fe19277 100644 --- a/lisp/emacs-lisp/regexp-opt.el +++ b/lisp/emacs-lisp/regexp-opt.el @@ -1,6 +1,6 @@ ;;; regexp-opt.el --- generate efficient regexps to match strings -;; Copyright (C) 1994-2011 Free Software Foundation, Inc. +;; Copyright (C) 1994-2012 Free Software Foundation, Inc. ;; Author: Simon Marshall <simon@gnu.org> ;; Maintainer: FSF @@ -143,7 +143,7 @@ This means the number of non-shy regexp grouping constructs "Return a regexp to match a string in the sorted list STRINGS. If PAREN non-nil, output regexp parentheses around returned regexp. If LAX non-nil, don't output parentheses if it doesn't require them. -Merges keywords to avoid backtracking in Emacs' regexp matcher." +Merges keywords to avoid backtracking in Emacs's regexp matcher." ;; The basic idea is to find the shortest common prefix or suffix, remove it ;; and recurse. If there is no prefix, we divide the list into two so that ;; \(at least) one half will have at least a one-character common prefix. diff --git a/lisp/emacs-lisp/regi.el b/lisp/emacs-lisp/regi.el index 8000dcd53dd..a68c67246ff 100644 --- a/lisp/emacs-lisp/regi.el +++ b/lisp/emacs-lisp/regi.el @@ -1,6 +1,6 @@ ;;; regi.el --- REGular expression Interpreting engine -;; Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc. ;; Author: 1993 Barry A. Warsaw, Century Computing, Inc. <bwarsaw@cen.com> ;; Maintainer: bwarsaw@cen.com @@ -161,7 +161,7 @@ useful information: (progn (goto-char end) (regi-pos 'bonl)) (progn (goto-char start) (regi-pos 'bol))))) - ;; lets find the special tags and remove them from the working + ;; let's find the special tags and remove them from the working ;; frame. note that only the last special tag is used. (mapc (function diff --git a/lisp/emacs-lisp/ring.el b/lisp/emacs-lisp/ring.el index affaa9ce32e..cee6a43df86 100644 --- a/lisp/emacs-lisp/ring.el +++ b/lisp/emacs-lisp/ring.el @@ -1,6 +1,6 @@ ;;; ring.el --- handle rings of items -;; Copyright (C) 1992, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: extensions @@ -185,26 +185,31 @@ Raise error if ITEM is not in the RING." (unless curr-index (error "Item is not in the ring: `%s'" item)) (ring-ref ring (ring-minus1 curr-index (ring-length ring))))) +(defun ring-extend (ring x) + "Increase the size of RING by X." + (when (and (integerp x) (> x 0)) + (let* ((hd (car ring)) + (length (ring-length ring)) + (size (ring-size ring)) + (old-vec (cddr ring)) + (new-vec (make-vector (+ size x) nil))) + (setcdr ring (cons length new-vec)) + ;; If the ring is wrapped, the existing elements must be written + ;; out in the right order. + (dotimes (j length) + (aset new-vec j (aref old-vec (mod (+ hd j) size)))) + (setcar ring 0)))) + (defun ring-insert+extend (ring item &optional grow-p) "Like `ring-insert', but if GROW-P is non-nil, then enlarge ring. Insert onto ring RING the item ITEM, as the newest (last) item. If the ring is full, behavior depends on GROW-P: If GROW-P is non-nil, enlarge the ring to accommodate the new item. If GROW-P is nil, dump the oldest item to make room for the new." - (let* ((vec (cddr ring)) - (veclen (length vec)) - (hd (car ring)) - (ringlen (ring-length ring))) - (prog1 - (cond ((and grow-p (= ringlen veclen)) ; Full ring. Enlarge it. - (setq veclen (1+ veclen)) - (setcdr ring (cons (setq ringlen (1+ ringlen)) - (setq vec (vconcat vec (vector item))))) - (setcar ring hd)) - (t (aset vec (mod (+ hd ringlen) veclen) item))) - (if (= ringlen veclen) - (setcar ring (ring-plus1 hd veclen)) - (setcar (cdr ring) (1+ ringlen)))))) + (and grow-p + (= (ring-length ring) (ring-size ring)) + (ring-extend ring 1)) + (ring-insert ring item)) (defun ring-remove+insert+extend (ring item &optional grow-p) "`ring-remove' ITEM from RING, then `ring-insert+extend' it. diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index 56efd142198..c246d0235f6 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -1,6 +1,6 @@ ;;; rx.el --- sexp notation for regular expressions -;; Copyright (C) 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 2001-2012 Free Software Foundation, Inc. ;; Author: Gerd Moellmann <gerd@gnu.org> ;; Maintainer: FSF @@ -393,7 +393,7 @@ FORM is of the form `(and FORM1 ...)'." (defun rx-anything (form) "Match any character." (if (consp form) - (error "rx `anythng' syntax error: %s" form)) + (error "rx `anything' syntax error: %s" form)) (rx-or (list 'or 'not-newline ?\n))) diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el index d5bba20b1cd..286c4937b5b 100644 --- a/lisp/emacs-lisp/shadow.el +++ b/lisp/emacs-lisp/shadow.el @@ -1,6 +1,6 @@ ;;; shadow.el --- locate Emacs Lisp file shadowings -;; Copyright (C) 1995, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1995, 2001-2012 Free Software Foundation, Inc. ;; Author: Terry Jones <terry@santafe.edu> ;; Keywords: lisp diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index 49ee051e62d..5382e601e67 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -1,6 +1,6 @@ ;;; smie.el --- Simple Minded Indentation Engine -*- lexical-binding: t -*- -;; Copyright (C) 2010-2011 Free Software Foundation, Inc. +;; Copyright (C) 2010-2012 Free Software Foundation, Inc. ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> ;; Keywords: languages, lisp, internal, parsing, indentation @@ -56,7 +56,7 @@ ;; building the 2D precedence tables and then computing the precedence levels ;; from it) can be found in pages 187-194 of "Parsing techniques" by Dick Grune ;; and Ceriel Jacobs (BookBody.pdf available at -;; http://www.cs.vu.nl/~dick/PTAPG.html). +;; http://dickgrune.com/Books/PTAPG_1st_Edition/). ;; ;; OTOH we had to kill many chickens, read many coffee grounds, and practice ;; untold numbers of black magic spells, to come up with the indentation code. @@ -69,13 +69,23 @@ ;; (exp ("IF" exp "ELSE" exp "END") ("CASE" cases "END")) ;; (cases (cases "ELSE" insts) ...) ;; The IF-rule implies ELSE=END and the CASE-rule implies ELSE>END. -;; FIXME: we could try to resolve such conflicts automatically by changing -;; the way BNF rules such as the IF-rule is handled. I.e. rather than -;; IF=ELSE and ELSE=END, we could turn them into IF<ELSE and ELSE>END -;; and IF=END, +;; This can be resolved simply with: +;; (exp ("IF" expelseexp "END") ("CASE" cases "END")) +;; (expelseexp (exp) (exp "ELSE" exp)) +;; (cases (cases "ELSE" insts) ...) +;; - Another source of conflict is when a terminator/separator is used to +;; terminate elements at different levels, as in: +;; (decls ("VAR" vars) (decls "," decls)) +;; (vars (id) (vars "," vars)) +;; often these can be resolved by making the lexer distinguish the two +;; kinds of commas, e.g. based on the following token. ;; TODO & BUGS: ;; +;; - We could try to resolve conflicts such as the IFexpELSEexpEND -vs- +;; CASE(casesELSEexp)END automatically by changing the way BNF rules such as +;; the IF-rule is handled. I.e. rather than IF=ELSE and ELSE=END, we could +;; turn them into IF<ELSE and ELSE>END and IF=END. ;; - Using the structural information SMIE gives us, it should be possible to ;; implement a `smie-align' command that would automatically figure out what ;; there is to align and how to do it (something like: align the token of @@ -107,6 +117,10 @@ ;;; Code: +;; FIXME: +;; - smie-indent-comment doesn't interact well with mis-indented lines (where +;; the indent rules don't do what the user wants). Not sure what to do. + (eval-when-compile (require 'cl)) (defgroup smie nil @@ -130,7 +144,7 @@ ;; - a 2 dimensional precedence table (key word "prec2"), is a 2D ;; table recording the precedence relation (can be `<', `=', `>', or ;; nil) between each pair of tokens. -;; - a precedence-level table (key word "grammar"), which is a alist +;; - a precedence-level table (key word "grammar"), which is an alist ;; giving for each token its left and right precedence level (a ;; number or nil). This is used in `smie-grammar'. ;; The prec2 tables are only intermediate data structures: the source @@ -138,6 +152,8 @@ ;; turns them into a levels table, which is what's used by the rest of ;; the SMIE code. +(defvar smie-warning-count 0) + (defun smie-set-prec2tab (table x y val &optional override) (assert (and x y)) (let* ((key (cons x y)) @@ -149,7 +165,8 @@ ;; be able to distinguish the two cases so that overrides ;; don't hide real conflicts. (puthash key (gethash key override) table) - (display-warning 'smie (format "Conflict: %s %s/%s %s" x old val y))) + (display-warning 'smie (format "Conflict: %s %s/%s %s" x old val y)) + (incf smie-warning-count)) (puthash key val table)))) (put 'smie-precs->prec2 'pure t) @@ -193,21 +210,54 @@ one of those elements share the same precedence level and associativity." prec2))) (put 'smie-bnf->prec2 'pure t) -(defun smie-bnf->prec2 (bnf &rest precs) +(defun smie-bnf->prec2 (bnf &rest resolvers) + "Convert the BNF grammar into a prec2 table. +BNF is a list of nonterminal definitions of the form: + \(NONTERM RHS1 RHS2 ...) +where each RHS is a (non-empty) list of terminals (aka tokens) or non-terminals. +Not all grammars are accepted: +- an RHS cannot be an empty list (this is not needed, since SMIE allows all + non-terminals to match the empty string anyway). +- an RHS cannot have 2 consecutive non-terminals: between each non-terminal + needs to be a terminal (aka token). This is a fundamental limitation of + the parsing technology used (operator precedence grammar). +Additionally, conflicts can occur: +- The returned prec2 table holds constraints between pairs of + token, and for any given pair only one constraint can be + present, either: T1 < T2, T1 = T2, or T1 > T2. +- A token can either be an `opener' (something similar to an open-paren), + a `closer' (like a close-paren), or `neither' of the two (e.g. an infix + operator, or an inner token like \"else\"). +Conflicts can be resolved via RESOLVERS, which is a list of elements that can +be either: +- a precs table (see `smie-precs->prec2') to resolve conflicting constraints, +- a constraint (T1 REL T2) where REL is one of = < or >." ;; FIXME: Add repetition operator like (repeat <separator> <elems>). ;; Maybe also add (or <elem1> <elem2>...) for things like ;; (exp (exp (or "+" "*" "=" ..) exp)). ;; Basically, make it EBNF (except for the specification of a separator in ;; the repetition, maybe). - (let ((nts (mapcar 'car bnf)) ;Non-terminals - (first-ops-table ()) - (last-ops-table ()) - (first-nts-table ()) - (last-nts-table ()) - (prec2 (make-hash-table :test 'equal)) - (override (apply 'smie-merge-prec2s - (mapcar 'smie-precs->prec2 precs))) - again) + (let* ((nts (mapcar 'car bnf)) ;Non-terminals. + (first-ops-table ()) + (last-ops-table ()) + (first-nts-table ()) + (last-nts-table ()) + (smie-warning-count 0) + (prec2 (make-hash-table :test 'equal)) + (override + (let ((precs ()) + (over (make-hash-table :test 'equal))) + (dolist (resolver resolvers) + (cond + ((and (= 3 (length resolver)) (memq (nth 1 resolver) '(= < >))) + (smie-set-prec2tab + over (nth 0 resolver) (nth 2 resolver) (nth 1 resolver))) + ((memq (caar resolver) '(left right assoc nonassoc)) + (push resolver precs)) + (t (error "Unknown resolver %S" resolver)))) + (apply #'smie-merge-prec2s over + (mapcar 'smie-precs->prec2 precs)))) + again) (dolist (rules bnf) (let ((nt (car rules)) (last-ops ()) @@ -287,8 +337,11 @@ one of those elements share the same precedence level and associativity." (setq rhs (cdr rhs))))) ;; Keep track of which tokens are openers/closer, so they can get a nil ;; precedence in smie-prec2->grammar. - (puthash :smie-open/close-alist (smie-bnf-classify bnf) prec2) - (puthash :smie-closer-alist (smie-bnf-closer-alist bnf) prec2) + (puthash :smie-open/close-alist (smie-bnf--classify bnf) prec2) + (puthash :smie-closer-alist (smie-bnf--closer-alist bnf) prec2) + (if (> smie-warning-count 0) + (display-warning + 'smie (format "Total: %d warnings" smie-warning-count))) prec2)) ;; (defun smie-prec2-closer-alist (prec2 include-inners) @@ -343,7 +396,7 @@ one of those elements share the same precedence level and associativity." ;; openers) ;; alist))) -(defun smie-bnf-closer-alist (bnf &optional no-inners) +(defun smie-bnf--closer-alist (bnf &optional no-inners) ;; We can also build this closer-alist table from a prec2 table, ;; but it takes more work, and the order is unpredictable, which ;; is a problem for smie-close-block. @@ -371,37 +424,33 @@ from the table, e.g. the table will not include things like (\"if\" . \"else\"). (pushnew (cons (car rhs) term) alist :test #'equal))))))) (nreverse alist))) -(defun smie-bnf-classify (bnf) +(defun smie-bnf--set-class (table token class) + (let ((prev (gethash token table class))) + (puthash token + (cond + ((eq prev class) class) + ((eq prev t) t) ;Non-terminal. + (t (display-warning + 'smie + (format "token %s is both %s and %s" token class prev)) + 'neither)) + table))) + +(defun smie-bnf--classify (bnf) "Return a table classifying terminals. -Each terminal can either be an `opener', a `closer', or neither." +Each terminal can either be an `opener', a `closer', or `neither'." (let ((table (make-hash-table :test #'equal)) - (nts (mapcar #'car bnf)) (alist '())) (dolist (category bnf) - (puthash (car category) 'neither table) ;Remove non-terminals. + (puthash (car category) t table)) ;Mark non-terminals. + (dolist (category bnf) (dolist (rhs (cdr category)) (if (null (cdr rhs)) - (puthash (pop rhs) 'neither table) - (let ((first (pop rhs))) - (puthash first - (if (memq (gethash first table) '(nil opener)) - 'opener - (unless (member first nts) - (error "SMIE: token %s is both opener and non-opener" - first)) - 'neither) - table)) - (while (cdr rhs) - (puthash (pop rhs) 'neither table)) ;Remove internals. - (let ((last (pop rhs))) - (puthash last - (if (memq (gethash last table) '(nil closer)) - 'closer - (unless (member last nts) - (error "SMIE: token %s is both closer and non-closer" - last)) - 'neither) - table))))) + (smie-bnf--set-class table (pop rhs) 'neither) + (smie-bnf--set-class table (pop rhs) 'opener) + (while (cdr rhs) ;Remove internals. + (smie-bnf--set-class table (pop rhs) 'neither)) + (smie-bnf--set-class table (pop rhs) 'closer)))) (maphash (lambda (tok v) (when (memq v '(closer opener)) (push (cons tok v) alist))) @@ -530,7 +579,7 @@ PREC2 is a table as returned by `smie-precs->prec2' or (smie-debug--describe-cycle table (smie-debug--prec2-cycle csts))))) (incf i 10)) - ;; Propagate equalities back to their source. + ;; Propagate equality constraints back to their sources. (dolist (eq (nreverse eqs)) (when (null (cadr eq)) ;; There's an equality constraint, but we still haven't given @@ -692,8 +741,22 @@ Possible return values: ;; Keep looking as long as we haven't matched the ;; topmost operator. (levels - (if (numberp (funcall op-forw toklevels)) - (push toklevels levels))) + (cond + ((numberp (funcall op-forw toklevels)) + (push toklevels levels)) + ;; FIXME: For some languages, we can express the grammar + ;; OK, but next-sexp doesn't stop where we'd want it to. + ;; E.g. in SML, we'd want to stop right in front of + ;; "local" if we're scanning (both forward and backward) + ;; from a "val/fun/..." at the same level. + ;; Same for Pascal/Modula2's "procedure" w.r.t + ;; "type/var/const". + ;; + ;; ((and (functionp (cadr (funcall op-forw toklevels))) + ;; (funcall (cadr (funcall op-forw toklevels)) + ;; levels)) + ;; (setq levels nil)) + )) ;; We matched the topmost operator. If the new operator ;; is the last in the corresponding BNF rule, we're done. ((not (numberp (funcall op-forw toklevels))) @@ -759,7 +822,7 @@ Possible return values: (indirect-function 'smie-op-left) halfsexp)) -;;; Miscellanous commands using the precedence parser. +;;; Miscellaneous commands using the precedence parser. (defun smie-backward-sexp-command (&optional n) "Move backward through N logical elements." @@ -980,7 +1043,7 @@ function should return nil for arguments it does not expect. OFFSET can be: nil use the default indentation rule. -`(column . COLUMN) indent to column COLUMN. +\(column . COLUMN) indent to column COLUMN. NUMBER offset by NUMBER, relative to a base token which is the current token for :after and its parent for :before. @@ -1612,8 +1675,9 @@ KEYWORDS are additional arguments, which can use the following keywords: (while (setq closer (pop closers)) (unless (and closers ;; FIXME: this eliminates prefixes of other - ;; closers, but we should probably elimnate - ;; prefixes of other keywords as well. + ;; closers, but we should probably + ;; eliminate prefixes of other keywords + ;; as well. (string-prefix-p closer (car closers))) (push (aref closer (1- (length closer))) triggers))) (delete-dups triggers))))))) diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index 200b3a6389b..611a766922a 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -1,6 +1,6 @@ ;;; syntax.el --- helper functions to find syntactic context -;; Copyright (C) 2000-2011 Free Software Foundation, Inc. +;; Copyright (C) 2000-2012 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal @@ -56,7 +56,7 @@ ;; syntax-ppss-flush-cache since that would not only flush the cache but also ;; reset syntax-propertize--done which should not be done in this case). "Mode-specific function to apply the syntax-table properties. -Called with 2 arguments: START and END. +Called with two arguments: START and END. This function can call `syntax-ppss' on any position before END, but it should not call `syntax-ppss-flush-cache', which means that it should not call `syntax-ppss' on some position and later modify the buffer on some @@ -100,7 +100,7 @@ Put first the functions more likely to cause a change and cheaper to compute.") (cons beg end)) (defvar syntax-propertize--done -1 - "Position upto which syntax-table properties have been set.") + "Position up to which syntax-table properties have been set.") (make-variable-buffer-local 'syntax-propertize--done) (defun syntax-propertize--shift-groups (re n) @@ -248,7 +248,7 @@ Note: back-references in REGEXPs do not work." (if syntax (put-text-property mb me 'syntax-table syntax)))))))) - + (if (or (not (cddr rule)) (zerop gn)) (setq code (nconc (nreverse thiscode) code)) (push `(if (match-beginning ,gn) @@ -283,7 +283,7 @@ The return value is a function suitable for `syntax-propertize-function'." (setq keywords font-lock-syntactic-keywords)))))) (defun syntax-propertize (pos) - "Ensure that syntax-table properties are set upto POS." + "Ensure that syntax-table properties are set until POS." (when (and syntax-propertize-function (< syntax-propertize--done pos)) ;; (message "Needs to syntax-propertize from %s to %s" diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 2fdfa9525b1..f17b12da6a0 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -1,6 +1,6 @@ -;;; tabulated-list.el --- generic major mode for tabulated lists. +;;; tabulated-list.el --- generic major mode for tabulated lists -*- lexical-binding: t -*- -;; Copyright (C) 2011 Free Software Foundation, Inc. +;; Copyright (C) 2011-2012 Free Software Foundation, Inc. ;; Author: Chong Yidong <cyd@stupidchicken.com> ;; Keywords: extensions, lisp @@ -146,7 +146,7 @@ If ADVANCE is non-nil, move forward by one line afterwards." (defvar tabulated-list-glyphless-char-display (let ((table (make-char-table 'glyphless-char-display nil))) (set-char-table-parent table glyphless-char-display) - ;; Some text terminals can't display the unicode arrows; be safe. + ;; Some text terminals can't display the Unicode arrows; be safe. (aset table 9650 (cons nil "^")) (aset table 9660 (cons nil "v")) table) @@ -258,7 +258,8 @@ to the entry with the same ID element as the current line." ;; If REMEMBER-POS was specified, move to the "old" location. (if saved-pt (progn (goto-char saved-pt) - (move-to-column saved-col)) + (move-to-column saved-col) + (recenter)) (goto-char (point-min))))) (defun tabulated-list-print-entry (id cols) @@ -277,11 +278,11 @@ of column descriptors." (width (nth 1 format)) (label (if (stringp desc) desc (car desc))) (help-echo (concat (car format) ": " label))) - ;; Truncate labels if necessary. - (and (> width 6) - (> (length label) width) - (setq label (concat (substring label 0 (- width 3)) - "..."))) + ;; Truncate labels if necessary (except last column). + (and (< (1+ n) len) + (> (string-width label) width) + (setq label (truncate-string-to-width label width nil nil t))) + (setq label (bidi-string-mark-left-to-right label)) (if (stringp desc) (insert (propertize label 'help-echo help-echo)) (apply 'insert-text-button label (cdr desc))) @@ -319,7 +320,7 @@ This mode is usually not used directly; instead, other major modes are derived from it, using `define-derived-mode'. In this major mode, the buffer is divided into multiple columns, -which are labelled using the header line. Each non-empty line +which are labeled using the header line. Each non-empty line belongs to one \"entry\", and the entries can be sorted according to their column values. @@ -360,7 +361,6 @@ as the ewoc pretty-printer." ;; Local Variables: ;; coding: utf-8 -;; lexical-binding: t ;; End: ;;; tabulated-list.el ends here diff --git a/lisp/emacs-lisp/tcover-ses.el b/lisp/emacs-lisp/tcover-ses.el index b91b96b83e5..79251bfd6e1 100644 --- a/lisp/emacs-lisp/tcover-ses.el +++ b/lisp/emacs-lisp/tcover-ses.el @@ -1,6 +1,6 @@ ;;;; testcover-ses.el -- Example use of `testcover' to test "SES" -;; Copyright (C) 2002-2011 Free Software Foundation, Inc. +;; Copyright (C) 2002-2012 Free Software Foundation, Inc. ;; Author: Jonathan Yavner <jyavner@engineer.com> ;; Maintainer: Jonathan Yavner <jyavner@engineer.com> diff --git a/lisp/emacs-lisp/tcover-unsafep.el b/lisp/emacs-lisp/tcover-unsafep.el index cc3e633f098..2de6e6c5bc0 100644 --- a/lisp/emacs-lisp/tcover-unsafep.el +++ b/lisp/emacs-lisp/tcover-unsafep.el @@ -1,6 +1,6 @@ ;;;; testcover-unsafep.el -- Use testcover to test unsafep's code coverage -;; Copyright (C) 2002-2011 Free Software Foundation, Inc. +;; Copyright (C) 2002-2012 Free Software Foundation, Inc. ;; Author: Jonathan Yavner <jyavner@engineer.com> ;; Maintainer: Jonathan Yavner <jyavner@engineer.com> @@ -100,7 +100,7 @@ . (risky-local-variable format-alist)) ( (setq buffer-display-count (delete-file "x")) . (function delete-file)) - ;;These are actualy safe (they signal errors) + ;;These are actually safe (they signal errors) ( (apply '(x) '(1 2 3)) . (function (x))) ( (let (((x))) 1) diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el index 2f168180cf6..3999529f7ac 100644 --- a/lisp/emacs-lisp/testcover.el +++ b/lisp/emacs-lisp/testcover.el @@ -1,6 +1,6 @@ ;;;; testcover.el -- Visual code-coverage tool -;; Copyright (C) 2002-2011 Free Software Foundation, Inc. +;; Copyright (C) 2002-2012 Free Software Foundation, Inc. ;; Author: Jonathan Yavner <jyavner@member.fsf.org> ;; Maintainer: Jonathan Yavner <jyavner@member.fsf.org> @@ -28,7 +28,7 @@ ;; * Use `testcover-mark-all' to add overlay "splotches" to the Lisp file's ;; buffer to show where coverage is lacking. Normally, a red splotch ;; indicates the form was never evaluated; a brown splotch means it always -;; evaluted to the same value. +;; evaluated to the same value. ;; * Use `testcover-next-mark' (bind it to a key!) to jump to the next spot ;; that has a splotch. @@ -220,7 +220,7 @@ non-nil, byte-compiles each function after instrumenting." (defun testcover-reinstrument (form) "Reinstruments FORM to use testcover instead of edebug. This function modifies the list that FORM points to. Result is nil if -FORM should return multiple vlues, t if should always return same +FORM should return multiple values, t if should always return same value, 'maybe if either is acceptable." (let ((fun (car-safe form)) id val) @@ -509,7 +509,7 @@ eliminated by adding more test cases." (set-buffer-modified-p changed)))) (defun testcover-mark-all (&optional buffer) - "Mark all forms in BUFFER that did not get completley tested during + "Mark all forms in BUFFER that did not get completely tested during coverage tests. This function creates many overlays." (interactive "bMark forms in buffer: ") (if buffer diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index 0e007ff7176..b6b7c266263 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -1,6 +1,6 @@ ;;; timer.el --- run a function with args at some time in future -;; Copyright (C) 1996, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1996, 2001-2012 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Package: emacs @@ -402,10 +402,6 @@ This function returns a timer object which you can use in `cancel-timer'." (timer-activate-when-idle timer t) timer)) -(defun with-timeout-handler (tag) - "This is the timer function used for the timer made by `with-timeout'." - (throw tag 'timeout)) - (defvar with-timeout-timers nil "List of all timers used by currently pending `with-timeout' calls.") @@ -417,24 +413,27 @@ event (such as keyboard input, input from subprocesses, or a certain time); if the program loops without waiting in any way, the timeout will not be detected. \n(fn (SECONDS TIMEOUT-FORMS...) BODY)" - (declare (indent 1)) + (declare (indent 1) (debug ((form body) body))) (let ((seconds (car list)) - (timeout-forms (cdr list))) - `(let ((with-timeout-tag (cons nil nil)) - with-timeout-value with-timeout-timer - (with-timeout-timers with-timeout-timers)) - (if (catch with-timeout-tag - (progn - (setq with-timeout-timer - (run-with-timer ,seconds nil - 'with-timeout-handler - with-timeout-tag)) - (push with-timeout-timer with-timeout-timers) - (setq with-timeout-value (progn . ,body)) - nil)) - (progn . ,timeout-forms) - (cancel-timer with-timeout-timer) - with-timeout-value)))) + (timeout-forms (cdr list)) + (timeout (make-symbol "timeout"))) + `(let ((-with-timeout-value- + (catch ',timeout + (let* ((-with-timeout-timer- + (run-with-timer ,seconds nil + (lambda () (throw ',timeout ',timeout)))) + (with-timeout-timers + (cons -with-timeout-timer- with-timeout-timers))) + (unwind-protect + ,@body + (cancel-timer -with-timeout-timer-)))))) + ;; It is tempting to avoid the `if' altogether and instead run + ;; timeout-forms in the timer, just before throwing `timeout'. + ;; But that would mean that timeout-forms are run in the deeper + ;; dynamic context of the timer, with inhibit-quit set etc... + (if (eq -with-timeout-value- ',timeout) + (progn ,@timeout-forms) + -with-timeout-value-)))) (defun with-timeout-suspend () "Stop the clock for `with-timeout'. Used by debuggers. diff --git a/lisp/emacs-lisp/tq.el b/lisp/emacs-lisp/tq.el index 3d3b371ad5c..0d13a3caed0 100644 --- a/lisp/emacs-lisp/tq.el +++ b/lisp/emacs-lisp/tq.el @@ -1,6 +1,6 @@ ;;; tq.el --- utility to maintain a transaction queue -;; Copyright (C) 1985-1987, 1992, 2001-2011 Free Software Foundation, Inc. +;; Copyright (C) 1985-1987, 1992, 2001-2012 Free Software Foundation, Inc. ;; Author: Scott Draves <spot@cs.cmu.edu> ;; Maintainer: FSF diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el index 22c1f0e7ea7..fd66c9364f2 100644 --- a/lisp/emacs-lisp/trace.el +++ b/lisp/emacs-lisp/trace.el @@ -1,6 +1,6 @@ ;;; trace.el --- tracing facility for Emacs Lisp functions -;; Copyright (C) 1993, 1998, 2000-2011 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1998, 2000-2012 Free Software Foundation, Inc. ;; Author: Hans Chalupsky <hans@cs.buffalo.edu> ;; Maintainer: FSF diff --git a/lisp/emacs-lisp/unsafep.el b/lisp/emacs-lisp/unsafep.el index 0f08d77d4c3..11256c294d9 100644 --- a/lisp/emacs-lisp/unsafep.el +++ b/lisp/emacs-lisp/unsafep.el @@ -1,6 +1,6 @@ ;;;; unsafep.el -- Determine whether a Lisp form is safe to evaluate -;; Copyright (C) 2002-2011 Free Software Foundation, Inc. +;; Copyright (C) 2002-2012 Free Software Foundation, Inc. ;; Author: Jonathan Yavner <jyavner@member.fsf.org> ;; Maintainer: Jonathan Yavner <jyavner@member.fsf.org> diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el index 7f3657bbbe6..ab35d8f3d8f 100644 --- a/lisp/emacs-lisp/warnings.el +++ b/lisp/emacs-lisp/warnings.el @@ -1,6 +1,6 @@ ;;; warnings.el --- log and display warnings -;; Copyright (C) 2002-2011 Free Software Foundation, Inc. +;; Copyright (C) 2002-2012 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal |