From acaf905b1130aae80fa59d2c861ffd4c8eb75486 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Thu, 5 Jan 2012 01:46:05 -0800 Subject: Add 2012 to FSF copyright years for Emacs files --- lisp/emacs-lisp/lisp-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp/lisp-mode.el') diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 44e87e171d1..3d581e26758 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 -- cgit v1.2.3 From db17443466147411261b559458fa6e8df6587d12 Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sun, 29 Jan 2012 12:45:51 +0800 Subject: Make Emacs Lisp mode use emacs-lisp-mode-abbrev-table. * lisp/emacs-lisp/lisp-mode.el (emacs-lisp-mode-abbrev-table): Define and use in Emacs Lisp mode. (lisp-mode-abbrev-table): Add doc. (lisp-mode-variables): Don't set local-abbrev-table. (lisp-interaction-mode): Use emacs-lisp-mode-abbrev-table. Fixes: debbugs:9360 --- lisp/ChangeLog | 8 ++++++++ lisp/emacs-lisp/lisp-mode.el | 12 +++++++++--- 2 files changed, 17 insertions(+), 3 deletions(-) (limited to 'lisp/emacs-lisp/lisp-mode.el') diff --git a/lisp/ChangeLog b/lisp/ChangeLog index e7a09b7b208..e74adea65e6 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,11 @@ +2012-01-29 Chong Yidong + + * emacs-lisp/lisp-mode.el (emacs-lisp-mode-abbrev-table): Define + and use in Emacs Lisp mode (Bug#9360). + (lisp-mode-abbrev-table): Add doc. + (lisp-mode-variables): Don't set local-abbrev-table. + (lisp-interaction-mode): Use emacs-lisp-mode-abbrev-table. + 2012-01-28 Roland Winkler * textmodes/bibtex.el (bibtex-vec-incr): Fix docstring. diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 3d581e26758..95eb8c963be 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -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)) @@ -206,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) @@ -540,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. -- cgit v1.2.3 From b581bb5c8ac2aed4a610097aaaca4a8d354fe9b4 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 17 May 2012 21:46:20 -0400 Subject: * lisp/emacs-lisp/lisp-mode.el (doc-string-elt): Move those properties to their respective macro declarations. * lisp/skeleton.el (define-skeleton): * lisp/progmodes/compile.el (define-compilation-mode): * lisp/ibuf-macs.el (define-ibuffer-sorter, define-ibuffer-op) (define-ibuffer-filter): * lisp/emacs-lisp/generic.el (define-generic-mode): * lisp/emacs-lisp/easy-mmode.el (define-minor-mode) (define-globalized-minor-mode): * lisp/emacs-lisp/cl-macs.el (defun*, defmacro*, defstruct, deftype): * lisp/emacs-lisp/byte-run.el (defsubst): * lisp/custom.el (deftheme): Add doc-string metadata. --- lisp/ChangeLog | 15 ++++++++++ lisp/cedet/mode-local.el | 4 +++ lisp/custom.el | 1 + lisp/emacs-lisp/byte-run.el | 2 +- lisp/emacs-lisp/cl-loaddefs.el | 66 +++++++++++++++++++++++++++++++++++++++++- lisp/emacs-lisp/cl-macs.el | 7 +++-- lisp/emacs-lisp/cl.el | 9 ++++++ lisp/emacs-lisp/easy-mmode.el | 5 ++-- lisp/emacs-lisp/generic.el | 3 +- lisp/emacs-lisp/lisp-mode.el | 20 ------------- lisp/ibuf-macs.el | 6 ++-- lisp/progmodes/compile.el | 3 ++ lisp/skeleton.el | 2 +- 13 files changed, 112 insertions(+), 31 deletions(-) (limited to 'lisp/emacs-lisp/lisp-mode.el') diff --git a/lisp/ChangeLog b/lisp/ChangeLog index fcdb2ce65b7..e22b3d07985 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,18 @@ +2012-05-18 Stefan Monnier + + * emacs-lisp/lisp-mode.el (doc-string-elt): Move those properties to + their respective macro declarations. + * skeleton.el (define-skeleton): + * progmodes/compile.el (define-compilation-mode): + * ibuf-macs.el (define-ibuffer-sorter, define-ibuffer-op) + (define-ibuffer-filter): + * emacs-lisp/generic.el (define-generic-mode): + * emacs-lisp/easy-mmode.el (define-minor-mode) + (define-globalized-minor-mode): + * emacs-lisp/cl-macs.el (defun*, defmacro*, defstruct, deftype): + * emacs-lisp/byte-run.el (defsubst): + * custom.el (deftheme): Add doc-string metadata. + 2012-05-17 Stefan Monnier * emacs-lisp/cl-macs.el, emacs-lisp/cl.el: Move indent info. diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el index 7346e88797d..11968f3fa35 100644 --- a/lisp/cedet/mode-local.el +++ b/lisp/cedet/mode-local.el @@ -522,6 +522,9 @@ See also the function `define-overload'." (list (mode-local--override name args body)) result))) +;;;###autoload +(put 'define-overloadable-function 'doc-string-elt 3) + (defmacro define-overloadable-function (name args docstring &rest body) "Define a new function, as with `defun', which can be overloaded. NAME is the name of the function to create. @@ -546,6 +549,7 @@ defined. The default is to call the function `NAME-default' with the appropriate arguments deduced from ARGS. OVERARGS is a list of arguments passed to the override and `NAME-default' function, in place of those deduced from ARGS." + (declare (doc-string 3)) `(eval-and-compile (defun ,name ,args ,docstring diff --git a/lisp/custom.el b/lisp/custom.el index d0eadcc23ff..50481f2aa7f 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1048,6 +1048,7 @@ The optional argument DOC is a doc string describing the theme. Any theme `foo' should be defined in a file called `foo-theme.el'; see `custom-make-theme-feature' for more information." + (declare (doc-string 2)) (let ((feature (custom-make-theme-feature theme))) ;; It is better not to use backquote in this file, ;; because that makes a bootstrapping problem diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index dc7166bc2ea..7de3396f8ed 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -96,7 +96,7 @@ The return value of this function is not used." ;; This has a special byte-hunk-handler in bytecomp.el. (defmacro defsubst (name arglist &rest body) "Define an inline function. The syntax is just like that of `defun'." - (declare (debug defun)) + (declare (debug defun) (doc-string 3)) (or (memq (get name 'byte-optimizer) '(nil byte-compile-inline-expand)) (error "`%s' is a primitive" name)) diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index d16b98630c8..a9380619e6a 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -286,7 +286,7 @@ This also does some trivial optimizations to make the form prettier. ;;;;;; 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" "ed94b3ba46080516e6ada69bdf617be5") +;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "c383ef0fa5f6d28796cd8e9cf65e1c5d") ;;; Generated autoloads from cl-macs.el (autoload 'gensym "cl-macs" "\ @@ -308,6 +308,10 @@ and BODY is implicitly surrounded by (block NAME ...). \(fn NAME ARGLIST [DOCSTRING] BODY...)" nil (quote macro)) +(put 'defun* 'lisp-indent-function '2) + +(put 'defun* 'doc-string-elt '3) + (autoload 'defmacro* "cl-macs" "\ Define NAME as a macro. Like normal `defmacro', except ARGLIST allows full Common Lisp conventions, @@ -315,6 +319,10 @@ and BODY is implicitly surrounded by (block NAME ...). \(fn NAME ARGLIST [DOCSTRING] BODY...)" nil (quote macro)) +(put 'defmacro* 'lisp-indent-function '2) + +(put 'defmacro* 'doc-string-elt '3) + (autoload 'function* "cl-macs" "\ Introduce a function. Like normal `function', except that if argument is a lambda form, @@ -327,6 +335,8 @@ its argument list allows full Common Lisp conventions. \(fn ARGS EXPR &rest BODY)" nil (quote macro)) +(put 'destructuring-bind 'lisp-indent-function '2) + (autoload 'eval-when "cl-macs" "\ Control when BODY is evaluated. If `compile' is in WHEN, BODY is evaluated when compiled at top-level. @@ -335,6 +345,8 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level. \(fn (WHEN...) BODY...)" nil (quote macro)) +(put 'eval-when 'lisp-indent-function '1) + (autoload 'load-time-value "cl-macs" "\ Like `progn', but evaluates the body at load time. The result of the body appears to the compiler as a quoted constant. @@ -352,12 +364,16 @@ Key values are compared by `eql'. \(fn EXPR (KEYLIST BODY...)...)" nil (quote macro)) +(put 'case 'lisp-indent-function '1) + (autoload 'ecase "cl-macs" "\ Like `case', but error if no case fits. `otherwise'-clauses are not allowed. \(fn EXPR (KEYLIST BODY...)...)" nil (quote macro)) +(put 'ecase 'lisp-indent-function '1) + (autoload 'typecase "cl-macs" "\ Evals EXPR, chooses among clauses on that value. Each clause looks like (TYPE BODY...). EXPR is evaluated and, if it @@ -367,12 +383,16 @@ final clause, and matches if no other keys match. \(fn EXPR (TYPE BODY...)...)" nil (quote macro)) +(put 'typecase 'lisp-indent-function '1) + (autoload 'etypecase "cl-macs" "\ Like `typecase', but error if no case fits. `otherwise'-clauses are not allowed. \(fn EXPR (TYPE BODY...)...)" nil (quote macro)) +(put 'etypecase 'lisp-indent-function '1) + (autoload 'block "cl-macs" "\ Define a lexically-scoped block named NAME. NAME may be any symbol. Code inside the BODY forms can call `return-from' @@ -385,6 +405,8 @@ called from BODY. \(fn NAME &rest BODY)" nil (quote macro)) +(put 'block 'lisp-indent-function '1) + (autoload 'return "cl-macs" "\ Return from the block named nil. This is equivalent to `(return-from nil RESULT)'. @@ -400,6 +422,8 @@ This is compatible with Common Lisp, but note that `defun' and \(fn NAME &optional RESULT)" nil (quote macro)) +(put 'return-from 'lisp-indent-function '1) + (autoload 'loop "cl-macs" "\ The Common Lisp `loop' macro. Valid clauses are: @@ -421,11 +445,15 @@ The Common Lisp `do' loop. \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil (quote macro)) +(put 'do 'lisp-indent-function '2) + (autoload 'do* "cl-macs" "\ The Common Lisp `do*' loop. \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil (quote macro)) +(put 'do* 'lisp-indent-function '2) + (autoload 'dolist "cl-macs" "\ Loop over a list. Evaluate BODY with VAR bound to each `car' from LIST, in turn. @@ -449,11 +477,15 @@ from OBARRAY. \(fn (VAR [OBARRAY [RESULT]]) BODY...)" nil (quote macro)) +(put 'do-symbols 'lisp-indent-function '1) + (autoload 'do-all-symbols "cl-macs" "\ \(fn SPEC &rest BODY)" nil (quote macro)) +(put 'do-all-symbols 'lisp-indent-function '1) + (autoload 'psetq "cl-macs" "\ Set SYMs to the values VALs in parallel. This is like `setq', except that all VAL forms are evaluated (in order) @@ -471,6 +503,8 @@ a `let' form, except that the list of symbols can be computed at run-time. \(fn SYMBOLS VALUES &rest BODY)" nil (quote macro)) +(put 'progv 'lisp-indent-function '2) + (autoload 'flet "cl-macs" "\ Make temporary function definitions. This is an analogue of `let' that operates on the function cell of FUNC @@ -480,6 +514,8 @@ go back to their previous definitions, or lack thereof). \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil (quote macro)) +(put 'flet 'lisp-indent-function '1) + (autoload 'labels "cl-macs" "\ Make temporary function bindings. This is like `flet', except the bindings are lexical instead of dynamic. @@ -487,12 +523,16 @@ Unlike `flet', this macro is fully compliant with the Common Lisp standard. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil (quote macro)) +(put 'labels 'lisp-indent-function '1) + (autoload 'macrolet "cl-macs" "\ Make temporary macro definitions. This is like `flet', but for macros instead of functions. \(fn ((NAME ARGLIST BODY...) ...) FORM...)" nil (quote macro)) +(put 'macrolet 'lisp-indent-function '1) + (autoload 'symbol-macrolet "cl-macs" "\ Make symbol macro definitions. Within the body FORMs, references to the variable NAME will be replaced @@ -500,6 +540,8 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). \(fn ((NAME EXPANSION) ...) FORM...)" nil (quote macro)) +(put 'symbol-macrolet 'lisp-indent-function '1) + (autoload 'lexical-let "cl-macs" "\ Like `let', but lexically scoped. The main visible difference is that lambdas inside BODY will create @@ -507,6 +549,8 @@ lexical closures as in Common Lisp. \(fn BINDINGS BODY)" nil (quote macro)) +(put 'lexical-let 'lisp-indent-function '1) + (autoload 'lexical-let* "cl-macs" "\ Like `let*', but lexically scoped. The main visible difference is that lambdas inside BODY, and in @@ -516,6 +560,8 @@ Common Lisp. \(fn BINDINGS BODY)" nil (quote macro)) +(put 'lexical-let* 'lisp-indent-function '1) + (autoload 'multiple-value-bind "cl-macs" "\ Collect multiple return values. FORM must return a list; the BODY is then executed with the first N elements @@ -526,6 +572,8 @@ a synonym for (list A B C). \(fn (SYM...) FORM BODY)" nil (quote macro)) +(put 'multiple-value-bind 'lisp-indent-function '2) + (autoload 'multiple-value-setq "cl-macs" "\ Collect multiple return values. FORM must return a list; the first N elements of this list are stored in @@ -535,6 +583,8 @@ values. For compatibility, (values A B C) is a synonym for (list A B C). \(fn (SYM...) FORM)" nil (quote macro)) +(put 'multiple-value-setq 'lisp-indent-function '1) + (autoload 'locally "cl-macs" "\ @@ -545,6 +595,8 @@ values. For compatibility, (values A B C) is a synonym for (list A B C). \(fn TYPE FORM)" nil (quote macro)) +(put 'the 'lisp-indent-function '1) + (autoload 'declare "cl-macs" "\ Declare SPECS about the current function while compiling. For instance @@ -649,6 +701,8 @@ the PLACE is not modified before executing BODY. \(fn ((PLACE VALUE) ...) BODY...)" nil (quote macro)) +(put 'letf 'lisp-indent-function '1) + (autoload 'letf* "cl-macs" "\ Temporarily bind to PLACEs. This is the analogue of `let*', but with generalized variables (in the @@ -661,6 +715,8 @@ the PLACE is not modified before executing BODY. \(fn ((PLACE VALUE) ...) BODY...)" nil (quote macro)) +(put 'letf* 'lisp-indent-function '1) + (autoload 'callf "cl-macs" "\ Set PLACE to (FUNC PLACE ARGS...). FUNC should be an unquoted function name. PLACE may be a symbol, @@ -668,12 +724,16 @@ or any generalized variable allowed by `setf'. \(fn FUNC PLACE ARGS...)" nil (quote macro)) +(put 'callf 'lisp-indent-function '2) + (autoload 'callf2 "cl-macs" "\ Set PLACE to (FUNC ARG1 PLACE ARGS...). Like `callf', but PLACE is the second argument of FUNC, not the first. \(fn FUNC ARG1 PLACE ARGS...)" nil (quote macro)) +(put 'callf2 'lisp-indent-function '3) + (autoload 'define-modify-macro "cl-macs" "\ Define a `setf'-like modify macro. If NAME is called, it combines its PLACE argument with the other arguments @@ -699,6 +759,8 @@ value, that slot cannot be set via `setf'. \(fn NAME SLOTS...)" nil (quote macro)) +(put 'defstruct 'doc-string-elt '2) + (autoload 'cl-struct-setf-expander "cl-macs" "\ @@ -710,6 +772,8 @@ The type name can then be used in `typecase', `check-type', etc. \(fn NAME ARGLIST &rest BODY)" nil (quote macro)) +(put 'deftype 'doc-string-elt '3) + (autoload 'typep "cl-macs" "\ Check that OBJECT is of type TYPE. TYPE is a Common Lisp-style type specifier. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 441ae55758c..c547a4f6460 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -227,6 +227,7 @@ and BODY is implicitly surrounded by (block NAME ...). cl-declarations-or-string [&optional ("interactive" interactive)] def-body)) + (doc-string 3) (indent 2)) (let* ((res (cl-transform-lambda (cons args body) name)) (form (list* 'defun name (cdr res)))) @@ -279,6 +280,7 @@ and BODY is implicitly surrounded by (block NAME ...). \(fn NAME ARGLIST [DOCSTRING] BODY...)" (declare (debug (&define name cl-macro-list cl-declarations-or-string def-body)) + (doc-string 3) (indent 2)) (let* ((res (cl-transform-lambda (cons args body) name)) (form (list* 'defmacro name (cdr res)))) @@ -2587,7 +2589,8 @@ one keyword is supported, `:read-only'. If this has a non-nil value, that slot cannot be set via `setf'. \(fn NAME SLOTS...)" - (declare (debug + (declare (doc-string 2) + (debug (&define ;Makes top-level form not be wrapped. [&or symbolp (gate @@ -2854,7 +2857,7 @@ value, that slot cannot be set via `setf'. (defmacro deftype (name arglist &rest body) "Define NAME as a new data type. The type name can then be used in `typecase', `check-type', etc." - (declare (debug defmacro*)) + (declare (debug defmacro*) (doc-string 3)) (list 'eval-when '(compile load eval) (cl-transform-function-property name 'cl-deftype-handler (cons (list* '&cl-defs ''('*) arglist) body)))) diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index 7c486e17dcf..137dd1bfb84 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -656,6 +656,15 @@ If ALIST is non-nil, the new pairs are prepended to it." (fmakunbound 'dolist) (fmakunbound 'dotimes) (fmakunbound 'declare) +;;;###autoload +(progn + ;; Autoload, so autoload.el and font-lock can use it even when CL + ;; is not loaded. + (put 'defun* 'doc-string-elt 3) + (put 'defmacro* 'doc-string-elt 3) + (put 'defsubst 'doc-string-elt 3) + (put 'defstruct 'doc-string-elt 2)) + (load "cl-loaddefs" nil 'quiet) ;; This goes here so that cl-macs can find it if it loads right now. diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 301947f0735..a11f213e646 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -142,7 +142,8 @@ For example, you could write (define-minor-mode foo-mode \"If enabled, foo on you!\" :lighter \" Foo\" :require 'foo :global t :group 'hassle :version \"27.5\" ...BODY CODE...)" - (declare (debug (&define name stringp + (declare (doc-string 2) + (debug (&define name stringp [&optional [¬ keywordp] sexp &optional [¬ keywordp] sexp &optional [¬ keywordp] sexp] @@ -335,7 +336,7 @@ enabled, then disabling and reenabling MODE should make MODE work correctly with the current major mode. This is important to prevent problems with derived modes, that is, major modes that call another major mode in their body." - + (declare (doc-string 2)) (let* ((global-mode-name (symbol-name global-mode)) (pretty-name (easy-mmode-pretty-mode-name mode)) (pretty-global-name (easy-mmode-pretty-mode-name global-mode)) diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el index b9db092fafc..80b6122822e 100644 --- a/lisp/emacs-lisp/generic.el +++ b/lisp/emacs-lisp/generic.el @@ -151,7 +151,8 @@ mode hook `MODE-hook'. See the file generic-x.el for some examples of `define-generic-mode'." (declare (debug (sexp def-form def-form def-form form def-form [&optional stringp] &rest [keywordp form])) - (indent 1)) + (indent 1) + (doc-string 7)) ;; Backward compatibility. (when (eq (car-safe mode) 'quote) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 95eb8c963be..dfdac92ae32 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -136,34 +136,14 @@ It has `lisp-mode-abbrev-table' as its parent." ;; This was originally in autoload.el and is still used there. (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) -(put 'deftype 'doc-string-elt 3) (put 'defconst 'doc-string-elt 3) (put 'defmacro 'doc-string-elt 3) -(put 'defmacro* 'doc-string-elt 3) -(put 'defsubst 'doc-string-elt 3) -(put 'defstruct 'doc-string-elt 2) -(put 'define-skeleton 'doc-string-elt 2) -(put 'define-derived-mode 'doc-string-elt 4) -(put 'define-compilation-mode 'doc-string-elt 3) -(put 'easy-mmode-define-minor-mode 'doc-string-elt 2) -(put 'define-minor-mode 'doc-string-elt 2) -(put 'easy-mmode-define-global-mode 'doc-string-elt 2) -(put 'define-global-minor-mode 'doc-string-elt 2) -(put 'define-globalized-minor-mode 'doc-string-elt 2) -(put 'define-generic-mode 'doc-string-elt 7) -(put 'define-ibuffer-filter 'doc-string-elt 2) -(put 'define-ibuffer-op 'doc-string-elt 3) -(put 'define-ibuffer-sorter 'doc-string-elt 2) (put 'lambda 'doc-string-elt 2) (put 'defalias 'doc-string-elt 3) (put 'defvaralias 'doc-string-elt 3) (put 'define-category 'doc-string-elt 2) -(put 'define-overloadable-function 'doc-string-elt 3) (defvar lisp-doc-string-elt-property 'doc-string-elt "The symbol property that holds the docstring position info.") diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el index f47592e82bb..659b8e7d78c 100644 --- a/lisp/ibuf-macs.el +++ b/lisp/ibuf-macs.el @@ -143,7 +143,7 @@ buffer object, and `b' bound to another. BODY should return a non-nil value if and only if `a' is \"less than\" `b'. \(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)" - (declare (indent 1)) + (declare (indent 1) (doc-string 2)) `(progn (defun ,(intern (concat "ibuffer-do-sort-by-" (symbol-name name))) () ,(or documentation "No :documentation specified for this sorting method.") @@ -202,7 +202,7 @@ COMPLEX means this function is special; see the source code of this macro for exactly what it does. \(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING COMPLEX) &rest BODY)" - (declare (indent 2)) + (declare (indent 2) (doc-string 3)) `(progn (defun ,(intern (concat (if (string-match "^ibuffer-do" (symbol-name op)) "" "ibuffer-do-") (symbol-name op))) @@ -280,7 +280,7 @@ will be evaluated with BUF bound to the buffer object, and QUALIFIER bound to the current value of the filter. \(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)" - (declare (indent 2)) + (declare (indent 2) (doc-string 2)) (let ((fn-name (intern (concat "ibuffer-filter-by-" (symbol-name name))))) `(progn (defun ,fn-name (qualifier) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 7ffaddb2c49..fe1b63f3048 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1884,6 +1884,9 @@ Runs `compilation-mode-hook' with `run-mode-hooks' (which see). (setq buffer-read-only t) (run-mode-hooks 'compilation-mode-hook)) +;;;###autoload +(put 'define-compilation-mode 'doc-string-elt 3) + (defmacro define-compilation-mode (mode name doc &rest body) "This is like `define-derived-mode' without the PARENT argument. The parent is always `compilation-mode' and the customizable `compilation-...' diff --git a/lisp/skeleton.el b/lisp/skeleton.el index 328f795ecd2..34d69a74369 100644 --- a/lisp/skeleton.el +++ b/lisp/skeleton.el @@ -121,7 +121,7 @@ are integer buffer positions in the reverse order of the insertion order.") "Define a user-configurable COMMAND that enters a statement skeleton. DOCUMENTATION is that of the command. SKELETON is as defined under `skeleton-insert'." - (declare (debug (&define name stringp skeleton-edebug-spec))) + (declare (doc-string 2) (debug (&define name stringp skeleton-edebug-spec))) (if skeleton-debug (set command skeleton)) `(progn -- cgit v1.2.3 From a179e3f7b472b3b5075a98e3b33852e9f223cd83 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 26 May 2012 11:52:27 -0400 Subject: Use `declare' in `lambda' and mis minor changes. * lisp/subr.el (lambda): Use declare. * lisp/emacs-lisp/lisp-mode.el (lambda): * lisp/emacs-lisp/edebug.el (lambda): Move properties to its definition. * lisp/gnus/legacy-gnus-agent.el (gnus-agent-unhook-expire-days): * lisp/gnus/gnus-demon.el (gnus-demon-init): Don't bother with type-of. --- lisp/ChangeLog | 6 ++++++ lisp/emacs-lisp/edebug.el | 6 ------ lisp/emacs-lisp/lisp-mode.el | 2 -- lisp/emacs-lisp/pcase.el | 7 +++++-- lisp/gnus/ChangeLog | 5 +++++ lisp/gnus/gnus-demon.el | 5 ++--- lisp/gnus/legacy-gnus-agent.el | 18 ++++++++++-------- lisp/subr.el | 5 +++++ src/print.c | 4 +--- 9 files changed, 34 insertions(+), 24 deletions(-) (limited to 'lisp/emacs-lisp/lisp-mode.el') diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 97c1e4b5320..78551914fee 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2012-05-26 Stefan Monnier + + * subr.el (lambda): Use declare. + * emacs-lisp/lisp-mode.el (lambda): + * emacs-lisp/edebug.el (lambda): Move properties to its definition. + 2012-05-26 Aaron S. Hawley * thingatpt.el (forward-same-syntax): Handle no ARG case. (Bug#11560) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 2c7e7cf6362..9d3ee307083 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -2010,12 +2010,6 @@ expressions; a `progn' form will be returned enclosing these forms." ;; A macro is allowed by Emacs. (def-edebug-spec function (&or symbolp lambda-expr)) -;; lambda is a macro in emacs 19. -(def-edebug-spec lambda (&define lambda-list - [&optional stringp] - [&optional ("interactive" interactive)] - def-body)) - ;; A macro expression is a lambda expression with "macro" prepended. (def-edebug-spec macro (&define "lambda" lambda-list def-body)) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index dfdac92ae32..d76c1ad3e72 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -140,7 +140,6 @@ It has `lisp-mode-abbrev-table' as its parent." (put 'defvar 'doc-string-elt 3) (put 'defconst 'doc-string-elt 3) (put 'defmacro 'doc-string-elt 3) -(put 'lambda 'doc-string-elt 2) (put 'defalias 'doc-string-elt 3) (put 'defvaralias 'doc-string-elt 3) (put 'define-category 'doc-string-elt 2) @@ -1213,7 +1212,6 @@ Lisp function does not specify a special indentation." ;; like defun if the first form is placed on the next line, otherwise ;; it is indented like any other form (i.e. forms line up under first). -(put 'lambda 'lisp-indent-function 'defun) (put 'autoload 'lisp-indent-function 'defun) (put 'progn 'lisp-indent-function 0) (put 'prog1 'lisp-indent-function 1) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 67b19443967..363c0965c3e 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -39,12 +39,15 @@ ;; - along these lines, provide patterns to match CL structs. ;; - provide something like (setq VAR) so a var can be set rather than ;; let-bound. -;; - provide a way to fallthrough to subsequent cases. +;; - provide a way to fallthrough to subsequent cases (not sure what I meant by +;; this :-() ;; - try and be more clever to reduce the size of the decision tree, and ;; to reduce the number of leaves that need to be turned into function: ;; - first, do the tests shared by all remaining branches (it will have -;; to be performed anyway, so better so it first so it's shared). +;; to be performed anyway, so better do it first so it's shared). ;; - then choose the test that discriminates more (?). +;; - provide Agda's `with' (along with its `...' companion). +;; - implement (not UPAT). This might require a significant redesign. ;; - ideally we'd want (pcase s ((re RE1) E1) ((re RE2) E2)) to be able to ;; generate a lex-style DFA to decide whether to run E1 or E2. diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 1c5984e96cd..50ce9075dc0 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,8 @@ +2012-05-26 Stefan Monnier + + * legacy-gnus-agent.el (gnus-agent-unhook-expire-days): + * gnus-demon.el (gnus-demon-init): Don't bother with type-of. + 2012-05-25 Stefan Monnier * gnus-win.el (gnus-configure-frame): Don't signal an error when diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el index d0baf25d5d9..2a4fa6f483e 100644 --- a/lisp/gnus/gnus-demon.el +++ b/lisp/gnus/gnus-demon.el @@ -116,7 +116,6 @@ Emacs has been idle for IDLE `gnus-demon-timestep's." ;; Set up the timer. (let* ((func (nth 0 handler)) (time (nth 1 handler)) - (time-type (type-of time)) (idle (nth 2 handler)) ;; Compute time according with timestep. ;; If t, replace by 1 @@ -140,10 +139,10 @@ Emacs has been idle for IDLE `gnus-demon-timestep's." (run-with-idle-timer idle t 'gnus-demon-run-callback func)) ;; (func number any) ;; Call every `time' - ((eq time-type 'integer) + ((integerp time) (run-with-timer time time 'gnus-demon-run-callback func idle)) ;; (func string any) - ((eq time-type 'string) + ((stringp time) (run-with-timer time (* 24 60 60) 'gnus-demon-run-callback func idle))))) (when timer (add-to-list 'gnus-demon-timers timer))))) diff --git a/lisp/gnus/legacy-gnus-agent.el b/lisp/gnus/legacy-gnus-agent.el index afbebbff79f..ecde35dca8f 100644 --- a/lisp/gnus/legacy-gnus-agent.el +++ b/lisp/gnus/legacy-gnus-agent.el @@ -206,29 +206,31 @@ converted to the compressed format." (gnus-convert-mark-converter-prompt 'gnus-agent-unlist-expire-days t) (defun gnus-agent-unhook-expire-days (converting-to) - "Remove every lambda from gnus-group-prepare-hook that mention the -symbol gnus-agent-do-once in their definition. This should NOT be + "Remove every lambda from `gnus-group-prepare-hook' that mention the +symbol `gnus-agent-do-once' in their definition. This should NOT be necessary as gnus-agent.el no longer adds them. However, it is possible that the hook was persistently saved." - (let ((h t)) ; iterate from bgn of hook + (let ((h t)) ; Iterate from bgn of hook. (while h (let ((func (progn (when (eq h t) - ;; init h to list of functions + ;; Init h to list of functions. (setq h (cond ((listp gnus-group-prepare-hook) gnus-group-prepare-hook) ((boundp 'gnus-group-prepare-hook) (list gnus-group-prepare-hook))))) (pop h)))) - (when (cond ((eq (type-of func) 'compiled-function) - ;; Search def. of compiled function for gnus-agent-do-once string + (when (cond ((byte-code-function-p func) + ;; Search def. of compiled function for + ;; gnus-agent-do-once string. (let* (definition print-level print-length (standard-output (lambda (char) (setq definition (cons char definition))))) - (princ func) ; populates definition with reversed list of characters + (princ func) ; Populates definition with reversed list + ; of characters. (let* ((i (length definition)) (s (make-string i 0))) (while definition @@ -236,7 +238,7 @@ possible that the hook was persistently saved." (string-match "\\bgnus-agent-do-once\\b" s)))) ((listp func) - (eq (cadr (nth 2 func)) 'gnus-agent-do-once) ; handles eval'd lambda + (eq (cadr (nth 2 func)) 'gnus-agent-do-once) ; Handles eval'd lambda. )) (remove-hook 'gnus-group-prepare-hook func) diff --git a/lisp/subr.el b/lisp/subr.el index 0166a3276a8..0078fca8033 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -112,6 +112,11 @@ It may also be omitted. BODY should be a list of Lisp expressions. \(fn ARGS [DOCSTRING] [INTERACTIVE] BODY)" + (declare (doc-string 2) (indent defun) + (debug (&define lambda-list + [&optional stringp] + [&optional ("interactive" interactive)] + def-body))) ;; Note that this definition should not use backquotes; subr.el should not ;; depend on backquote.el. (list 'function (cons 'lambda cdr))) diff --git a/src/print.c b/src/print.c index 2912396bd33..2158d06dbca 100644 --- a/src/print.c +++ b/src/print.c @@ -1086,9 +1086,7 @@ print (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag) if (HASH_TABLE_P (Vprint_number_table)) { /* Remove unnecessary objects, which appear only once in OBJ; - that is, whose status is Qt. - Maybe a better way to do that is to copy elements to - a new hash table. */ + that is, whose status is Qt. */ struct Lisp_Hash_Table *h = XHASH_TABLE (Vprint_number_table); ptrdiff_t i; -- cgit v1.2.3 From e4d4f53985fc9ab929f063f63a173a9114d3beb6 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sun, 27 May 2012 12:45:54 +0300 Subject: * lisp/emacs-lisp/lisp-mode.el (eval-defun-2): Use `eval-sexp-add-defvars' after the `eval-defun-1' specialcaseing like in `edebug-eval-defun'. * lisp/emacs-lisp/edebug.el (edebug-eval-defun): Set `face-documentation' like in `eval-defun-1'. Fixes: debbugs:10181 --- lisp/ChangeLog | 9 +++++++++ lisp/emacs-lisp/edebug.el | 1 + lisp/emacs-lisp/lisp-mode.el | 4 ++-- 3 files changed, 12 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp/lisp-mode.el') diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3a71d8edfa5..7a22046fba6 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2012-05-27 Juri Linkov + + * emacs-lisp/lisp-mode.el (eval-defun-2): Use `eval-sexp-add-defvars' + after the `eval-defun-1' specialcaseing + like in `edebug-eval-defun' (bug#10181). + + * emacs-lisp/edebug.el (edebug-eval-defun): Set `face-documentation' + like in `eval-defun-1'. + 2012-05-27 Eli Zaretskii * mail/sendmail.el (mail-yank-region): Recognize diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 9d3ee307083..ee5e5d0ff89 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -527,6 +527,7 @@ the minibuffer." (setq face-new-frame-defaults (assq-delete-all (nth 1 form) face-new-frame-defaults)) (put (nth 1 form) 'face-defface-spec nil) + (put (nth 1 form) 'face-documentation (nth 3 form)) ;; See comments in `eval-defun-1' for purpose of code below (setq form (prog1 `(prog1 ,form (put ',(nth 1 form) 'saved-face diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index d76c1ad3e72..973d57d4210 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -829,10 +829,10 @@ Return the result of evaluation." (end-of-defun) (beginning-of-defun) (setq beg (point)) - (setq form (eval-sexp-add-defvars (read (current-buffer)))) + (setq form (read (current-buffer))) (setq end (point))) ;; Alter the form if necessary. - (setq form (eval-defun-1 (macroexpand form))) + (setq form (eval-sexp-add-defvars (eval-defun-1 (macroexpand form)))) (list beg end standard-output `(lambda (ignore) ;; Skipping to the end of the specified region -- cgit v1.2.3 From 61b108cc62d69c96c20b9e23b248185591563c1f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 29 May 2012 23:59:42 -0400 Subject: * lisp/emacs-lisp/byte-run.el (defmacro, defun): Move from C. (macro-declaration-function): Move var from C code. (macro-declaration-function): Define function with defalias. * lisp/emacs-lisp/macroexp.el (macroexpand-all-1): * lisp/emacs-lisp/cconv.el (cconv-convert, cconv-analyse-form): * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Don't handle defun/defmacro any more. * lisp/emacs-lisp/bytecomp.el (byte-compile-arglist-signature): Provide fallback for unknown arglist. (byte-compile-arglist-warn): Change calling convention. (byte-compile-output-file-form): Move print-vars binding. (byte-compile-output-docform): Simplify accordingly. (byte-compile-file-form-defun, byte-compile-file-form-defmacro) (byte-compile-defmacro-declaration): Remove. (byte-compile-file-form-defmumble): Generalize to defalias. (byte-compile-output-as-comment): Return byte-positions. Simplify callers accordingly. (byte-compile-lambda): Use `assert'. (byte-compile-defun, byte-compile-defmacro): Remove. (byte-compile-file-form-defalias): Use byte-compile-file-form-defmumble. (byte-compile-defalias-warn): Remove. * src/eval.c (Fdefun, Fdefmacro, Vmacro_declaration_function): Move to byte-run.el. (Fautoload): Do the hash-doc more carefully. * src/data.c (Fdefalias): Purify definition, except for keymaps. (Qdefun): Move from eval.c. * src/lisp.h (Qdefun): Remove. * src/lread.c (read1): Tiny simplification. * lib-src/make-docfile.c: Improve comment style. (search_lisp_doc_at_eol): New function. (scan_lisp_file): Use it. --- lib-src/ChangeLog | 48 +++-- lib-src/make-docfile.c | 153 +++++--------- lisp/ChangeLog | 32 ++- lisp/emacs-lisp/byte-opt.el | 2 +- lisp/emacs-lisp/byte-run.el | 111 ++++++++-- lisp/emacs-lisp/bytecomp.el | 492 ++++++++++++++++++++----------------------- lisp/emacs-lisp/cconv.el | 25 --- lisp/emacs-lisp/elint.el | 2 + lisp/emacs-lisp/lisp-mode.el | 2 - lisp/emacs-lisp/macroexp.el | 16 +- lisp/loadup.el | 15 ++ src/ChangeLog | 28 ++- src/data.c | 10 +- src/eval.c | 132 +----------- src/lisp.h | 2 +- src/lread.c | 17 +- 16 files changed, 491 insertions(+), 596 deletions(-) (limited to 'lisp/emacs-lisp/lisp-mode.el') diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index 7dc02ccaa95..d95137852e0 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -1,3 +1,9 @@ +2012-05-30 Stefan Monnier + + * make-docfile.c: Improve comment style. + (search_lisp_doc_at_eol): New function. + (scan_lisp_file): Use it. + 2012-05-26 Glenn Morris * Makefile.in (INSTALL_DATA): Remove; unused. @@ -441,8 +447,8 @@ * etags.c (canonicalize_filename, ISUPPER): Fix last change. - * makefile.w32-in ($(BLD)/ebrowse.$(O), $(BLD)/pop.$(O)): Depend - on ../lib/min-max.h. + * makefile.w32-in ($(BLD)/ebrowse.$(O), $(BLD)/pop.$(O)): + Depend on ../lib/min-max.h. 2011-02-22 Paul Eggert @@ -2819,7 +2825,7 @@ * make-docfile.c (read_c_string_or_comment): Declare msgno. - * Makefile.in (YACC): Deleted. + * Makefile.in (YACC): Delete. 2002-10-19 Andreas Schwab @@ -3037,7 +3043,7 @@ (TeX_commands): Names now include the initial backslash. (TeX_commands): Names do not include numeric args #n. (TeX_commands): Correct line char number in tags. - (TEX_tabent, TEX_token): Deleted. + (TEX_tabent, TEX_token): Delete. (TeX_commands, TEX_decode_env): Streamlined. 2002-06-05 Francesco Potortì @@ -3078,7 +3084,7 @@ (main): New argument -d, for specifying directory. (usage): Document. (get_user_id): Compute. - (get_home_dir): Deleted. + (get_home_dir): Delete. (get_prefix): New function, taken from main. (main): Check whether or not we are running setuid. Move prefix computation to get_prefix. Don't call getpwent; we don't need to @@ -3339,7 +3345,7 @@ (LOOKING_AT, get_tag, PHP_functions): Use notinname. (Ada_getit, Ada_funcs, Python_functions, Scheme_functions): Clarified, using strneq or notinname. - (L_isdef, L_isquote): Removed. + (L_isdef, L_isquote): Remove. (Lisp_functions, L_getit): Clarified. * etags.c (P_): Rename to __P for consistency with config.h. @@ -3776,7 +3782,7 @@ comma when --declarations is used. (C_entries): More accurate tagging of members and declarations. (yacc_rules): Was global, made local to C_entries. - (next_token_is_func): Removed. + (next_token_is_func): Remove. (fvdef): New constants fdefunkey, fdefunname. (consider_token, C_entries): Use them. (C_entries): Build proper lisp names for Emacs DEFUNs. @@ -4252,7 +4258,7 @@ (find_entries, takeprec, getit, Fortran_functions, Perl_functions) (Python_functions, L_getit, Lisp_functions, Scheme_functions) (prolog_pred, erlanf_func, erlang_attribute): Use them. - (eat_white): Deleted. + (eat_white): Delete. * etags.c (CHAR, init): Keep into account non US-ASCII characters and compilers with default signed chars. @@ -4775,7 +4781,7 @@ 1997-05-13 Francesco Potortì * etags.c (TeX_functions): Cleaned up. - (tex_getit): Removed. + (tex_getit): Remove. 1997-05-13 Paul Eggert @@ -5296,7 +5302,7 @@ * etags.c: Prolog language totally rewritten. (Prolog_functions): Rewritten from scratch. - (skip_comment, prolog_getit): Removed. + (skip_comment, prolog_getit): Remove. (prolog_skip_comment): New function, like old skip_comment. (prolog_pred, prolog_atom, prolog_white): New functions. (erlang_func, erlang_attributes): Forward declarations added. @@ -5797,7 +5803,7 @@ 1995-01-12 Francesco Potortì (pot@cnuce.cnr.it) - * etags.c (FILEPOS, GET_CHARNO, GET_FILEPOS, max, LINENO): Deleted. + * etags.c (FILEPOS, GET_CHARNO, GET_FILEPOS, max, LINENO): Delete. (append_to_tagfile, typedefs, typedefs_and_cplusplus) (constantypedefs, update, vgrind_style, no_warnings) (cxref_style, cplusplus, noindentypedefs): Were int, now logical. @@ -5816,9 +5822,9 @@ (consider_token): Don't take a token as argument. Use savenstr when saving a tag in structtag. Callers changed. (TOKEN): Structure changed. Now used only in C_entries. - (TOKEN_SAVED_P, SAVE_TOKEN, RESTORE_TOKEN): Deleted. + (TOKEN_SAVED_P, SAVE_TOKEN, RESTORE_TOKEN): Delete. (C_entries): nameb and savenameb deleted. Use dinamic allocation. - (pfcnt): Deleted. Users updated. + (pfcnt): Delete. Users updated. (getit, Asm_labels, Pascal_functions, L_getit, get_scheme) (TEX_getit, prolog_getit): Use dinamic allocation for storing the tag instead of a fixed size buffer. @@ -6394,7 +6400,7 @@ 1994-03-25 Francesco Potortì (pot@cnuce.cnr.it) - * etags.c (emacs_tags_format, ETAGS): Removed. Use CTAGS instead. + * etags.c (emacs_tags_format, ETAGS): Remove. Use CTAGS instead. (main): Don't allow the use of -t and -T in etags mode. (print_help): Don't show options enabled by default. (print_version): Show the emacs version number if VERSION is #defined. @@ -6511,9 +6517,9 @@ 1994-01-14 Francesco Potortì (pot@cnuce.cnr.it) * etags.c (stab_entry, stab_create, stab_find, stab_search, - stab_type, add_keyword, C_reate_stab, C_create_stabs): Deleted. + stab_type, add_keyword, C_reate_stab, C_create_stabs): Delete. Use gperf generated hash table instead of linked list. - (C_stab_entry, hash, in_word_set, get_C_stab, C_symtype): Added. + (C_stab_entry, hash, in_word_set, get_C_stab, C_symtype): Add. Mostly code generated by gperf. (consider_token): Remove unused parameter `lp'. (PF_funcs, getit): Allow subroutine and similar declarations @@ -6832,7 +6838,7 @@ * etags.c (consider_token): Was `==', now is `='. (consider_token): DEFUNs now treated like funcs in ctags mode. - * etags.c (LEVEL_OK_FOR_FUNCDEF): Removed. + * etags.c (LEVEL_OK_FOR_FUNCDEF): Remove. (C_entries): Optimized the test that used LEVEL_OK_FOR_FUNCDEF. (C_entries): Remove a piece of useless code. (C_entries): Making typedef tags is delayed until a semicolon @@ -7131,10 +7137,10 @@ * etags.c (GET_COOKIE): And related macros removed. (logical): Is now int, no more a char. (reg): Define deleted. - (isgood, _gd, notgd): Deleted. - (gotone): Deleted. + (isgood, _gd, notgd): Delete. + (gotone): Delete. (TOKEN): Member linestart removed. - (linepos, prev_linepos, lb1): Deleted. + (linepos, prev_linepos, lb1): Delete. (main): Call initbuffer on lbs array instead of lb1. (init): Remove the initialization of the logical _gd array. (find_entries): A .sa suffix means assembler file. @@ -7142,7 +7148,7 @@ All C state machines rewritten. (C_entries): Complete rewrite. (condider_token): Complete rewrite. - (getline): Deleted. + (getline): Delete. 1993-03-01 Francesco Potortì (pot@fly.CNUCE.CNR.IT) diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c index b33b13f34ce..1314a7b6829 100644 --- a/lib-src/make-docfile.c +++ b/lib-src/make-docfile.c @@ -35,7 +35,7 @@ along with GNU Emacs. If not, see . */ #include -/* defined to be emacs_main, sys_fopen, etc. in config.h */ +/* Defined to be emacs_main, sys_fopen, etc. in config.h. */ #undef main #undef fopen #undef chdir @@ -66,7 +66,7 @@ along with GNU Emacs. If not, see . */ #define IS_DIRECTORY_SEP(_c_) ((_c_) == DIRECTORY_SEP) #endif -/* Use this to suppress gcc's `...may be used before initialized' warnings. */ +/* Use this to suppress gcc's `...may be used before initialized' warnings. */ #ifdef lint # define IF_LINT(Code) Code #else @@ -226,7 +226,7 @@ put_filename (char *filename) for (tmp = filename; *tmp; tmp++) { - if (IS_DIRECTORY_SEP(*tmp)) + if (IS_DIRECTORY_SEP (*tmp)) filename = tmp + 1; } @@ -675,14 +675,14 @@ scan_c_file (char *filename, const char *mode) if (infile == NULL && extension == 'o') { - /* try .m */ + /* Try .m. */ filename[strlen (filename) - 1] = 'm'; infile = fopen (filename, mode); if (infile == NULL) - filename[strlen (filename) - 1] = 'c'; /* don't confuse people */ + filename[strlen (filename) - 1] = 'c'; /* Don't confuse people. */ } - /* No error if non-ex input file */ + /* No error if non-ex input file. */ if (infile == NULL) { perror (filename); @@ -800,8 +800,8 @@ scan_c_file (char *filename, const char *mode) input_buffer[i++] = c; c = getc (infile); } - while (! (c == ',' || c == ' ' || c == '\t' || - c == '\n' || c == '\r')); + while (! (c == ',' || c == ' ' || c == '\t' + || c == '\n' || c == '\r')); input_buffer[i] = '\0'; name = xmalloc (i + 1); @@ -820,7 +820,7 @@ scan_c_file (char *filename, const char *mode) commas = 3; else if (defvarflag) commas = 1; - else /* For DEFSIMPLE and DEFPRED */ + else /* For DEFSIMPLE and DEFPRED. */ commas = 2; while (commas) @@ -838,9 +838,9 @@ scan_c_file (char *filename, const char *mode) if (c < 0) goto eof; ungetc (c, infile); - if (commas == 2) /* pick up minargs */ + if (commas == 2) /* Pick up minargs. */ scanned = fscanf (infile, "%d", &minargs); - else /* pick up maxargs */ + else /* Pick up maxargs. */ if (c == 'M' || c == 'U') /* MANY || UNEVALLED */ maxargs = -1; else @@ -893,7 +893,7 @@ scan_c_file (char *filename, const char *mode) fprintf (outfile, "%s\n", input_buffer); if (comment) - getc (infile); /* Skip past `*' */ + getc (infile); /* Skip past `*'. */ c = read_c_string_or_comment (infile, 1, comment, &saw_usage); /* If this is a defun, find the arguments and print them. If @@ -979,7 +979,7 @@ scan_c_file (char *filename, const char *mode) problem because byte-compiler output follows this convention. The NAME and DOCSTRING are output. NAME is preceded by `F' for a function or `V' for a variable. - An entry is output only if DOCSTRING has \ newline just after the opening " + An entry is output only if DOCSTRING has \ newline just after the opening ". */ static void @@ -1019,6 +1019,32 @@ read_lisp_symbol (FILE *infile, char *buffer) skip_white (infile); } +static int +search_lisp_doc_at_eol (FILE *infile) +{ + char c = 0, c1 = 0, c2 = 0; + + /* Skip until the end of line; remember two previous chars. */ + while (c != '\n' && c != '\r' && c >= 0) + { + c2 = c1; + c1 = c; + c = getc (infile); + } + + /* If two previous characters were " and \, + this is a doc string. Otherwise, there is none. */ + if (c2 != '"' || c1 != '\\') + { +#ifdef DEBUG + fprintf (stderr, "## non-docstring in %s (%s)\n", + buffer, filename); +#endif + return 0; + } + return 1; +} + static int scan_lisp_file (const char *filename, const char *mode) { @@ -1033,7 +1059,7 @@ scan_lisp_file (const char *filename, const char *mode) if (infile == NULL) { perror (filename); - return 0; /* No error */ + return 0; /* No error. */ } c = '\n'; @@ -1110,7 +1136,7 @@ scan_lisp_file (const char *filename, const char *mode) type = 'F'; read_lisp_symbol (infile, buffer); - /* Skip the arguments: either "nil" or a list in parens */ + /* Skip the arguments: either "nil" or a list in parens. */ c = getc (infile); if (c == 'n') /* nil */ @@ -1154,39 +1180,18 @@ scan_lisp_file (const char *filename, const char *mode) || ! strcmp (buffer, "defconst") || ! strcmp (buffer, "defcustom")) { - char c1 = 0, c2 = 0; type = 'V'; read_lisp_symbol (infile, buffer); if (saved_string == 0) - { - - /* Skip until the end of line; remember two previous chars. */ - while (c != '\n' && c != '\r' && c >= 0) - { - c2 = c1; - c1 = c; - c = getc (infile); - } - - /* If two previous characters were " and \, - this is a doc string. Otherwise, there is none. */ - if (c2 != '"' || c1 != '\\') - { -#ifdef DEBUG - fprintf (stderr, "## non-docstring in %s (%s)\n", - buffer, filename); -#endif - continue; - } - } + if (!search_lisp_doc_at_eol (infile)) + continue; } else if (! strcmp (buffer, "custom-declare-variable") || ! strcmp (buffer, "defvaralias") ) { - char c1 = 0, c2 = 0; type = 'V'; c = getc (infile); @@ -1221,31 +1226,12 @@ scan_lisp_file (const char *filename, const char *mode) } if (saved_string == 0) - { - /* Skip to end of line; remember the two previous chars. */ - while (c != '\n' && c != '\r' && c >= 0) - { - c2 = c1; - c1 = c; - c = getc (infile); - } - - /* If two previous characters were " and \, - this is a doc string. Otherwise, there is none. */ - if (c2 != '"' || c1 != '\\') - { -#ifdef DEBUG - fprintf (stderr, "## non-docstring in %s (%s)\n", - buffer, filename); -#endif - continue; - } - } + if (!search_lisp_doc_at_eol (infile)) + continue; } else if (! strcmp (buffer, "fset") || ! strcmp (buffer, "defalias")) { - char c1 = 0, c2 = 0; type = 'F'; c = getc (infile); @@ -1278,26 +1264,8 @@ scan_lisp_file (const char *filename, const char *mode) } if (saved_string == 0) - { - /* Skip to end of line; remember the two previous chars. */ - while (c != '\n' && c != '\r' && c >= 0) - { - c2 = c1; - c1 = c; - c = getc (infile); - } - - /* If two previous characters were " and \, - this is a doc string. Otherwise, there is none. */ - if (c2 != '"' || c1 != '\\') - { -#ifdef DEBUG - fprintf (stderr, "## non-docstring in %s (%s)\n", - buffer, filename); -#endif - continue; - } - } + if (!search_lisp_doc_at_eol (infile)) + continue; } else if (! strcmp (buffer, "autoload")) @@ -1339,23 +1307,10 @@ scan_lisp_file (const char *filename, const char *mode) continue; } read_c_string_or_comment (infile, 0, 0, 0); - skip_white (infile); if (saved_string == 0) - { - /* If the next three characters aren't `dquote bslash newline' - then we're not reading a docstring. */ - if ((c = getc (infile)) != '"' - || (c = getc (infile)) != '\\' - || ((c = getc (infile)) != '\n' && c != '\r')) - { -#ifdef DEBUG - fprintf (stderr, "## non-docstring in %s (%s)\n", - buffer, filename); -#endif - continue; - } - } + if (!search_lisp_doc_at_eol (infile)) + continue; } #ifdef DEBUG @@ -1373,12 +1328,10 @@ scan_lisp_file (const char *filename, const char *mode) continue; } - /* At this point, we should either use the previous - dynamic doc string in saved_string - or gobble a doc string from the input file. - - In the latter case, the opening quote (and leading - backslash-newline) have already been read. */ + /* At this point, we should either use the previous dynamic doc string in + saved_string or gobble a doc string from the input file. + In the latter case, the opening quote (and leading backslash-newline) + have already been read. */ putc (037, outfile); putc (type, outfile); diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 80cbdef406c..ccd4de5f754 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,8 +1,32 @@ +2012-05-30 Stefan Monnier + + * emacs-lisp/byte-run.el (defmacro, defun): Move from C. + (macro-declaration-function): Move var from C code. + (macro-declaration-function): Define function with defalias. + * emacs-lisp/macroexp.el (macroexpand-all-1): + * emacs-lisp/cconv.el (cconv-convert, cconv-analyse-form): + * emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Don't handle + defun/defmacro any more. + * emacs-lisp/bytecomp.el (byte-compile-arglist-signature): + Provide fallback for unknown arglist. + (byte-compile-arglist-warn): Change calling convention. + (byte-compile-output-file-form): Move print-vars binding. + (byte-compile-output-docform): Simplify accordingly. + (byte-compile-file-form-defun, byte-compile-file-form-defmacro) + (byte-compile-defmacro-declaration): Remove. + (byte-compile-file-form-defmumble): Generalize to defalias. + (byte-compile-output-as-comment): Return byte-positions. + Simplify callers accordingly. + (byte-compile-lambda): Use `assert'. + (byte-compile-defun, byte-compile-defmacro): Remove. + (byte-compile-file-form-defalias): + Use byte-compile-file-form-defmumble. + (byte-compile-defalias-warn): Remove. + 2012-05-29 Stefan Merten * textmodes/rst.el: Silence `checkdoc-ispell' errors where - possible. Fix authors. Improve comments. Improve loading of - `cl'. + possible. Fix authors. Improve comments. Improve loading of `cl'. (rst-mode-abbrev-table): Merge definition. (rst-mode): Make sure `font-lock-defaults' is buffer local. @@ -14,8 +38,8 @@ (icalendar-export-region): Export UID properly. 2012-05-29 Leo - * calendar/icalendar.el (icalendar-import-format): Add - `icalendar-import-format-uid' (Bug#11525). + * calendar/icalendar.el (icalendar-import-format): + Add `icalendar-import-format-uid' (Bug#11525). (icalendar-import-format-uid): New. (icalendar--parse-summary-and-rest, icalendar--format-ical-event): Export UID. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 9dd475f2a51..7cb93890cb5 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -500,7 +500,7 @@ (prin1-to-string form)) nil) - ((memq fn '(defun defmacro function condition-case)) + ((memq fn '(function condition-case)) ;; These forms are compiled as constants or by breaking out ;; all the subexpressions and compiling them separately. form) diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 7de3396f8ed..9b04e9889dd 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -34,33 +34,98 @@ ;; handle declarations in macro definitions and this is the first file ;; loaded by loadup.el that uses declarations in macros. -(defun macro-declaration-function (macro decl) - "Process a declaration found in a macro definition. +(defvar macro-declaration-function #'macro-declaration-function + "Function to process declarations in a macro definition. +The function will be called with two args MACRO and DECL. +MACRO is the name of the macro being defined. +DECL is a list `(declare ...)' containing the declarations. +The value the function returns is not used.") + +(defalias 'macro-declaration-function + #'(lambda (macro decl) + "Process a declaration found in a macro definition. This is set as the value of the variable `macro-declaration-function'. MACRO is the name of the macro being defined. DECL is a list `(declare ...)' containing the declarations. The return value of this function is not used." - ;; We can't use `dolist' or `cadr' yet for bootstrapping reasons. - (let (d) - ;; Ignore the first element of `decl' (it's always `declare'). - (while (setq decl (cdr decl)) - (setq d (car decl)) - (if (and (consp d) - (listp (cdr d)) - (null (cdr (cdr d)))) - (cond ((eq (car d) 'indent) - (put macro 'lisp-indent-function (car (cdr d)))) - ((eq (car d) 'debug) - (put macro 'edebug-form-spec (car (cdr d)))) - ((eq (car d) 'doc-string) - (put macro 'doc-string-elt (car (cdr d)))) - (t - (message "Unknown declaration %s" d))) - (message "Invalid declaration %s" d))))) - - -(setq macro-declaration-function 'macro-declaration-function) - + ;; We can't use `dolist' or `cadr' yet for bootstrapping reasons. + (let (d) + ;; Ignore the first element of `decl' (it's always `declare'). + (while (setq decl (cdr decl)) + (setq d (car decl)) + (if (and (consp d) + (listp (cdr d)) + (null (cdr (cdr d)))) + (cond ((eq (car d) 'indent) + (put macro 'lisp-indent-function (car (cdr d)))) + ((eq (car d) 'debug) + (put macro 'edebug-form-spec (car (cdr d)))) + ((eq (car d) 'doc-string) + (put macro 'doc-string-elt (car (cdr d)))) + (t + (message "Unknown declaration %s" d))) + (message "Invalid declaration %s" d)))))) + +(put 'defmacro 'doc-string-elt 3) +(defalias 'defmacro + (cons + 'macro + #'(lambda (name arglist &optional docstring decl &rest body) + "Define NAME as a macro. +When the macro is called, as in (NAME ARGS...), +the function (lambda ARGLIST BODY...) is applied to +the list ARGS... as it appears in the expression, +and the result should be a form to be evaluated instead of the original. + +DECL is a declaration, optional, which can specify how to indent +calls to this macro, how Edebug should handle it, and which argument +should be treated as documentation. It looks like this: + (declare SPECS...) +The elements can look like this: + (indent INDENT) + Set NAME's `lisp-indent-function' property to INDENT. + + (debug DEBUG) + Set NAME's `edebug-form-spec' property to DEBUG. (This is + equivalent to writing a `def-edebug-spec' for the macro.) + + (doc-string ELT) + Set NAME's `doc-string-elt' property to ELT." + (if (stringp docstring) nil + (if decl (setq body (cons decl body))) + (setq decl docstring) + (setq docstring nil)) + (if (or (null decl) (eq 'declare (car-safe decl))) nil + (setq body (cons decl body)) + (setq decl nil)) + (if (null body) (setq body '(nil))) + (if docstring (setq body (cons docstring body))) + ;; Can't use backquote because it's not defined yet! + (let* ((fun (list 'function (cons 'lambda (cons arglist body)))) + (def (list 'defalias + (list 'quote name) + (list 'cons ''macro fun)))) + (if decl + (list 'progn + (list 'funcall 'macro-declaration-function + (list 'quote name) + (list 'quote decl)) + def) + def))))) + +;; Now that we defined defmacro we can use it! +(defmacro defun (name arglist &optional docstring &rest body) + "Define NAME as a function. +The definition is (lambda ARGLIST [DOCSTRING] BODY...). +See also the function `interactive'." + (declare (doc-string 3)) + (if docstring (setq body (cons docstring body)) + (if (null body) (setq body '(nil)))) + (list 'defalias + (list 'quote name) + (list 'function + (cons 'lambda + (cons arglist body))))) ;; Redefined in byte-optimize.el. ;; This is not documented--it's not clear that we should promote it. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 2518d8359c3..ce4d5d64ae2 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1169,12 +1169,14 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (t fn))))))) (defun byte-compile-arglist-signature (arglist) - (if (integerp arglist) - ;; New style byte-code arglist. - (cons (logand arglist 127) ;Mandatory. - (if (zerop (logand arglist 128)) ;No &rest. - (lsh arglist -8))) ;Nonrest. - ;; Old style byte-code, or interpreted function. + (cond + ;; New style byte-code arglist. + ((integerp arglist) + (cons (logand arglist 127) ;Mandatory. + (if (zerop (logand arglist 128)) ;No &rest. + (lsh arglist -8)))) ;Nonrest. + ;; Old style byte-code, or interpreted function. + ((listp arglist) (let ((args 0) opts restp) @@ -1190,7 +1192,9 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (setq opts (1+ opts)) (setq args (1+ args))))) (setq arglist (cdr arglist))) - (cons args (if restp nil (if opts (+ args opts) args)))))) + (cons args (if restp nil (if opts (+ args opts) args))))) + ;; Unknown arglist. + (t '(0)))) (defun byte-compile-arglist-signatures-congruent-p (old new) @@ -1250,8 +1254,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." ;; and/or remember its arity if it's unknown. (or (and (or def (fboundp (car form))) ; might be a subr or autoload. (not (memq (car form) byte-compile-noruntime-functions))) - (eq (car form) byte-compile-current-form) ; ## this doesn't work - ; with recursion. + (eq (car form) byte-compile-current-form) ; ## This doesn't work + ; with recursion. ;; It's a currently-undefined function. ;; Remember number of args in call. (let ((cons (assq (car form) byte-compile-unresolved-functions)) @@ -1316,9 +1320,8 @@ extra args." ;; Warn if the function or macro is being redefined with a different ;; number of arguments. -(defun byte-compile-arglist-warn (form macrop) - (let* ((name (nth 1 form)) - (old (byte-compile-fdefinition name macrop)) +(defun byte-compile-arglist-warn (name arglist macrop) + (let* ((old (byte-compile-fdefinition name macrop)) (initial (and macrop (cdr (assq name byte-compile-initial-macro-environment))))) @@ -1337,12 +1340,12 @@ extra args." (`(closure ,_ ,args . ,_) args) ((pred byte-code-function-p) (aref old 0)) (t '(&rest def))))) - (sig2 (byte-compile-arglist-signature (nth 2 form)))) + (sig2 (byte-compile-arglist-signature arglist))) (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2) (byte-compile-set-symbol-position name) (byte-compile-warn "%s %s used to take %s %s, now takes %s" - (if (eq (car form) 'defun) "function" "macro") + (if macrop "macro" "function") name (byte-compile-arglist-signature-string sig1) (if (equal sig1 '(1 . 1)) "argument" "arguments") @@ -1356,7 +1359,7 @@ extra args." 'byte-compile-inline-expand)) (byte-compile-warn "defsubst `%s' was used before it was defined" name)) - (setq sig (byte-compile-arglist-signature (nth 2 form)) + (setq sig (byte-compile-arglist-signature arglist) nums (sort (copy-sequence (cdr calls)) (function <)) min (car nums) max (car (nreverse nums))) @@ -2021,31 +2024,30 @@ Call from the source buffer." ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n")))) (defun byte-compile-output-file-form (form) - ;; writes the given form to the output buffer, being careful of docstrings + ;; Write the given form to the output buffer, being careful of docstrings ;; in defun, defmacro, defvar, defvaralias, defconst, autoload and ;; custom-declare-variable because make-docfile is so amazingly stupid. ;; defalias calls are output directly by byte-compile-file-form-defmumble; ;; it does not pay to first build the defalias in defmumble and then parse ;; it here. - (if (and (memq (car-safe form) '(defun defmacro defvar defvaralias defconst - autoload custom-declare-variable)) - (stringp (nth 3 form))) - (byte-compile-output-docform nil nil '("\n(" 3 ")") form nil - (memq (car form) - '(defvaralias autoload - custom-declare-variable))) - (let ((print-escape-newlines t) - (print-length nil) - (print-level nil) - (print-quoted t) - (print-gensym t) - (print-circle ; handle circular data structures - (not byte-compile-disable-print-circle))) + (let ((print-escape-newlines t) + (print-length nil) + (print-level nil) + (print-quoted t) + (print-gensym t) + (print-circle ; Handle circular data structures. + (not byte-compile-disable-print-circle))) + (if (and (memq (car-safe form) '(defun defmacro defvar defvaralias defconst + autoload custom-declare-variable)) + (stringp (nth 3 form))) + (byte-compile-output-docform nil nil '("\n(" 3 ")") form nil + (memq (car form) + '(defvaralias autoload + custom-declare-variable))) (princ "\n" byte-compile--outbuffer) (prin1 form byte-compile--outbuffer) nil))) -(defvar print-gensym-alist) ;Used before print-circle existed. (defvar byte-compile--for-effect) (defun byte-compile-output-docform (preface name info form specindex quoted) @@ -2075,7 +2077,6 @@ list that represents a doc string reference. (setq position (byte-compile-output-as-comment (nth (nth 1 info) form) nil)) - (setq position (- (position-bytes position) (point-min) -1)) ;; If the doc string starts with * (a user variable), ;; negate POSITION. (if (and (stringp (nth (nth 1 info) form)) @@ -2088,17 +2089,7 @@ list that represents a doc string reference. (insert preface) (prin1 name byte-compile--outbuffer))) (insert (car info)) - (let ((print-escape-newlines t) - (print-quoted t) - ;; For compatibility with code before print-circle, - ;; use a cons cell to say that we want - ;; print-gensym-alist not to be cleared - ;; between calls to print functions. - (print-gensym '(t)) - (print-circle ; handle circular data structures - (not byte-compile-disable-print-circle)) - print-gensym-alist ; was used before print-circle existed. - (print-continuous-numbering t) + (let ((print-continuous-numbering t) print-number-table (index 0)) (prin1 (car form) byte-compile--outbuffer) @@ -2121,8 +2112,6 @@ list that represents a doc string reference. (byte-compile-output-as-comment (cons (car form) (nth 1 form)) t))) - (setq position (- (position-bytes position) - (point-min) -1)) (princ (format "(#$ . %d) nil" position) byte-compile--outbuffer) (setq form (cdr form)) @@ -2317,143 +2306,132 @@ list that represents a doc string reference. (nth 1 (nth 1 form)) (byte-compile-keep-pending form))) -(put 'defun 'byte-hunk-handler 'byte-compile-file-form-defun) -(defun byte-compile-file-form-defun (form) - (byte-compile-file-form-defmumble form nil)) - -(put 'defmacro 'byte-hunk-handler 'byte-compile-file-form-defmacro) -(defun byte-compile-file-form-defmacro (form) - (byte-compile-file-form-defmumble form t)) - -(defun byte-compile-defmacro-declaration (form) - "Generate code for declarations in macro definitions. -Remove declarations from the body of the macro definition -by side-effects." - (let ((tail (nthcdr 2 form)) - (res '())) - (when (stringp (car (cdr tail))) - (setq tail (cdr tail))) - (while (and (consp (car (cdr tail))) - (eq (car (car (cdr tail))) 'declare)) - (let ((declaration (car (cdr tail)))) - (setcdr tail (cdr (cdr tail))) - (push `(if macro-declaration-function - (funcall macro-declaration-function - ',(car (cdr form)) ',declaration)) - res))) - res)) - -(defun byte-compile-file-form-defmumble (form macrop) - (let* ((name (car (cdr form))) - (this-kind (if macrop 'byte-compile-macro-environment - 'byte-compile-function-environment)) - (that-kind (if macrop 'byte-compile-function-environment - 'byte-compile-macro-environment)) - (this-one (assq name (symbol-value this-kind))) - (that-one (assq name (symbol-value that-kind))) - (byte-compile-free-references nil) - (byte-compile-free-assignments nil)) +(defun byte-compile-file-form-defmumble (name macro arglist body rest) + "Process a `defalias' for NAME. +If MACRO is non-nil, the definition is known to be a macro. +ARGLIST is the list of arguments, if it was recognized or t otherwise. +BODY of the definition, or t if not recognized. +Return non-nil if everything went as planned, or nil to imply that it decided +not to take responsibility for the actual compilation of the code." + (let* ((this-kind (if macro 'byte-compile-macro-environment + 'byte-compile-function-environment)) + (that-kind (if macro 'byte-compile-function-environment + 'byte-compile-macro-environment)) + (this-one (assq name (symbol-value this-kind))) + (that-one (assq name (symbol-value that-kind))) + (byte-compile-current-form name)) ; For warnings. + (byte-compile-set-symbol-position name) ;; When a function or macro is defined, add it to the call tree so that ;; we can tell when functions are not used. (if byte-compile-generate-call-tree - (or (assq name byte-compile-call-tree) - (setq byte-compile-call-tree - (cons (list name nil nil) byte-compile-call-tree)))) + (or (assq name byte-compile-call-tree) + (setq byte-compile-call-tree + (cons (list name nil nil) byte-compile-call-tree)))) - (setq byte-compile-current-form name) ; for warnings (if (byte-compile-warning-enabled-p 'redefine) - (byte-compile-arglist-warn form macrop)) + (byte-compile-arglist-warn name arglist macro)) + (if byte-compile-verbose - (message "Compiling %s... (%s)" - (or byte-compile-current-file "") (nth 1 form))) - (cond (that-one - (if (and (byte-compile-warning-enabled-p 'redefine) - ;; don't warn when compiling the stubs in byte-run... - (not (assq (nth 1 form) - byte-compile-initial-macro-environment))) - (byte-compile-warn + (message "Compiling %s... (%s)" + (or byte-compile-current-file "") name)) + (cond ((not (or macro (listp body))) + ;; We do not know positively if the definition is a macro + ;; or a function, so we shouldn't emit warnings. + ;; This also silences "multiple definition" warnings for defmethods. + nil) + (that-one + (if (and (byte-compile-warning-enabled-p 'redefine) + ;; Don't warn when compiling the stubs in byte-run... + (not (assq name byte-compile-initial-macro-environment))) + (byte-compile-warn "`%s' defined multiple times, as both function and macro" - (nth 1 form))) - (setcdr that-one nil)) - (this-one - (when (and (byte-compile-warning-enabled-p 'redefine) - ;; hack: don't warn when compiling the magic internal + name)) + (setcdr that-one nil)) + (this-one + (when (and (byte-compile-warning-enabled-p 'redefine) + ;; Hack: Don't warn when compiling the magic internal ;; byte-compiler macros in byte-run.el... - (not (assq (nth 1 form) - byte-compile-initial-macro-environment))) - (byte-compile-warn "%s `%s' defined multiple times in this file" - (if macrop "macro" "function") - (nth 1 form)))) - ((and (fboundp name) - (eq (car-safe (symbol-function name)) - (if macrop 'lambda 'macro))) - (when (byte-compile-warning-enabled-p 'redefine) - (byte-compile-warn "%s `%s' being redefined as a %s" - (if macrop "function" "macro") - (nth 1 form) - (if macrop "macro" "function"))) - ;; shadow existing definition - (set this-kind - (cons (cons name nil) - (symbol-value this-kind)))) - ) - (let ((body (nthcdr 3 form))) - (when (and (stringp (car body)) - (symbolp (car-safe (cdr-safe body))) - (car-safe (cdr-safe body)) - (stringp (car-safe (cdr-safe (cdr-safe body))))) - (byte-compile-set-symbol-position (nth 1 form)) - (byte-compile-warn "probable `\"' without `\\' in doc string of %s" - (nth 1 form)))) - - ;; Generate code for declarations in macro definitions. - ;; Remove declarations from the body of the macro definition. - (when macrop - (dolist (decl (byte-compile-defmacro-declaration form)) - (prin1 decl byte-compile--outbuffer))) - - (let* ((code (byte-compile-lambda (nthcdr 2 form) t))) - (if this-one - ;; A definition in b-c-initial-m-e should always take precedence - ;; during compilation, so don't let it be redefined. (Bug#8647) - (or (and macrop - (assq name byte-compile-initial-macro-environment)) - (setcdr this-one code)) - (set this-kind - (cons (cons name code) - (symbol-value this-kind)))) - (byte-compile-flush-pending) - (if (not (stringp (nth 3 form))) - ;; No doc string. Provide -1 as the "doc string index" - ;; so that no element will be treated as a doc string. - (byte-compile-output-docform - "\n(defalias '" - name - (if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]")) - (append code nil) ; Turn byte-code-function-p into list. - (and (atom code) byte-compile-dynamic - 1) - nil) - ;; Output the form by hand, that's much simpler than having - ;; b-c-output-file-form analyze the defalias. - (byte-compile-output-docform - "\n(defalias '" - name - (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]")) - (append code nil) ; Turn byte-code-function-p into list. - (and (atom code) byte-compile-dynamic - 1) - nil)) - (princ ")" byte-compile--outbuffer) - nil))) + (not (assq name byte-compile-initial-macro-environment))) + (byte-compile-warn "%s `%s' defined multiple times in this file" + (if macro "macro" "function") + name))) + ((and (fboundp name) + (eq (car-safe (symbol-function name)) + (if macro 'lambda 'macro))) + (when (byte-compile-warning-enabled-p 'redefine) + (byte-compile-warn "%s `%s' being redefined as a %s" + (if macro "function" "macro") + name + (if macro "macro" "function"))) + ;; Shadow existing definition. + (set this-kind + (cons (cons name nil) + (symbol-value this-kind)))) + ) + + (when (and (listp body) + (stringp (car body)) + (symbolp (car-safe (cdr-safe body))) + (car-safe (cdr-safe body)) + (stringp (car-safe (cdr-safe (cdr-safe body))))) + ;; FIXME: We've done that already just above, so this looks wrong! + ;;(byte-compile-set-symbol-position name) + (byte-compile-warn "probable `\"' without `\\' in doc string of %s" + name)) + + (if (not (listp body)) + ;; The precise definition requires evaluation to find out, so it + ;; will only be known at runtime. + ;; For a macro, that means we can't use that macro in the same file. + (progn + (unless macro + (push (cons name (if (listp arglist) `(declared ,arglist) t)) + byte-compile-function-environment)) + ;; Tell the caller that we didn't compile it yet. + nil) + + (let* ((code (byte-compile-lambda (cons arglist body) t))) + (if this-one + ;; A definition in b-c-initial-m-e should always take precedence + ;; during compilation, so don't let it be redefined. (Bug#8647) + (or (and macro + (assq name byte-compile-initial-macro-environment)) + (setcdr this-one code)) + (set this-kind + (cons (cons name code) + (symbol-value this-kind)))) + + (if rest + ;; There are additional args to `defalias' (like maybe a docstring) + ;; that the code below can't handle: punt! + nil + ;; Otherwise, we have a bona-fide defun/defmacro definition, and use + ;; special code to allow dynamic docstrings and byte-code. + (byte-compile-flush-pending) + (let ((index + ;; If there's no doc string, provide -1 as the "doc string + ;; index" so that no element will be treated as a doc string. + (if (not (stringp (car body))) -1 4))) + ;; Output the form by hand, that's much simpler than having + ;; b-c-output-file-form analyze the defalias. + (byte-compile-output-docform + "\n(defalias '" + name + (if macro `(" '(macro . #[" ,index "])") `(" #[" ,index "]")) + (append code nil) ; Turn byte-code-function-p into list. + (and (atom code) byte-compile-dynamic + 1) + nil)) + (princ ")" byte-compile--outbuffer) + t))))) -;; Print Lisp object EXP in the output file, inside a comment, -;; and return the file position it will have. -;; If QUOTED is non-nil, print with quoting; otherwise, print without quoting. (defun byte-compile-output-as-comment (exp quoted) - (let ((position (point))) - (with-current-buffer byte-compile--outbuffer + "Print Lisp object EXP in the output file, inside a comment, +and return the file (byte) position it will have. +If QUOTED is non-nil, print with quoting; otherwise, print without quoting." + (with-current-buffer byte-compile--outbuffer + (let ((position (point))) ;; Insert EXP, and make it a comment with #@LENGTH. (insert " ") @@ -2478,13 +2456,12 @@ by side-effects." (position-bytes position)))) ;; Save the file position of the object. - ;; Note we should add 1 to skip the space - ;; that we inserted before the actual doc string, - ;; and subtract 1 to convert from an 1-origin Emacs position - ;; to a file position; they cancel. - (setq position (point)) - (goto-char (point-max))) - position)) + ;; Note we add 1 to skip the space that we inserted before the actual doc + ;; string, and subtract point-min to convert from an 1-origin Emacs + ;; position to a file position. + (prog1 + (- (position-bytes (point)) (point-min) -1) + (goto-char (point-max)))))) @@ -2581,14 +2558,15 @@ If FORM is a lambda or a macro, byte-compile it as a function." (lsh nonrest 8) (lsh rest 7))))) -;; Byte-compile a lambda-expression and return a valid function. -;; The value is usually a compiled function but may be the original -;; lambda-expression. -;; When ADD-LAMBDA is non-nil, the symbol `lambda' is added as head -;; of the list FUN and `byte-compile-set-symbol-position' is not called. -;; Use this feature to avoid calling `byte-compile-set-symbol-position' -;; for symbols generated by the byte compiler itself. + (defun byte-compile-lambda (fun &optional add-lambda reserved-csts) + "Byte-compile a lambda-expression and return a valid function. +The value is usually a compiled function but may be the original +lambda-expression. +When ADD-LAMBDA is non-nil, the symbol `lambda' is added as head +of the list FUN and `byte-compile-set-symbol-position' is not called. +Use this feature to avoid calling `byte-compile-set-symbol-position' +for symbols generated by the byte compiler itself." (if add-lambda (setq fun (cons 'lambda fun)) (unless (eq 'lambda (car-safe fun)) @@ -2649,24 +2627,23 @@ If FORM is a lambda or a macro, byte-compile it as a function." (byte-compile-make-lambda-lexenv fun)) reserved-csts))) ;; Build the actual byte-coded function. - (if (eq 'byte-code (car-safe compiled)) - (apply 'make-byte-code - (if lexical-binding - (byte-compile-make-args-desc arglist) - arglist) - (append - ;; byte-string, constants-vector, stack depth - (cdr compiled) - ;; optionally, the doc string. - (cond (lexical-binding - (require 'help-fns) - (list (help-add-fundoc-usage doc arglist))) - ((or doc int) - (list doc))) - ;; optionally, the interactive spec. - (if int - (list (nth 1 int))))) - (error "byte-compile-top-level did not return byte-code"))))) + (assert (eq 'byte-code (car-safe compiled))) + (apply #'make-byte-code + (if lexical-binding + (byte-compile-make-args-desc arglist) + arglist) + (append + ;; byte-string, constants-vector, stack depth + (cdr compiled) + ;; optionally, the doc string. + (cond (lexical-binding + (require 'help-fns) + (list (help-add-fundoc-usage doc arglist))) + ((or doc int) + (list doc))) + ;; optionally, the interactive spec. + (if int + (list (nth 1 int)))))))) (defvar byte-compile-reserved-constants 0) @@ -3066,9 +3043,9 @@ That command is designed for interactive use only" fn)) (byte-compile-check-variable var 'assign) (let ((lex-binding (assq var byte-compile--lexical-environment))) (if lex-binding - ;; VAR is lexically bound + ;; VAR is lexically bound. (byte-compile-stack-set (cdr lex-binding)) - ;; VAR is dynamically bound + ;; VAR is dynamically bound. (unless (or (not (byte-compile-warning-enabled-p 'free-vars)) (boundp var) (memq var byte-compile-bound-variables) @@ -3353,6 +3330,7 @@ discarding." (body (nthcdr 3 form)) (fun (byte-compile-lambda `(lambda ,vars . ,body) nil (length env)))) + (assert (> (length env) 0)) ;Otherwise, we don't need a closure. (assert (byte-code-function-p fun)) (byte-compile-form `(make-byte-code ',(aref fun 0) ',(aref fun 1) @@ -4074,36 +4052,11 @@ binding slots have been popped." ;;; top-level forms elsewhere -(byte-defop-compiler-1 defun) -(byte-defop-compiler-1 defmacro) (byte-defop-compiler-1 defvar) (byte-defop-compiler-1 defconst byte-compile-defvar) (byte-defop-compiler-1 autoload) (byte-defop-compiler-1 lambda byte-compile-lambda-form) -(defun byte-compile-defun (form) - ;; This is not used for file-level defuns with doc strings. - (if (symbolp (car form)) - (byte-compile-set-symbol-position (car form)) - (byte-compile-set-symbol-position 'defun) - (error "defun name must be a symbol, not %s" (car form))) - (byte-compile-push-constant 'defalias) - (byte-compile-push-constant (nth 1 form)) - (byte-compile-push-constant (byte-compile-lambda (cdr (cdr form)) t)) - (byte-compile-out 'byte-call 2)) - -(defun byte-compile-defmacro (form) - ;; This is not used for file-level defmacros with doc strings. - (byte-compile-body-do-effect - (let ((decls (byte-compile-defmacro-declaration form)) - (code (byte-compile-lambda (cdr (cdr form)) t))) - `((defalias ',(nth 1 form) - ,(if (eq (car-safe code) 'make-byte-code) - `(cons 'macro ,code) - `'(macro . ,(eval code)))) - ,@decls - ',(nth 1 form))))) - ;; If foo.el declares `toto' as obsolete, it is likely that foo.el will ;; actually use `toto' in order for this obsolete variable to still work ;; correctly, so paradoxically, while byte-compiling foo.el, the presence @@ -4179,38 +4132,53 @@ binding slots have been popped." (put 'defalias 'byte-hunk-handler 'byte-compile-file-form-defalias) ;; Used for eieio--defalias as well. (defun byte-compile-file-form-defalias (form) - (if (and (consp (cdr form)) (consp (nth 1 form)) - (eq (car (nth 1 form)) 'quote) - (consp (cdr (nth 1 form))) - (symbolp (nth 1 (nth 1 form)))) - (let ((constant - (and (consp (nthcdr 2 form)) - (consp (nth 2 form)) - (eq (car (nth 2 form)) 'quote) - (consp (cdr (nth 2 form))) - (symbolp (nth 1 (nth 2 form)))))) - (byte-compile-defalias-warn (nth 1 (nth 1 form))) - (push (cons (nth 1 (nth 1 form)) - (if constant (nth 1 (nth 2 form)) t)) - byte-compile-function-environment))) - ;; We used to just do: (byte-compile-normal-call form) - ;; But it turns out that this fails to optimize the code. - ;; So instead we now do the same as what other byte-hunk-handlers do, - ;; which is to call back byte-compile-file-form and then return nil. - ;; Except that we can't just call byte-compile-file-form since it would - ;; call us right back. - (byte-compile-keep-pending form) - ;; Return nil so the form is not output twice. - nil) - -;; Turn off warnings about prior calls to the function being defalias'd. -;; This could be smarter and compare those calls with -;; the function it is being aliased to. -(defun byte-compile-defalias-warn (new) - (let ((calls (assq new byte-compile-unresolved-functions))) - (if calls - (setq byte-compile-unresolved-functions - (delq calls byte-compile-unresolved-functions))))) + ;; For the compilation itself, we could largely get rid of this hunk-handler, + ;; if it weren't for the fact that we need to figure out when a defalias + ;; defines a macro, so as to add it to byte-compile-macro-environment. + ;; + ;; FIXME: we also use this hunk-handler to implement the function's dynamic + ;; docstring feature. We could actually implement it more elegantly in + ;; byte-compile-lambda so it applies to all lambdas, but the problem is that + ;; the resulting .elc format will not be recognized by make-docfile, so + ;; either we stop using DOC for the docstrings of preloaded elc files (at the + ;; cost of around 24KB on 32bit hosts, double on 64bit hosts) or we need to + ;; build DOC in a more clever way (e.g. handle anonymous elements). + (let ((byte-compile-free-references nil) + (byte-compile-free-assignments nil)) + (pcase form + ;; Decompose `form' into: + ;; - `name' is the name of the defined function. + ;; - `arg' is the expression to which it is defined. + ;; - `rest' is the rest of the arguments. + (`(,_ ',name ,arg . ,rest) + (pcase-let* + ;; `macro' is non-nil if it defines a macro. + ;; `fun' is the function part of `arg' (defaults to `arg'). + (((or (and (or `(cons 'macro ,fun) `'(macro . ,fun)) (let macro t)) + (and (let fun arg) (let macro nil))) + arg) + ;; `lam' is the lambda expression in `fun' (or nil if not + ;; recognized). + ((or `(,(or `quote `function) ,lam) (let lam nil)) + fun) + ;; `arglist' is the list of arguments (or t if not recognized). + ;; `body' is the body of `lam' (or t if not recognized). + ((or `(lambda ,arglist . ,body) + ;; `(closure ,_ ,arglist . ,body) + (and `(internal-make-closure ,arglist . ,_) (let body t)) + (and (let arglist t) (let body t))) + lam)) + (unless (byte-compile-file-form-defmumble + name macro arglist body rest) + (byte-compile-keep-pending form)))) + + ;; We used to just do: (byte-compile-normal-call form) + ;; But it turns out that this fails to optimize the code. + ;; So instead we now do the same as what other byte-hunk-handlers do, + ;; which is to call back byte-compile-file-form and then return nil. + ;; Except that we can't just call byte-compile-file-form since it would + ;; call us right back. + (t (byte-compile-keep-pending form))))) (byte-defop-compiler-1 with-no-warnings byte-compile-no-warnings) (defun byte-compile-no-warnings (form) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 3ce0eadab55..f43dd9e7ee4 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -73,8 +73,6 @@ ;; since afterwards they can because obnoxious (warnings about an "unused ;; variable" should not be emitted when the variable use has simply been ;; optimized away). -;; - turn defun and defmacro into macros (and remove special handling of -;; `declare' afterwards). ;; - let macros specify that some let-bindings come from the same source, ;; so the unused warning takes all uses into account. ;; - let interactive specs return a function to build the args (to stash into @@ -410,20 +408,6 @@ places where they originally did not directly appear." . ,(mapcar (lambda (form) (cconv-convert form env extend)) forms))) - ;defun, defmacro - (`(,(and sym (or `defun `defmacro)) - ,func ,args . ,body) - (assert (equal body (caar cconv-freevars-alist))) - (assert (null (cdar cconv-freevars-alist))) - - (let ((new (cconv--convert-function args body env form))) - (pcase new - (`(function (lambda ,newargs . ,new-body)) - (assert (equal args newargs)) - `(,sym ,func ,args . ,new-body)) - (t (byte-compile-report-error - (format "Internal error in cconv of (%s %s ...)" sym func)))))) - ;condition-case (`(condition-case ,var ,protected-form . ,handlers) (let ((newform (cconv--convert-function @@ -618,15 +602,6 @@ and updates the data stored in ENV." (dolist (vardata newvars) (cconv--analyse-use vardata form "variable")))) - ; defun special form - (`(,(or `defun `defmacro) ,func ,vrs . ,body-forms) - (when env - (byte-compile-log-warning - (format "Function %S will ignore its context %S" - func (mapcar #'car env)) - t :warning)) - (cconv--analyse-function vrs body-forms nil form)) - (`(function (lambda ,vrs . ,body-forms)) (cconv--analyse-function vrs body-forms env form)) diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el index 5b82cd477f9..82e958533e8 100644 --- a/lisp/emacs-lisp/elint.el +++ b/lisp/emacs-lisp/elint.el @@ -357,6 +357,8 @@ Returns the forms." (set (make-local-variable 'elint-buffer-env) (elint-init-env elint-buffer-forms)) (if elint-preloaded-env + ;; FIXME: This doesn't do anything! Should we setq the result to + ;; elint-buffer-env? (elint-env-add-env elint-preloaded-env elint-buffer-env)) (set (make-local-variable 'elint-last-env-time) (buffer-modified-tick)) elint-buffer-forms)) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 973d57d4210..2a4cd704a43 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -135,11 +135,9 @@ It has `lisp-mode-abbrev-table' as its parent." ;; This was originally in autoload.el and is still used there. (put 'autoload 'doc-string-elt 3) -(put 'defun 'doc-string-elt 3) (put 'defmethod 'doc-string-elt 3) (put 'defvar 'doc-string-elt 3) (put 'defconst 'doc-string-elt 3) -(put 'defmacro 'doc-string-elt 3) (put 'defalias 'doc-string-elt 3) (put 'defvaralias 'doc-string-elt 3) (put 'define-category 'doc-string-elt 2) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 21c351159c2..ba8f9c4c148 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -65,7 +65,7 @@ result will be eq to LIST). (,unshared nil) (,tail ,shared) ,var ,new-el) - (while ,tail + (while (consp ,tail) (setq ,var (car ,tail) ,new-el (progn ,@body)) (unless (eq ,var ,new-el) @@ -128,20 +128,6 @@ Assumes the caller has bound `macroexpand-all-environment'." (cddr form)) (cdr form)) form)) - (`(defmacro ,name . ,args-and-body) - (push (cons name (cons 'lambda args-and-body)) - macroexpand-all-environment) - (let ((n 3)) - ;; Don't macroexpand `declare' since it should really be "expanded" - ;; away when `defmacro' is expanded, but currently defmacro is not - ;; itself a macro. So both `defmacro' and `declare' need to be - ;; handled directly in bytecomp.el. - ;; FIXME: Maybe a simpler solution is to (defalias 'declare 'quote). - (while (or (stringp (nth n form)) - (eq (car-safe (nth n form)) 'declare)) - (setq n (1+ n))) - (macroexpand-all-forms form n))) - (`(defun . ,_) (macroexpand-all-forms form 3)) (`(,(or `defvar `defconst) . ,_) (macroexpand-all-forms form 2)) (`(function ,(and f `(lambda . ,_))) (maybe-cons 'function diff --git a/lisp/loadup.el b/lisp/loadup.el index c5180e9ff6c..fae742f6638 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -318,6 +318,21 @@ ;; At this point, we're ready to resume undo recording for scratch. (buffer-enable-undo "*scratch*") +(when (hash-table-p purify-flag) + (let ((strings 0) + (vectors 0) + (conses 0) + (others 0)) + (maphash (lambda (k v) + (cond + ((stringp k) (setq strings (1+ strings))) + ((vectorp k) (setq vectors (1+ vectors))) + ((consp k) (setq conses (1+ conses))) + (t (setq others (1+ others))))) + purify-flag) + (message "Pure-hashed: %d strings, %d vectors, %d conses, %d others" + strings vectors conses others))) + ;; Avoid error if user loads some more libraries now and make sure the ;; hash-consing hash table is GC'd. (setq purify-flag nil) diff --git a/src/ChangeLog b/src/ChangeLog index e39ec206bf8..0c050535d8e 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,13 @@ +2012-05-30 Stefan Monnier + + * eval.c (Fdefun, Fdefmacro, Vmacro_declaration_function): + Move to byte-run.el. + (Fautoload): Do the hash-doc more carefully. + * data.c (Fdefalias): Purify definition, except for keymaps. + (Qdefun): Move from eval.c. + * lisp.h (Qdefun): Remove. + * lread.c (read1): Tiny simplification. + 2012-05-29 Troels Nielsen Do not create empty overlays with the evaporate property (Bug#9642). @@ -11,8 +21,8 @@ * w32term.c (my_bring_window_to_top): New function. (x_raise_frame): Use handle returned by DeferWindowPos, which - could be different from the original one. Call - my_bring_window_to_top instead of my_set_foreground_window. + could be different from the original one. + Call my_bring_window_to_top instead of my_set_foreground_window. (Bug#11513) * w32fns.c (w32_wnd_proc): Accept and process WM_EMACS_BRINGTOTOP @@ -103,12 +113,12 @@ 2012-05-26 Eli Zaretskii Extend mouse support on W32 text-mode console. - * xdisp.c (draw_row_with_mouse_face): Call - tty_draw_row_with_mouse_face for WINDOWSNT as well. + * xdisp.c (draw_row_with_mouse_face): + Call tty_draw_row_with_mouse_face for WINDOWSNT as well. * w32console.c: Include window.h. - (w32con_write_glyphs_with_face, tty_draw_row_with_mouse_face): New - functions. + (w32con_write_glyphs_with_face, tty_draw_row_with_mouse_face): + New functions. (initialize_w32_display): Initialize mouse-highlight data. * w32inevt.c: Include termchar.h and window.h. @@ -646,7 +656,7 @@ (marker_byte_position, Fbuffer_has_markers_at): Use ptrdiff_t, not EMACS_INT, where ptrdiff_t is wide enough. (Fset_marker, set_marker_restricted): Don't assume fixnum fits in int. - * menu.c (ensure_menu_items): Renamed from grow_menu_items. + * menu.c (ensure_menu_items): Rename from grow_menu_items. It now merely ensures that the menu is large enough, without necessarily growing it, as this avoids some integer overflow issues. All callers changed. @@ -1091,8 +1101,8 @@ * xdisp.c (handle_single_display_spec): Return 1 for left-margin and right-margin display specs even if the spec is invalid or we - are on a TTY, and thus unable to display on the fringes. That's - because the text with the property will not be displayed anyway, + are on a TTY, and thus unable to display on the fringes. + That's because the text with the property will not be displayed anyway, so we need to signal to the caller that this is a "replacing" display spec. This fixes display when the spec is invalid or we are on a TTY. diff --git a/src/data.c b/src/data.c index 11660a2483d..defcd06a2ed 100644 --- a/src/data.c +++ b/src/data.c @@ -34,6 +34,7 @@ along with GNU Emacs. If not, see . */ #include "syssignal.h" #include "termhooks.h" /* For FRAME_KBOARD reference in y-or-n-p. */ #include "font.h" +#include "keymap.h" #include /* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*. */ @@ -92,6 +93,7 @@ Lisp_Object Qbuffer; static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; static Lisp_Object Qsubrp, Qmany, Qunevalled; Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; +static Lisp_Object Qdefun; Lisp_Object Qinteractive_form; @@ -130,7 +132,7 @@ args_out_of_range_3 (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3) } -/* Data type predicates */ +/* Data type predicates. */ DEFUN ("eq", Feq, Seq, 2, 2, 0, doc: /* Return t if the two args are the same Lisp object. */) @@ -656,6 +658,10 @@ determined by DEFINITION. */) if (CONSP (XSYMBOL (symbol)->function) && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload)) LOADHIST_ATTACH (Fcons (Qt, symbol)); + if (!NILP (Vpurify_flag) + /* If `definition' is a keymap, immutable (and copying) is wrong. */ + && !KEYMAPP (definition)) + definition = Fpurecopy (definition); definition = Ffset (symbol, definition); LOADHIST_ATTACH (Fcons (Qdefun, symbol)); if (!NILP (docstring)) @@ -3085,6 +3091,8 @@ syms_of_data (void) DEFSYM (Qbool_vector, "bool-vector"); DEFSYM (Qhash_table, "hash-table"); + DEFSYM (Qdefun, "defun"); + DEFSYM (Qfont_spec, "font-spec"); DEFSYM (Qfont_entity, "font-entity"); DEFSYM (Qfont_object, "font-object"); diff --git a/src/eval.c b/src/eval.c index e44b7e32915..1da841a4073 100644 --- a/src/eval.c +++ b/src/eval.c @@ -65,7 +65,7 @@ struct handler *handlerlist; int gcpro_level; #endif -Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun; +Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp; Lisp_Object Qinhibit_quit; Lisp_Object Qand_rest; static Lisp_Object Qand_optional; @@ -593,109 +593,6 @@ interactive_p (int exclude_subrs_p) } -DEFUN ("defun", Fdefun, Sdefun, 2, UNEVALLED, 0, - doc: /* Define NAME as a function. -The definition is (lambda ARGLIST [DOCSTRING] BODY...). -See also the function `interactive'. -usage: (defun NAME ARGLIST [DOCSTRING] BODY...) */) - (Lisp_Object args) -{ - register Lisp_Object fn_name; - register Lisp_Object defn; - - fn_name = Fcar (args); - CHECK_SYMBOL (fn_name); - defn = Fcons (Qlambda, Fcdr (args)); - if (!NILP (Vinternal_interpreter_environment)) /* Mere optimization! */ - defn = Ffunction (Fcons (defn, Qnil)); - if (!NILP (Vpurify_flag)) - defn = Fpurecopy (defn); - if (CONSP (XSYMBOL (fn_name)->function) - && EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload)) - LOADHIST_ATTACH (Fcons (Qt, fn_name)); - Ffset (fn_name, defn); - LOADHIST_ATTACH (Fcons (Qdefun, fn_name)); - return fn_name; -} - -DEFUN ("defmacro", Fdefmacro, Sdefmacro, 2, UNEVALLED, 0, - doc: /* Define NAME as a macro. -The actual definition looks like - (macro lambda ARGLIST [DOCSTRING] [DECL] BODY...). -When the macro is called, as in (NAME ARGS...), -the function (lambda ARGLIST BODY...) is applied to -the list ARGS... as it appears in the expression, -and the result should be a form to be evaluated instead of the original. - -DECL is a declaration, optional, which can specify how to indent -calls to this macro, how Edebug should handle it, and which argument -should be treated as documentation. It looks like this: - (declare SPECS...) -The elements can look like this: - (indent INDENT) - Set NAME's `lisp-indent-function' property to INDENT. - - (debug DEBUG) - Set NAME's `edebug-form-spec' property to DEBUG. (This is - equivalent to writing a `def-edebug-spec' for the macro.) - - (doc-string ELT) - Set NAME's `doc-string-elt' property to ELT. - -usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */) - (Lisp_Object args) -{ - register Lisp_Object fn_name; - register Lisp_Object defn; - Lisp_Object lambda_list, doc, tail; - - fn_name = Fcar (args); - CHECK_SYMBOL (fn_name); - lambda_list = Fcar (Fcdr (args)); - tail = Fcdr (Fcdr (args)); - - doc = Qnil; - if (STRINGP (Fcar (tail))) - { - doc = XCAR (tail); - tail = XCDR (tail); - } - - if (CONSP (Fcar (tail)) - && EQ (Fcar (Fcar (tail)), Qdeclare)) - { - if (!NILP (Vmacro_declaration_function)) - { - struct gcpro gcpro1; - GCPRO1 (args); - call2 (Vmacro_declaration_function, fn_name, Fcar (tail)); - UNGCPRO; - } - - tail = Fcdr (tail); - } - - if (NILP (doc)) - tail = Fcons (lambda_list, tail); - else - tail = Fcons (lambda_list, Fcons (doc, tail)); - - defn = Fcons (Qlambda, tail); - if (!NILP (Vinternal_interpreter_environment)) /* Mere optimization! */ - defn = Ffunction (Fcons (defn, Qnil)); - defn = Fcons (Qmacro, defn); - - if (!NILP (Vpurify_flag)) - defn = Fpurecopy (defn); - if (CONSP (XSYMBOL (fn_name)->function) - && EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload)) - LOADHIST_ATTACH (Fcons (Qt, fn_name)); - Ffset (fn_name, defn); - LOADHIST_ATTACH (Fcons (Qdefun, fn_name)); - return fn_name; -} - - DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0, doc: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE. Aliased variables always have the same value; setting one sets the other. @@ -2014,12 +1911,11 @@ this does nothing and returns nil. */) /* Only add entries after dumping, because the ones before are not useful and else we get loads of them from the loaddefs.el. */ LOADHIST_ATTACH (Fcons (Qautoload, function)); - else - /* We don't want the docstring in purespace (instead, - Snarf-documentation should (hopefully) overwrite it). - We used to use 0 here, but that leads to accidental sharing in - purecopy's hash-consing, so we use a (hopefully) unique integer - instead. */ + else if (EQ (docstring, make_number (0))) + /* `read1' in lread.c has found the docstring starting with "\ + and assumed the docstring will be provided by Snarf-documentation, so it + passed us 0 instead. But that leads to accidental sharing in purecopy's + hash-consing, so we use a (hopefully) unique integer instead. */ docstring = make_number (XUNTAG (function, Lisp_Symbol)); return Ffset (function, Fpurecopy (list5 (Qautoload, file, docstring, @@ -3576,7 +3472,6 @@ before making `inhibit-quit' nil. */); DEFSYM (Qinteractive, "interactive"); DEFSYM (Qcommandp, "commandp"); - DEFSYM (Qdefun, "defun"); DEFSYM (Qand_rest, "&rest"); DEFSYM (Qand_optional, "&optional"); DEFSYM (Qclosure, "closure"); @@ -3638,23 +3533,16 @@ Note that `debug-on-error', `debug-on-quit' and friends still determine whether to handle the particular condition. */); Vdebug_on_signal = Qnil; - DEFVAR_LISP ("macro-declaration-function", Vmacro_declaration_function, - doc: /* Function to process declarations in a macro definition. -The function will be called with two args MACRO and DECL. -MACRO is the name of the macro being defined. -DECL is a list `(declare ...)' containing the declarations. -The value the function returns is not used. */); - Vmacro_declaration_function = Qnil; - /* When lexical binding is being used, - vinternal_interpreter_environment is non-nil, and contains an alist + Vinternal_interpreter_environment is non-nil, and contains an alist of lexically-bound variable, or (t), indicating an empty environment. The lisp name of this variable would be `internal-interpreter-environment' if it weren't hidden. Every element of this list can be either a cons (VAR . VAL) specifying a lexical binding, or a single symbol VAR indicating that this variable should use dynamic scoping. */ - DEFSYM (Qinternal_interpreter_environment, "internal-interpreter-environment"); + DEFSYM (Qinternal_interpreter_environment, + "internal-interpreter-environment"); DEFVAR_LISP ("internal-interpreter-environment", Vinternal_interpreter_environment, doc: /* If non-nil, the current lexical environment of the lisp interpreter. @@ -3685,8 +3573,6 @@ alist of active lexical bindings. */); defsubr (&Ssetq); defsubr (&Squote); defsubr (&Sfunction); - defsubr (&Sdefun); - defsubr (&Sdefmacro); defsubr (&Sdefvar); defsubr (&Sdefvaralias); defsubr (&Sdefconst); diff --git a/src/lisp.h b/src/lisp.h index 50c21915af1..544277db3b5 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3001,7 +3001,7 @@ extern void init_lread (void); extern void syms_of_lread (void); /* Defined in eval.c. */ -extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qdefun, Qmacro; +extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qmacro; extern Lisp_Object Qinhibit_quit, Qclosure; extern Lisp_Object Qand_rest; extern Lisp_Object Vautoload_queue; diff --git a/src/lread.c b/src/lread.c index 7aba203d685..38b00a66962 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2982,7 +2982,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) /* If purifying, and string starts with \ newline, return zero instead. This is for doc strings - that we are really going to find in etc/DOC.nn.nn */ + that we are really going to find in etc/DOC.nn.nn. */ if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel) return make_number (0); @@ -3095,18 +3095,17 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) nbytes) : nbytes); - if (uninterned_symbol && ! NILP (Vpurify_flag)) - name = make_pure_string (read_buffer, nchars, nbytes, multibyte); - else - name = make_specified_string (read_buffer, nchars, nbytes, multibyte); + name = ((uninterned_symbol && ! NILP (Vpurify_flag) + ? make_pure_string : make_specified_string) + (read_buffer, nchars, nbytes, multibyte)); result = (uninterned_symbol ? Fmake_symbol (name) : Fintern (name, Qnil)); if (EQ (Vread_with_symbol_positions, Qt) || EQ (Vread_with_symbol_positions, readcharfun)) - Vread_symbol_positions_list = - Fcons (Fcons (result, make_number (start_position)), - Vread_symbol_positions_list); + Vread_symbol_positions_list + = Fcons (Fcons (result, make_number (start_position)), + Vread_symbol_positions_list); return result; } } @@ -3520,7 +3519,7 @@ read_list (int flag, register Lisp_Object readcharfun) We don't use Fexpand_file_name because that would make the directory absolute now. */ elt = concat2 (build_string ("../lisp/"), - Ffile_name_nondirectory (elt)); + Ffile_name_nondirectory (elt)); } else if (EQ (elt, Vload_file_name) && ! NILP (elt) -- cgit v1.2.3 From 1ec4b7b25979ff9ea72a3ea35bf35d5882f467f7 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 27 Jun 2012 17:15:13 -0400 Subject: Get rid of all the manual purecopy calls in menu-bar definitions. * lisp/loadup.el (purify-flag): Pre-grow the hash-table to reduce the memory use. * lisp/bindings.el (bindings--define-key): New function. * lisp/vc/vc-hooks.el, lisp/replace.el, lisp/menu-bar.el: * lisp/international/mule-cmds.el, lisp/emacs-lisp/lisp-mode.el: * lisp/buff-menu.el, lisp/bookmark.el: * bindings.el: Use it to purecopy define-key bindings. * src/fns.c (maybe_resize_hash_table): Output message when growing the purify-hashtable. --- lisp/ChangeLog | 7 + lisp/bindings.el | 104 +-- lisp/bookmark.el | 60 +- lisp/buff-menu.el | 120 ++-- lisp/emacs-lisp/lisp-mode.el | 256 +++---- lisp/international/mule-cmds.el | 150 ++-- lisp/loadup.el | 2 +- lisp/menu-bar.el | 1502 +++++++++++++++++++-------------------- lisp/replace.el | 81 ++- lisp/vc/vc-hooks.el | 120 ++-- src/ChangeLog | 7 +- src/data.c | 2 +- src/fns.c | 11 + src/puresize.h | 6 +- 14 files changed, 1232 insertions(+), 1196 deletions(-) (limited to 'lisp/emacs-lisp/lisp-mode.el') diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b08374742c1..1bcd9c7001e 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,12 @@ 2012-06-27 Stefan Monnier + * loadup.el (purify-flag): Pre-grow the hash-table to reduce the + memory use. + * bindings.el (bindings--define-key): New function. + * vc/vc-hooks.el, replace.el, menu-bar.el, international/mule-cmds.el: + * emacs-lisp/lisp-mode.el, buff-menu.el, bookmark.el: + * bindings.el: Use it to purecopy define-key bindings. + * textmodes/rst.el (rst-adornment-faces-alist): Avoid copy-list. * emacs-lisp/cl.el (flet): Mark obsolete. diff --git a/lisp/bindings.el b/lisp/bindings.el index b92d5e9a1ee..109cd8a0d49 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -273,14 +273,34 @@ Normally nil in most modes, since there is no process to display.") (put 'mode-line-process 'risky-local-variable t) (make-variable-buffer-local 'mode-line-process) +(defun bindings--define-key (map key item) + "Make as much as possible of the menus pure." + (declare (indent 2)) + (define-key map key + (cond + ((not (consp item)) item) ;Not sure that could be other than a symbol. + ;; Keymaps can't be made pure otherwise users can't remove/add elements + ;; from/to them any more. + ((keymapp item) item) + ((stringp (car item)) + (if (keymapp (cdr item)) + (cons (purecopy (car item)) (cdr item)) + (purecopy item))) + ((eq 'menu-item (car item)) + (if (keymapp (nth 2 item)) + `(menu-item ,(purecopy (nth 1 item)) ,(nth 2 item) + ,@(purecopy (nthcdr 3 item))) + (purecopy item))) + (t (message "non-menu-item: %S" item) item)))) + (defvar mode-line-mode-menu (make-sparse-keymap "Minor Modes") "\ Menu of mode operations in the mode line.") (defvar mode-line-major-mode-keymap (let ((map (make-sparse-keymap))) - (define-key map [mode-line down-mouse-1] - `(menu-item ,(purecopy "Menu Bar") ignore - :filter (lambda (_) (mouse-menu-major-mode-map)))) + (bindings--define-key map [mode-line down-mouse-1] + `(menu-item "Menu Bar" ignore + :filter ,(lambda (_) (mouse-menu-major-mode-map)))) (define-key map [mode-line mouse-2] 'describe-mode) (define-key map [mode-line down-mouse-3] mode-line-mode-menu) map) "\ @@ -327,13 +347,13 @@ mouse-3: Toggle minor modes" (defvar mode-line-column-line-number-mode-map (let ((map (make-sparse-keymap)) (menu-map (make-sparse-keymap "Toggle Line and Column Number Display"))) - (define-key menu-map [line-number-mode] - `(menu-item ,(purecopy "Display Line Numbers") line-number-mode - :help ,(purecopy "Toggle displaying line numbers in the mode-line") + (bindings--define-key menu-map [line-number-mode] + '(menu-item "Display Line Numbers" line-number-mode + :help "Toggle displaying line numbers in the mode-line" :button (:toggle . line-number-mode))) - (define-key menu-map [column-number-mode] - `(menu-item ,(purecopy "Display Column Numbers") column-number-mode - :help ,(purecopy "Toggle displaying column numbers in the mode-line") + (bindings--define-key menu-map [column-number-mode] + '(menu-item "Display Column Numbers" column-number-mode + :help "Toggle displaying column numbers in the mode-line" :button (:toggle . column-number-mode))) (define-key map [mode-line down-mouse-1] menu-map) map) "\ @@ -491,51 +511,51 @@ Switch to the most recently selected buffer other than the current one." ;; Use mode-line-mode-menu for local minor-modes only. ;; Global ones can go on the menubar (Options --> Show/Hide). -(define-key mode-line-mode-menu [overwrite-mode] - `(menu-item ,(purecopy "Overwrite (Ovwrt)") overwrite-mode - :help ,(purecopy "Overwrite mode: typed characters replace existing text") +(bindings--define-key mode-line-mode-menu [overwrite-mode] + '(menu-item "Overwrite (Ovwrt)" overwrite-mode + :help "Overwrite mode: typed characters replace existing text" :button (:toggle . overwrite-mode))) -(define-key mode-line-mode-menu [outline-minor-mode] - `(menu-item ,(purecopy "Outline (Outl)") outline-minor-mode +(bindings--define-key mode-line-mode-menu [outline-minor-mode] + '(menu-item "Outline (Outl)" outline-minor-mode ;; XXX: This needs a good, brief description. - :help ,(purecopy "") + :help "" :button (:toggle . (bound-and-true-p outline-minor-mode)))) -(define-key mode-line-mode-menu [highlight-changes-mode] - `(menu-item ,(purecopy "Highlight changes (Chg)") highlight-changes-mode - :help ,(purecopy "Show changes in the buffer in a distinctive color") +(bindings--define-key mode-line-mode-menu [highlight-changes-mode] + '(menu-item "Highlight changes (Chg)" highlight-changes-mode + :help "Show changes in the buffer in a distinctive color" :button (:toggle . (bound-and-true-p highlight-changes-mode)))) -(define-key mode-line-mode-menu [hide-ifdef-mode] - `(menu-item ,(purecopy "Hide ifdef (Ifdef)") hide-ifdef-mode - :help ,(purecopy "Show/Hide code within #ifdef constructs") +(bindings--define-key mode-line-mode-menu [hide-ifdef-mode] + '(menu-item "Hide ifdef (Ifdef)" hide-ifdef-mode + :help "Show/Hide code within #ifdef constructs" :button (:toggle . (bound-and-true-p hide-ifdef-mode)))) -(define-key mode-line-mode-menu [glasses-mode] - `(menu-item ,(purecopy "Glasses (o^o)") glasses-mode - :help ,(purecopy "Insert virtual separators to make long identifiers easy to read") +(bindings--define-key mode-line-mode-menu [glasses-mode] + '(menu-item "Glasses (o^o)" glasses-mode + :help "Insert virtual separators to make long identifiers easy to read" :button (:toggle . (bound-and-true-p glasses-mode)))) -(define-key mode-line-mode-menu [font-lock-mode] - `(menu-item ,(purecopy "Font Lock") font-lock-mode - :help ,(purecopy "Syntax coloring") +(bindings--define-key mode-line-mode-menu [font-lock-mode] + '(menu-item "Font Lock" font-lock-mode + :help "Syntax coloring" :button (:toggle . font-lock-mode))) -(define-key mode-line-mode-menu [flyspell-mode] - `(menu-item ,(purecopy "Flyspell (Fly)") flyspell-mode - :help ,(purecopy "Spell checking on the fly") +(bindings--define-key mode-line-mode-menu [flyspell-mode] + '(menu-item "Flyspell (Fly)" flyspell-mode + :help "Spell checking on the fly" :button (:toggle . (bound-and-true-p flyspell-mode)))) -(define-key mode-line-mode-menu [auto-revert-tail-mode] - `(menu-item ,(purecopy "Auto revert tail (Tail)") auto-revert-tail-mode - :help ,(purecopy "Revert the tail of the buffer when buffer grows") +(bindings--define-key mode-line-mode-menu [auto-revert-tail-mode] + '(menu-item "Auto revert tail (Tail)" auto-revert-tail-mode + :help "Revert the tail of the buffer when buffer grows" :enable (buffer-file-name) :button (:toggle . (bound-and-true-p auto-revert-tail-mode)))) -(define-key mode-line-mode-menu [auto-revert-mode] - `(menu-item ,(purecopy "Auto revert (ARev)") auto-revert-mode - :help ,(purecopy "Revert the buffer when the file on disk changes") +(bindings--define-key mode-line-mode-menu [auto-revert-mode] + '(menu-item "Auto revert (ARev)" auto-revert-mode + :help "Revert the buffer when the file on disk changes" :button (:toggle . (bound-and-true-p auto-revert-mode)))) -(define-key mode-line-mode-menu [auto-fill-mode] - `(menu-item ,(purecopy "Auto fill (Fill)") auto-fill-mode - :help ,(purecopy "Automatically insert new lines") +(bindings--define-key mode-line-mode-menu [auto-fill-mode] + '(menu-item "Auto fill (Fill)" auto-fill-mode + :help "Automatically insert new lines" :button (:toggle . auto-fill-function))) -(define-key mode-line-mode-menu [abbrev-mode] - `(menu-item ,(purecopy "Abbrev (Abbrev)") abbrev-mode - :help ,(purecopy "Automatically expand abbreviations") +(bindings--define-key mode-line-mode-menu [abbrev-mode] + '(menu-item "Abbrev (Abbrev)" abbrev-mode + :help "Automatically expand abbreviations" :button (:toggle . abbrev-mode))) (defun mode-line-minor-mode-help (event) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index f7266dc2250..bf2ea9a9517 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -2115,36 +2115,36 @@ strings returned are not." ;;;###autoload (defvar menu-bar-bookmark-map (let ((map (make-sparse-keymap "Bookmark functions"))) - (define-key map [load] - `(menu-item ,(purecopy "Load a Bookmark File...") bookmark-load - :help ,(purecopy "Load bookmarks from a bookmark file)"))) - (define-key map [write] - `(menu-item ,(purecopy "Save Bookmarks As...") bookmark-write - :help ,(purecopy "Write bookmarks to a file (reading the file name with the minibuffer)"))) - (define-key map [save] - `(menu-item ,(purecopy "Save Bookmarks") bookmark-save - :help ,(purecopy "Save currently defined bookmarks"))) - (define-key map [edit] - `(menu-item ,(purecopy "Edit Bookmark List") bookmark-bmenu-list - :help ,(purecopy "Display a list of existing bookmarks"))) - (define-key map [delete] - `(menu-item ,(purecopy "Delete Bookmark...") bookmark-delete - :help ,(purecopy "Delete a bookmark from the bookmark list"))) - (define-key map [rename] - `(menu-item ,(purecopy "Rename Bookmark...") bookmark-rename - :help ,(purecopy "Change the name of a bookmark"))) - (define-key map [locate] - `(menu-item ,(purecopy "Insert Location...") bookmark-locate - :help ,(purecopy "Insert the name of the file associated with a bookmark"))) - (define-key map [insert] - `(menu-item ,(purecopy "Insert Contents...") bookmark-insert - :help ,(purecopy "Insert the text of the file pointed to by a bookmark"))) - (define-key map [set] - `(menu-item ,(purecopy "Set Bookmark...") bookmark-set - :help ,(purecopy "Set a bookmark named inside a file."))) - (define-key map [jump] - `(menu-item ,(purecopy "Jump to Bookmark...") bookmark-jump - :help ,(purecopy "Jump to a bookmark (a point in some file)"))) + (bindings--define-key map [load] + '(menu-item "Load a Bookmark File..." bookmark-load + :help "Load bookmarks from a bookmark file)")) + (bindings--define-key map [write] + '(menu-item "Save Bookmarks As..." bookmark-write + :help "Write bookmarks to a file (reading the file name with the minibuffer)")) + (bindings--define-key map [save] + '(menu-item "Save Bookmarks" bookmark-save + :help "Save currently defined bookmarks")) + (bindings--define-key map [edit] + '(menu-item "Edit Bookmark List" bookmark-bmenu-list + :help "Display a list of existing bookmarks")) + (bindings--define-key map [delete] + '(menu-item "Delete Bookmark..." bookmark-delete + :help "Delete a bookmark from the bookmark list")) + (bindings--define-key map [rename] + '(menu-item "Rename Bookmark..." bookmark-rename + :help "Change the name of a bookmark")) + (bindings--define-key map [locate] + '(menu-item "Insert Location..." bookmark-locate + :help "Insert the name of the file associated with a bookmark")) + (bindings--define-key map [insert] + '(menu-item "Insert Contents..." bookmark-insert + :help "Insert the text of the file pointed to by a bookmark")) + (bindings--define-key map [set] + '(menu-item "Set Bookmark..." bookmark-set + :help "Set a bookmark named inside a file.")) + (bindings--define-key map [jump] + '(menu-item "Jump to Bookmark..." bookmark-jump + :help "Jump to a bookmark (a point in some file)")) map)) ;;;###autoload diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index f501583b9ba..ab1de184ea0 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -134,68 +134,68 @@ commands.") (define-key map [follow-link] 'mouse-face) (define-key map [menu-bar Buffer-menu-mode] (cons (purecopy "Buffer-Menu") menu-map)) - (define-key menu-map [quit] - `(menu-item ,(purecopy "Quit") quit-window - :help ,(purecopy "Remove the buffer menu from the display"))) - (define-key menu-map [rev] - `(menu-item ,(purecopy "Refresh") revert-buffer - :help ,(purecopy "Refresh the *Buffer List* buffer contents"))) - (define-key menu-map [s0] menu-bar-separator) - (define-key menu-map [tf] - `(menu-item ,(purecopy "Show Only File Buffers") Buffer-menu-toggle-files-only + (bindings--define-key menu-map [quit] + '(menu-item "Quit" quit-window + :help "Remove the buffer menu from the display")) + (bindings--define-key menu-map [rev] + '(menu-item "Refresh" revert-buffer + :help "Refresh the *Buffer List* buffer contents")) + (bindings--define-key menu-map [s0] menu-bar-separator) + (bindings--define-key menu-map [tf] + '(menu-item "Show Only File Buffers" Buffer-menu-toggle-files-only :button (:toggle . Buffer-menu-files-only) - :help ,(purecopy "Toggle whether the current buffer-menu displays only file buffers"))) - (define-key menu-map [s1] menu-bar-separator) + :help "Toggle whether the current buffer-menu displays only file buffers")) + (bindings--define-key menu-map [s1] menu-bar-separator) ;; FIXME: The "Select" entries could use better names... - (define-key menu-map [sel] - `(menu-item ,(purecopy "Select Marked") Buffer-menu-select - :help ,(purecopy "Select this line's buffer; also display buffers marked with `>'"))) - (define-key menu-map [bm2] - `(menu-item ,(purecopy "Select Two") Buffer-menu-2-window - :help ,(purecopy "Select this line's buffer, with previous buffer in second window"))) - (define-key menu-map [bm1] - `(menu-item ,(purecopy "Select Current") Buffer-menu-1-window - :help ,(purecopy "Select this line's buffer, alone, in full frame"))) - (define-key menu-map [ow] - `(menu-item ,(purecopy "Select in Other Window") Buffer-menu-other-window - :help ,(purecopy "Select this line's buffer in other window, leaving buffer menu visible"))) - (define-key menu-map [tw] - `(menu-item ,(purecopy "Select in Current Window") Buffer-menu-this-window - :help ,(purecopy "Select this line's buffer in this window"))) - (define-key menu-map [s2] menu-bar-separator) - (define-key menu-map [is] - `(menu-item ,(purecopy "Regexp Isearch Marked Buffers...") Buffer-menu-isearch-buffers-regexp - :help ,(purecopy "Search for a regexp through all marked buffers using Isearch"))) - (define-key menu-map [ir] - `(menu-item ,(purecopy "Isearch Marked Buffers...") Buffer-menu-isearch-buffers - :help ,(purecopy "Search for a string through all marked buffers using Isearch"))) - (define-key menu-map [s3] menu-bar-separator) - (define-key menu-map [by] - `(menu-item ,(purecopy "Bury") Buffer-menu-bury - :help ,(purecopy "Bury the buffer listed on this line"))) - (define-key menu-map [vt] - `(menu-item ,(purecopy "Set Unmodified") Buffer-menu-not-modified - :help ,(purecopy "Mark buffer on this line as unmodified (no changes to save)"))) - (define-key menu-map [ex] - `(menu-item ,(purecopy "Execute") Buffer-menu-execute - :help ,(purecopy "Save and/or delete buffers marked with s or k commands"))) - (define-key menu-map [s4] menu-bar-separator) - (define-key menu-map [delb] - `(menu-item ,(purecopy "Mark for Delete and Move Backwards") Buffer-menu-delete-backwards - :help ,(purecopy "Mark buffer on this line to be deleted by x command and move up one line"))) - (define-key menu-map [del] - `(menu-item ,(purecopy "Mark for Delete") Buffer-menu-delete - :help ,(purecopy "Mark buffer on this line to be deleted by x command"))) - - (define-key menu-map [sv] - `(menu-item ,(purecopy "Mark for Save") Buffer-menu-save - :help ,(purecopy "Mark buffer on this line to be saved by x command"))) - (define-key menu-map [umk] - `(menu-item ,(purecopy "Unmark") Buffer-menu-unmark - :help ,(purecopy "Cancel all requested operations on buffer on this line and move down"))) - (define-key menu-map [mk] - `(menu-item ,(purecopy "Mark") Buffer-menu-mark - :help ,(purecopy "Mark buffer on this line for being displayed by v command"))) + (bindings--define-key menu-map [sel] + '(menu-item "Select Marked" Buffer-menu-select + :help "Select this line's buffer; also display buffers marked with `>'")) + (bindings--define-key menu-map [bm2] + '(menu-item "Select Two" Buffer-menu-2-window + :help "Select this line's buffer, with previous buffer in second window")) + (bindings--define-key menu-map [bm1] + '(menu-item "Select Current" Buffer-menu-1-window + :help "Select this line's buffer, alone, in full frame")) + (bindings--define-key menu-map [ow] + '(menu-item "Select in Other Window" Buffer-menu-other-window + :help "Select this line's buffer in other window, leaving buffer menu visible")) + (bindings--define-key menu-map [tw] + '(menu-item "Select in Current Window" Buffer-menu-this-window + :help "Select this line's buffer in this window")) + (bindings--define-key menu-map [s2] menu-bar-separator) + (bindings--define-key menu-map [is] + '(menu-item "Regexp Isearch Marked Buffers..." Buffer-menu-isearch-buffers-regexp + :help "Search for a regexp through all marked buffers using Isearch")) + (bindings--define-key menu-map [ir] + '(menu-item "Isearch Marked Buffers..." Buffer-menu-isearch-buffers + :help "Search for a string through all marked buffers using Isearch")) + (bindings--define-key menu-map [s3] menu-bar-separator) + (bindings--define-key menu-map [by] + '(menu-item "Bury" Buffer-menu-bury + :help "Bury the buffer listed on this line")) + (bindings--define-key menu-map [vt] + '(menu-item "Set Unmodified" Buffer-menu-not-modified + :help "Mark buffer on this line as unmodified (no changes to save)")) + (bindings--define-key menu-map [ex] + '(menu-item "Execute" Buffer-menu-execute + :help "Save and/or delete buffers marked with s or k commands")) + (bindings--define-key menu-map [s4] menu-bar-separator) + (bindings--define-key menu-map [delb] + '(menu-item "Mark for Delete and Move Backwards" Buffer-menu-delete-backwards + :help "Mark buffer on this line to be deleted by x command and move up one line")) + (bindings--define-key menu-map [del] + '(menu-item "Mark for Delete" Buffer-menu-delete + :help "Mark buffer on this line to be deleted by x command")) + + (bindings--define-key menu-map [sv] + '(menu-item "Mark for Save" Buffer-menu-save + :help "Mark buffer on this line to be saved by x command")) + (bindings--define-key menu-map [umk] + '(menu-item "Unmark" Buffer-menu-unmark + :help "Cancel all requested operations on buffer on this line and move down")) + (bindings--define-key menu-map [mk] + '(menu-item "Mark" Buffer-menu-mark + :help "Mark buffer on this line for being displayed by v command")) map) "Local keymap for `Buffer-menu-mode' buffers.") diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 2a4cd704a43..350b0bd949d 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -264,110 +264,111 @@ font-lock keywords will not be case sensitive." (define-key map "\e\t" 'completion-at-point) (define-key map "\e\C-x" 'eval-defun) (define-key map "\e\C-q" 'indent-pp-sexp) - (define-key map [menu-bar emacs-lisp] (cons (purecopy "Emacs-Lisp") menu-map)) - (define-key menu-map [eldoc] - `(menu-item ,(purecopy "Auto-Display Documentation Strings") eldoc-mode + (bindings--define-key map [menu-bar emacs-lisp] + (cons "Emacs-Lisp" menu-map)) + (bindings--define-key menu-map [eldoc] + '(menu-item "Auto-Display Documentation Strings" eldoc-mode :button (:toggle . (bound-and-true-p eldoc-mode)) - :help ,(purecopy "Display the documentation string for the item under cursor"))) - (define-key menu-map [checkdoc] - `(menu-item ,(purecopy "Check Documentation Strings") checkdoc - :help ,(purecopy "Check documentation strings for style requirements"))) - (define-key menu-map [re-builder] - `(menu-item ,(purecopy "Construct Regexp") re-builder - :help ,(purecopy "Construct a regexp interactively"))) - (define-key menu-map [tracing] (cons (purecopy "Tracing") tracing-map)) - (define-key tracing-map [tr-a] - `(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 - :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] - `(menu-item ,(purecopy "Trace Function Quietly...") trace-function-background - :help ,(purecopy "Trace the function with trace output going quietly to a buffer"))) - (define-key tracing-map [tr-f] - `(menu-item ,(purecopy "Trace Function...") trace-function - :help ,(purecopy "Trace the function given as an argument"))) - (define-key menu-map [profiling] (cons (purecopy "Profiling") prof-map)) - (define-key prof-map [prof-restall] - `(menu-item ,(purecopy "Remove Instrumentation for All Functions") elp-restore-all - :help ,(purecopy "Restore the original definitions of all functions being profiled"))) - (define-key prof-map [prof-restfunc] - `(menu-item ,(purecopy "Remove Instrumentation for Function...") elp-restore-function - :help ,(purecopy "Restore an instrumented function to its original definition"))) - - (define-key prof-map [sep-rem] menu-bar-separator) - (define-key prof-map [prof-resall] - `(menu-item ,(purecopy "Reset Counters for All Functions") elp-reset-all - :help ,(purecopy "Reset the profiling information for all functions being profiled"))) - (define-key prof-map [prof-resfunc] - `(menu-item ,(purecopy "Reset Counters for Function...") elp-reset-function - :help ,(purecopy "Reset the profiling information for a function"))) - (define-key prof-map [prof-res] - `(menu-item ,(purecopy "Show Profiling Results") elp-results - :help ,(purecopy "Display current profiling results"))) - (define-key prof-map [prof-pack] - `(menu-item ,(purecopy "Instrument Package...") elp-instrument-package - :help ,(purecopy "Instrument for profiling all function that start with a prefix"))) - (define-key prof-map [prof-func] - `(menu-item ,(purecopy "Instrument Function...") elp-instrument-function - :help ,(purecopy "Instrument a function for profiling"))) - (define-key menu-map [lint] (cons (purecopy "Linting") lint-map)) - (define-key lint-map [lint-di] - `(menu-item ,(purecopy "Lint Directory...") elint-directory - :help ,(purecopy "Lint a directory"))) - (define-key lint-map [lint-f] - `(menu-item ,(purecopy "Lint File...") elint-file - :help ,(purecopy "Lint a file"))) - (define-key lint-map [lint-b] - `(menu-item ,(purecopy "Lint Buffer") elint-current-buffer - :help ,(purecopy "Lint the current buffer"))) - (define-key lint-map [lint-d] - `(menu-item ,(purecopy "Lint Defun") elint-defun - :help ,(purecopy "Lint the function at point"))) - (define-key menu-map [edebug-defun] - `(menu-item ,(purecopy "Instrument Function for Debugging") edebug-defun - :help ,(purecopy "Evaluate the top level form point is in, stepping through with Edebug") - :keys ,(purecopy "C-u C-M-x"))) - (define-key menu-map [separator-byte] menu-bar-separator) - (define-key menu-map [disas] - `(menu-item ,(purecopy "Disassemble Byte Compiled Object...") disassemble - :help ,(purecopy "Print disassembled code for OBJECT in a buffer"))) - (define-key menu-map [byte-recompile] - `(menu-item ,(purecopy "Byte-recompile Directory...") byte-recompile-directory - :help ,(purecopy "Recompile every `.el' file in DIRECTORY that needs recompilation"))) - (define-key menu-map [emacs-byte-compile-and-load] - `(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 - :help ,(purecopy "Byte compile the file containing the current buffer"))) - (define-key menu-map [separator-eval] menu-bar-separator) - (define-key menu-map [ielm] - `(menu-item ,(purecopy "Interactive Expression Evaluation") ielm - :help ,(purecopy "Interactively evaluate Emacs Lisp expressions"))) - (define-key menu-map [eval-buffer] - `(menu-item ,(purecopy "Evaluate Buffer") eval-buffer - :help ,(purecopy "Execute the current buffer as Lisp code"))) - (define-key menu-map [eval-region] - `(menu-item ,(purecopy "Evaluate Region") eval-region - :help ,(purecopy "Execute the region as Lisp code") + :help "Display the documentation string for the item under cursor")) + (bindings--define-key menu-map [checkdoc] + '(menu-item "Check Documentation Strings" checkdoc + :help "Check documentation strings for style requirements")) + (bindings--define-key menu-map [re-builder] + '(menu-item "Construct Regexp" re-builder + :help "Construct a regexp interactively")) + (bindings--define-key menu-map [tracing] (cons "Tracing" tracing-map)) + (bindings--define-key tracing-map [tr-a] + '(menu-item "Untrace All" untrace-all + :help "Untrace all currently traced functions")) + (bindings--define-key tracing-map [tr-uf] + '(menu-item "Untrace Function..." untrace-function + :help "Untrace function, and possibly activate all remaining advice")) + (bindings--define-key tracing-map [tr-sep] menu-bar-separator) + (bindings--define-key tracing-map [tr-q] + '(menu-item "Trace Function Quietly..." trace-function-background + :help "Trace the function with trace output going quietly to a buffer")) + (bindings--define-key tracing-map [tr-f] + '(menu-item "Trace Function..." trace-function + :help "Trace the function given as an argument")) + (bindings--define-key menu-map [profiling] (cons "Profiling" prof-map)) + (bindings--define-key prof-map [prof-restall] + '(menu-item "Remove Instrumentation for All Functions" elp-restore-all + :help "Restore the original definitions of all functions being profiled")) + (bindings--define-key prof-map [prof-restfunc] + '(menu-item "Remove Instrumentation for Function..." elp-restore-function + :help "Restore an instrumented function to its original definition")) + + (bindings--define-key prof-map [sep-rem] menu-bar-separator) + (bindings--define-key prof-map [prof-resall] + '(menu-item "Reset Counters for All Functions" elp-reset-all + :help "Reset the profiling information for all functions being profiled")) + (bindings--define-key prof-map [prof-resfunc] + '(menu-item "Reset Counters for Function..." elp-reset-function + :help "Reset the profiling information for a function")) + (bindings--define-key prof-map [prof-res] + '(menu-item "Show Profiling Results" elp-results + :help "Display current profiling results")) + (bindings--define-key prof-map [prof-pack] + '(menu-item "Instrument Package..." elp-instrument-package + :help "Instrument for profiling all function that start with a prefix")) + (bindings--define-key prof-map [prof-func] + '(menu-item "Instrument Function..." elp-instrument-function + :help "Instrument a function for profiling")) + (bindings--define-key menu-map [lint] (cons "Linting" lint-map)) + (bindings--define-key lint-map [lint-di] + '(menu-item "Lint Directory..." elint-directory + :help "Lint a directory")) + (bindings--define-key lint-map [lint-f] + '(menu-item "Lint File..." elint-file + :help "Lint a file")) + (bindings--define-key lint-map [lint-b] + '(menu-item "Lint Buffer" elint-current-buffer + :help "Lint the current buffer")) + (bindings--define-key lint-map [lint-d] + '(menu-item "Lint Defun" elint-defun + :help "Lint the function at point")) + (bindings--define-key menu-map [edebug-defun] + '(menu-item "Instrument Function for Debugging" edebug-defun + :help "Evaluate the top level form point is in, stepping through with Edebug" + :keys "C-u C-M-x")) + (bindings--define-key menu-map [separator-byte] menu-bar-separator) + (bindings--define-key menu-map [disas] + '(menu-item "Disassemble Byte Compiled Object..." disassemble + :help "Print disassembled code for OBJECT in a buffer")) + (bindings--define-key menu-map [byte-recompile] + '(menu-item "Byte-recompile Directory..." byte-recompile-directory + :help "Recompile every `.el' file in DIRECTORY that needs recompilation")) + (bindings--define-key menu-map [emacs-byte-compile-and-load] + '(menu-item "Byte-compile and Load" emacs-lisp-byte-compile-and-load + :help "Byte-compile the current file (if it has changed), then load compiled code")) + (bindings--define-key menu-map [byte-compile] + '(menu-item "Byte-compile This File" emacs-lisp-byte-compile + :help "Byte compile the file containing the current buffer")) + (bindings--define-key menu-map [separator-eval] menu-bar-separator) + (bindings--define-key menu-map [ielm] + '(menu-item "Interactive Expression Evaluation" ielm + :help "Interactively evaluate Emacs Lisp expressions")) + (bindings--define-key menu-map [eval-buffer] + '(menu-item "Evaluate Buffer" eval-buffer + :help "Execute the current buffer as Lisp code")) + (bindings--define-key menu-map [eval-region] + '(menu-item "Evaluate Region" eval-region + :help "Execute the region as Lisp code" :enable mark-active)) - (define-key menu-map [eval-sexp] - `(menu-item ,(purecopy "Evaluate Last S-expression") eval-last-sexp - :help ,(purecopy "Evaluate sexp before point; print value in minibuffer"))) - (define-key menu-map [separator-format] menu-bar-separator) - (define-key menu-map [comment-region] - `(menu-item ,(purecopy "Comment Out Region") comment-region - :help ,(purecopy "Comment or uncomment each line in the region") + (bindings--define-key menu-map [eval-sexp] + '(menu-item "Evaluate Last S-expression" eval-last-sexp + :help "Evaluate sexp before point; print value in minibuffer")) + (bindings--define-key menu-map [separator-format] menu-bar-separator) + (bindings--define-key menu-map [comment-region] + '(menu-item "Comment Out Region" comment-region + :help "Comment or uncomment each line in the region" :enable mark-active)) - (define-key menu-map [indent-region] - `(menu-item ,(purecopy "Indent Region") indent-region - :help ,(purecopy "Indent each nonblank line in the region") + (bindings--define-key menu-map [indent-region] + '(menu-item "Indent Region" indent-region + :help "Indent each nonblank line in the region" :enable mark-active)) - (define-key menu-map [indent-line] - `(menu-item ,(purecopy "Indent Line") lisp-indent-line)) + (bindings--define-key menu-map [indent-line] + '(menu-item "Indent Line" lisp-indent-line)) map) "Keymap for Emacs Lisp mode. All commands in `lisp-mode-shared-map' are inherited by this map.") @@ -430,16 +431,16 @@ if that value is non-nil." (set-keymap-parent map lisp-mode-shared-map) (define-key map "\e\C-x" 'lisp-eval-defun) (define-key map "\C-c\C-z" 'run-lisp) - (define-key map [menu-bar lisp] (cons (purecopy "Lisp") menu-map)) - (define-key menu-map [run-lisp] - `(menu-item ,(purecopy "Run inferior Lisp") run-lisp - :help ,(purecopy "Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'"))) - (define-key menu-map [ev-def] - `(menu-item ,(purecopy "Eval defun") lisp-eval-defun - :help ,(purecopy "Send the current defun to the Lisp process made by M-x run-lisp"))) - (define-key menu-map [ind-sexp] - `(menu-item ,(purecopy "Indent sexp") indent-sexp - :help ,(purecopy "Indent each line of the list starting just after point"))) + (bindings--define-key map [menu-bar lisp] (cons "Lisp" menu-map)) + (bindings--define-key menu-map [run-lisp] + '(menu-item "Run inferior Lisp" run-lisp + :help "Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'")) + (bindings--define-key menu-map [ev-def] + '(menu-item "Eval defun" lisp-eval-defun + :help "Send the current defun to the Lisp process made by M-x run-lisp")) + (bindings--define-key menu-map [ind-sexp] + '(menu-item "Indent sexp" indent-sexp + :help "Indent each line of the list starting just after point")) map) "Keymap for ordinary Lisp mode. All commands in `lisp-mode-shared-map' are inherited by this map.") @@ -487,23 +488,24 @@ if that value is non-nil." (define-key map "\e\C-q" 'indent-pp-sexp) (define-key map "\e\t" 'completion-at-point) (define-key map "\n" 'eval-print-last-sexp) - (define-key map [menu-bar lisp-interaction] (cons (purecopy "Lisp-Interaction") menu-map)) - (define-key menu-map [eval-defun] - `(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 - :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 - :help ,(purecopy "Evaluate the top level form point is in, stepping through with Edebug") - :keys ,(purecopy "C-u C-M-x"))) - (define-key menu-map [indent-pp-sexp] - `(menu-item ,(purecopy "Indent or Pretty-Print") indent-pp-sexp - :help ,(purecopy "Indent each line of the list starting just after point, or prettyprint it"))) - (define-key menu-map [complete-symbol] - `(menu-item ,(purecopy "Complete Lisp Symbol") completion-at-point - :help ,(purecopy "Perform completion on Lisp symbol preceding point"))) + (bindings--define-key map [menu-bar lisp-interaction] + (cons "Lisp-Interaction" menu-map)) + (bindings--define-key menu-map [eval-defun] + '(menu-item "Evaluate Defun" eval-defun + :help "Evaluate the top-level form containing point, or after point")) + (bindings--define-key menu-map [eval-print-last-sexp] + '(menu-item "Evaluate and Print" eval-print-last-sexp + :help "Evaluate sexp before point; print value into current buffer")) + (bindings--define-key menu-map [edebug-defun-lisp-interaction] + '(menu-item "Instrument Function for Debugging" edebug-defun + :help "Evaluate the top level form point is in, stepping through with Edebug" + :keys "C-u C-M-x")) + (bindings--define-key menu-map [indent-pp-sexp] + '(menu-item "Indent or Pretty-Print" indent-pp-sexp + :help "Indent each line of the list starting just after point, or prettyprint it")) + (bindings--define-key menu-map [complete-symbol] + '(menu-item "Complete Lisp Symbol" completion-at-point + :help "Perform completion on Lisp symbol preceding point")) map) "Keymap for Lisp Interaction mode. All commands in `lisp-mode-shared-map' are inherited by this map.") diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 0f3d8c2d2bf..137a43b3d11 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -58,98 +58,98 @@ (defvar describe-language-environment-map (let ((map (make-sparse-keymap "Describe Language Environment"))) - (define-key map - [Default] `(menu-item ,(purecopy "Default") describe-specified-language-support)) + (bindings--define-key map + [Default] '(menu-item "Default" describe-specified-language-support)) map)) (defvar setup-language-environment-map (let ((map (make-sparse-keymap "Set Language Environment"))) - (define-key map - [Default] `(menu-item ,(purecopy "Default") setup-specified-language-environment)) + (bindings--define-key map + [Default] '(menu-item "Default" setup-specified-language-environment)) map)) (defvar set-coding-system-map (let ((map (make-sparse-keymap "Set Coding System"))) - (define-key-after map [universal-coding-system-argument] - `(menu-item ,(purecopy "For Next Command") universal-coding-system-argument - :help ,(purecopy "Coding system to be used by next command"))) - (define-key-after map [separator-1] menu-bar-separator) - (define-key-after map [set-buffer-file-coding-system] - `(menu-item ,(purecopy "For Saving This Buffer") set-buffer-file-coding-system - :help ,(purecopy "How to encode this buffer when saved"))) - (define-key-after map [revert-buffer-with-coding-system] - `(menu-item ,(purecopy "For Reverting This File Now") - revert-buffer-with-coding-system - :enable buffer-file-name - :help ,(purecopy "Revisit this file immediately using specified coding system"))) - (define-key-after map [set-file-name-coding-system] - `(menu-item ,(purecopy "For File Name") set-file-name-coding-system - :help ,(purecopy "How to decode/encode file names"))) - (define-key-after map [separator-2] menu-bar-separator) - - (define-key-after map [set-keyboard-coding-system] - `(menu-item ,(purecopy "For Keyboard") set-keyboard-coding-system - :help ,(purecopy "How to decode keyboard input"))) - (define-key-after map [set-terminal-coding-system] - `(menu-item ,(purecopy "For Terminal") set-terminal-coding-system - :enable (null (memq initial-window-system '(x w32 ns))) - :help ,(purecopy "How to encode terminal output"))) - (define-key-after map [separator-3] menu-bar-separator) - - (define-key-after map [set-selection-coding-system] - `(menu-item ,(purecopy "For X Selections/Clipboard") set-selection-coding-system - :visible (display-selections-p) - :help ,(purecopy "How to en/decode data to/from selection/clipboard"))) - (define-key-after map [set-next-selection-coding-system] - `(menu-item ,(purecopy "For Next X Selection") set-next-selection-coding-system - :visible (display-selections-p) - :help ,(purecopy "How to en/decode next selection/clipboard operation"))) - (define-key-after map [set-buffer-process-coding-system] - `(menu-item ,(purecopy "For I/O with Subprocess") set-buffer-process-coding-system + (bindings--define-key map [set-buffer-process-coding-system] + '(menu-item "For I/O with Subprocess" set-buffer-process-coding-system :visible (fboundp 'start-process) :enable (get-buffer-process (current-buffer)) - :help ,(purecopy "How to en/decode I/O from/to subprocess connected to this buffer"))) + :help "How to en/decode I/O from/to subprocess connected to this buffer")) + (bindings--define-key map [set-next-selection-coding-system] + '(menu-item "For Next X Selection" set-next-selection-coding-system + :visible (display-selections-p) + :help "How to en/decode next selection/clipboard operation")) + (bindings--define-key map [set-selection-coding-system] + '(menu-item "For X Selections/Clipboard" set-selection-coding-system + :visible (display-selections-p) + :help "How to en/decode data to/from selection/clipboard")) + + (bindings--define-key map [separator-3] menu-bar-separator) + (bindings--define-key map [set-terminal-coding-system] + '(menu-item "For Terminal" set-terminal-coding-system + :enable (null (memq initial-window-system '(x w32 ns))) + :help "How to encode terminal output")) + (bindings--define-key map [set-keyboard-coding-system] + '(menu-item "For Keyboard" set-keyboard-coding-system + :help "How to decode keyboard input")) + + (bindings--define-key map [separator-2] menu-bar-separator) + (bindings--define-key map [set-file-name-coding-system] + '(menu-item "For File Name" set-file-name-coding-system + :help "How to decode/encode file names")) + (bindings--define-key map [revert-buffer-with-coding-system] + '(menu-item "For Reverting This File Now" + revert-buffer-with-coding-system + :enable buffer-file-name + :help "Revisit this file immediately using specified coding system")) + (bindings--define-key map [set-buffer-file-coding-system] + '(menu-item "For Saving This Buffer" set-buffer-file-coding-system + :help "How to encode this buffer when saved")) + (bindings--define-key map [separator-1] menu-bar-separator) + (bindings--define-key map [universal-coding-system-argument] + '(menu-item "For Next Command" universal-coding-system-argument + :help "Coding system to be used by next command")) map)) (defvar mule-menu-keymap (let ((map (make-sparse-keymap "Mule (Multilingual Environment)"))) - (define-key-after map [set-language-environment] - `(menu-item ,(purecopy "Set Language Environment") ,setup-language-environment-map)) - (define-key-after map [separator-mule] menu-bar-separator) - - (define-key-after map [toggle-input-method] - `(menu-item ,(purecopy "Toggle Input Method") toggle-input-method)) - (define-key-after map [set-input-method] - `(menu-item ,(purecopy "Select Input Method...") set-input-method)) - (define-key-after map [describe-input-method] - `(menu-item ,(purecopy "Describe Input Method") describe-input-method)) - (define-key-after map [separator-input-method] menu-bar-separator) - - (define-key-after map [set-various-coding-system] - `(menu-item ,(purecopy "Set Coding Systems") ,set-coding-system-map - :enable (default-value 'enable-multibyte-characters))) - (define-key-after map [view-hello-file] - `(menu-item ,(purecopy "Show Multilingual Sample Text") view-hello-file + (bindings--define-key map [mule-diag] + '(menu-item "Show All Multilingual Settings" mule-diag + :help "Display multilingual environment settings")) + (bindings--define-key map [list-character-sets] + '(menu-item "List Character Sets" list-character-sets + :help "Show table of available character sets")) + (bindings--define-key map [describe-coding-system] + '(menu-item "Describe Coding System..." describe-coding-system)) + (bindings--define-key map [describe-input-method] + '(menu-item "Describe Input Method..." describe-input-method + :help "Keyboard layout for a specific input method")) + (bindings--define-key map [describe-language-environment] + `(menu-item "Describe Language Environment" + ,describe-language-environment-map + :help "Show multilingual settings for a specific language")) + + (bindings--define-key map [separator-coding-system] menu-bar-separator) + (bindings--define-key map [view-hello-file] + '(menu-item "Show Multilingual Sample Text" view-hello-file :enable (file-readable-p (expand-file-name "HELLO" data-directory)) - :help ,(purecopy "Demonstrate various character sets"))) - (define-key-after map [separator-coding-system] menu-bar-separator) + :help "Demonstrate various character sets")) + (bindings--define-key map [set-various-coding-system] + `(menu-item "Set Coding Systems" ,set-coding-system-map + :enable (default-value 'enable-multibyte-characters))) - (define-key-after map [describe-language-environment] - `(menu-item ,(purecopy "Describe Language Environment") - ,describe-language-environment-map - :help ,(purecopy "Show multilingual settings for a specific language"))) - (define-key-after map [describe-input-method] - `(menu-item ,(purecopy "Describe Input Method...") describe-input-method - :help ,(purecopy "Keyboard layout for a specific input method"))) - (define-key-after map [describe-coding-system] - `(menu-item ,(purecopy "Describe Coding System...") describe-coding-system)) - (define-key-after map [list-character-sets] - `(menu-item ,(purecopy "List Character Sets") list-character-sets - :help ,(purecopy "Show table of available character sets"))) - (define-key-after map [mule-diag] - `(menu-item ,(purecopy "Show All Multilingual Settings") mule-diag - :help ,(purecopy "Display multilingual environment settings"))) + (bindings--define-key map [separator-input-method] menu-bar-separator) + (bindings--define-key map [describe-input-method] + '(menu-item "Describe Input Method" describe-input-method)) + (bindings--define-key map [set-input-method] + '(menu-item "Select Input Method..." set-input-method)) + (bindings--define-key map [toggle-input-method] + '(menu-item "Toggle Input Method" toggle-input-method)) + + (bindings--define-key map [separator-mule] menu-bar-separator) + (bindings--define-key map [set-language-environment] + `(menu-item "Set Language Environment" ,setup-language-environment-map)) map) "Keymap for Mule (Multilingual environment) menu specific commands.") diff --git a/lisp/loadup.el b/lisp/loadup.el index d5841d16780..35681718976 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -61,7 +61,7 @@ (if (eq t purify-flag) ;; Hash consing saved around 11% of pure space in my tests. - (setq purify-flag (make-hash-table :test 'equal))) + (setq purify-flag (make-hash-table :test 'equal :size 70000))) (message "Using load-path %s" load-path) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 64b0a18e901..619510e8833 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -49,14 +49,14 @@ (setq menu-bar-final-items '(buffer services help-menu)) (setq menu-bar-final-items '(buffer services hide-app quit)) ;; Add standard top-level items to GNUstep menu. - (define-key global-map [menu-bar quit] - `(menu-item ,(purecopy "Quit") save-buffers-kill-emacs - :help ,(purecopy "Save unsaved buffers, then exit"))) - (define-key global-map [menu-bar hide-app] - `(menu-item ,(purecopy "Hide") ns-do-hide-emacs - :help ,(purecopy "Hide Emacs")))) - (define-key global-map [menu-bar services] ; set-up in ns-win - (cons (purecopy "Services") (make-sparse-keymap "Services")))) + (bindings--define-key global-map [menu-bar quit] + '(menu-item "Quit" save-buffers-kill-emacs + :help "Save unsaved buffers, then exit")) + (bindings--define-key global-map [menu-bar hide-app] + '(menu-item "Hide" ns-do-hide-emacs + :help "Hide Emacs"))) + (bindings--define-key global-map [menu-bar services] ; Set-up in ns-win. + (cons "Services" (make-sparse-keymap "Services")))) ;; This definition is just to show what this looks like. ;; It gets modified in place when menu-bar-update-buffers is called. @@ -69,85 +69,84 @@ (let ((menu (make-sparse-keymap "File"))) ;; The "File" menu items - (define-key menu [exit-emacs] - `(menu-item ,(purecopy "Quit") save-buffers-kill-terminal - :help ,(purecopy "Save unsaved buffers, then exit"))) + (bindings--define-key menu [exit-emacs] + '(menu-item "Quit" save-buffers-kill-terminal + :help "Save unsaved buffers, then exit")) - (define-key menu [separator-exit] + (bindings--define-key menu [separator-exit] menu-bar-separator) ;; Don't use delete-frame as event name because that is a special ;; event. - (define-key menu [delete-this-frame] - `(menu-item ,(purecopy "Delete Frame") delete-frame + (bindings--define-key menu [delete-this-frame] + '(menu-item "Delete Frame" delete-frame :visible (fboundp 'delete-frame) :enable (delete-frame-enabled-p) - :help ,(purecopy "Delete currently selected frame"))) - (define-key menu [make-frame-on-display] - `(menu-item ,(purecopy "New Frame on Display...") make-frame-on-display + :help "Delete currently selected frame")) + (bindings--define-key menu [make-frame-on-display] + '(menu-item "New Frame on Display..." make-frame-on-display :visible (fboundp 'make-frame-on-display) - :help ,(purecopy "Open a new frame on another display"))) - (define-key menu [make-frame] - `(menu-item ,(purecopy "New Frame") make-frame-command + :help "Open a new frame on another display")) + (bindings--define-key menu [make-frame] + '(menu-item "New Frame" make-frame-command :visible (fboundp 'make-frame-command) - :help ,(purecopy "Open a new frame"))) + :help "Open a new frame")) - (define-key menu [separator-frame] + (bindings--define-key menu [separator-frame] menu-bar-separator) - (define-key menu [one-window] - `(menu-item ,(purecopy "Remove Other Windows") delete-other-windows + (bindings--define-key menu [one-window] + '(menu-item "Remove Other Windows" delete-other-windows :enable (not (one-window-p t nil)) - :help ,(purecopy "Make selected window fill whole frame"))) + :help "Make selected window fill whole frame")) - (define-key menu [new-window-on-right] - `(menu-item ,(purecopy "New Window on Right") split-window-right + (bindings--define-key menu [new-window-on-right] + '(menu-item "New Window on Right" split-window-right :enable (and (menu-bar-menu-frame-live-and-visible-p) (menu-bar-non-minibuffer-window-p)) - :help ,(purecopy "Make new window on right of selected one"))) + :help "Make new window on right of selected one")) - (define-key menu [new-window-below] - `(menu-item ,(purecopy "New Window Below") split-window-below + (bindings--define-key menu [new-window-below] + '(menu-item "New Window Below" split-window-below :enable (and (menu-bar-menu-frame-live-and-visible-p) (menu-bar-non-minibuffer-window-p)) - :help ,(purecopy "Make new window below selected one"))) + :help "Make new window below selected one")) - (define-key menu [separator-window] + (bindings--define-key menu [separator-window] menu-bar-separator) - (define-key menu [ps-print-region] - `(menu-item ,(purecopy "PostScript Print Region (B+W)") ps-print-region + (bindings--define-key menu [ps-print-region] + '(menu-item "PostScript Print Region (B+W)" ps-print-region :enable mark-active - :help ,(purecopy "Pretty-print marked region in black and white to PostScript printer"))) - (define-key menu [ps-print-buffer] - `(menu-item ,(purecopy "PostScript Print Buffer (B+W)") ps-print-buffer + :help "Pretty-print marked region in black and white to PostScript printer")) + (bindings--define-key menu [ps-print-buffer] + '(menu-item "PostScript Print Buffer (B+W)" ps-print-buffer :enable (menu-bar-menu-frame-live-and-visible-p) - :help ,(purecopy "Pretty-print current buffer in black and white to PostScript printer"))) - (define-key menu [ps-print-region-faces] - `(menu-item ,(purecopy "PostScript Print Region") + :help "Pretty-print current buffer in black and white to PostScript printer")) + (bindings--define-key menu [ps-print-region-faces] + '(menu-item "PostScript Print Region" ps-print-region-with-faces :enable mark-active - :help ,(purecopy - "Pretty-print marked region to PostScript printer"))) - (define-key menu [ps-print-buffer-faces] - `(menu-item ,(purecopy "PostScript Print Buffer") + :help "Pretty-print marked region to PostScript printer")) + (bindings--define-key menu [ps-print-buffer-faces] + '(menu-item "PostScript Print Buffer" ps-print-buffer-with-faces :enable (menu-bar-menu-frame-live-and-visible-p) - :help ,(purecopy "Pretty-print current buffer to PostScript printer"))) - (define-key menu [print-region] - `(menu-item ,(purecopy "Print Region") print-region + :help "Pretty-print current buffer to PostScript printer")) + (bindings--define-key menu [print-region] + '(menu-item "Print Region" print-region :enable mark-active - :help ,(purecopy "Print region between mark and current position"))) - (define-key menu [print-buffer] - `(menu-item ,(purecopy "Print Buffer") print-buffer + :help "Print region between mark and current position")) + (bindings--define-key menu [print-buffer] + '(menu-item "Print Buffer" print-buffer :enable (menu-bar-menu-frame-live-and-visible-p) - :help ,(purecopy "Print current buffer with page headings"))) + :help "Print current buffer with page headings")) - (define-key menu [separator-print] + (bindings--define-key menu [separator-print] menu-bar-separator) - (define-key menu [recover-session] - `(menu-item ,(purecopy "Recover Crashed Session") recover-session + (bindings--define-key menu [recover-session] + '(menu-item "Recover Crashed Session" recover-session :enable (and auto-save-list-file-prefix (file-directory-p @@ -160,55 +159,52 @@ (file-name-nondirectory auto-save-list-file-prefix))) t)) - :help ,(purecopy "Recover edits from a crashed session"))) - (define-key menu [revert-buffer] - `(menu-item ,(purecopy "Revert Buffer") revert-buffer + :help "Recover edits from a crashed session")) + (bindings--define-key menu [revert-buffer] + '(menu-item "Revert Buffer" revert-buffer :enable (or revert-buffer-function revert-buffer-insert-file-contents-function (and buffer-file-number (or (buffer-modified-p) (not (verify-visited-file-modtime (current-buffer)))))) - :help ,(purecopy "Re-read current buffer from its file"))) - (define-key menu [write-file] - `(menu-item ,(purecopy "Save As...") write-file + :help "Re-read current buffer from its file")) + (bindings--define-key menu [write-file] + '(menu-item "Save As..." write-file :enable (and (menu-bar-menu-frame-live-and-visible-p) (menu-bar-non-minibuffer-window-p)) - :help ,(purecopy "Write current buffer to another file"))) - (define-key menu [save-buffer] - `(menu-item ,(purecopy "Save") save-buffer + :help "Write current buffer to another file")) + (bindings--define-key menu [save-buffer] + '(menu-item "Save" save-buffer :enable (and (buffer-modified-p) (buffer-file-name) (menu-bar-non-minibuffer-window-p)) - :help ,(purecopy "Save current buffer to its file"))) + :help "Save current buffer to its file")) - (define-key menu [separator-save] + (bindings--define-key menu [separator-save] menu-bar-separator) - (define-key menu [kill-buffer] - `(menu-item ,(purecopy "Close") kill-this-buffer + (bindings--define-key menu [kill-buffer] + '(menu-item "Close" kill-this-buffer :enable (kill-this-buffer-enabled-p) - :help ,(purecopy "Discard (kill) current buffer"))) - (define-key menu [insert-file] - `(menu-item ,(purecopy "Insert File...") insert-file + :help "Discard (kill) current buffer")) + (bindings--define-key menu [insert-file] + '(menu-item "Insert File..." insert-file :enable (menu-bar-non-minibuffer-window-p) - :help ,(purecopy "Insert another file into current buffer"))) - (define-key menu [dired] - `(menu-item ,(purecopy "Open Directory...") dired + :help "Insert another file into current buffer")) + (bindings--define-key menu [dired] + '(menu-item "Open Directory..." dired :enable (menu-bar-non-minibuffer-window-p) - :help ,(purecopy - "Read a directory, to operate on its files"))) - (define-key menu [open-file] - `(menu-item ,(purecopy "Open File...") menu-find-file-existing + :help "Read a directory, to operate on its files")) + (bindings--define-key menu [open-file] + '(menu-item "Open File..." menu-find-file-existing :enable (menu-bar-non-minibuffer-window-p) - :help ,(purecopy - "Read an existing file into an Emacs buffer"))) - (define-key menu [new-file] - `(menu-item ,(purecopy "Visit New File...") find-file + :help "Read an existing file into an Emacs buffer")) + (bindings--define-key menu [new-file] + '(menu-item "Visit New File..." find-file :enable (menu-bar-non-minibuffer-window-p) - :help ,(purecopy - "Specify a new file's name, to edit the file"))) + :help "Specify a new file's name, to edit the file")) menu)) @@ -291,148 +287,143 @@ ;; The Edit->Search->Incremental Search menu (defvar menu-bar-i-search-menu (let ((menu (make-sparse-keymap "Incremental Search"))) - (define-key menu [isearch-backward-regexp] - `(menu-item ,(purecopy "Backward Regexp...") isearch-backward-regexp - :help ,(purecopy - "Search backwards for a regular expression as you type it"))) - (define-key menu [isearch-forward-regexp] - `(menu-item ,(purecopy "Forward Regexp...") isearch-forward-regexp - :help ,(purecopy - "Search forward for a regular expression as you type it"))) - (define-key menu [isearch-backward] - `(menu-item ,(purecopy "Backward String...") isearch-backward - :help ,(purecopy "Search backwards for a string as you type it"))) - (define-key menu [isearch-forward] - `(menu-item ,(purecopy "Forward String...") isearch-forward - :help ,(purecopy "Search forward for a string as you type it"))) + (bindings--define-key menu [isearch-backward-regexp] + '(menu-item "Backward Regexp..." isearch-backward-regexp + :help "Search backwards for a regular expression as you type it")) + (bindings--define-key menu [isearch-forward-regexp] + '(menu-item "Forward Regexp..." isearch-forward-regexp + :help "Search forward for a regular expression as you type it")) + (bindings--define-key menu [isearch-backward] + '(menu-item "Backward String..." isearch-backward + :help "Search backwards for a string as you type it")) + (bindings--define-key menu [isearch-forward] + '(menu-item "Forward String..." isearch-forward + :help "Search forward for a string as you type it")) menu)) (defvar menu-bar-search-menu (let ((menu (make-sparse-keymap "Search"))) - (define-key menu [i-search] - `(menu-item ,(purecopy "Incremental Search") ,menu-bar-i-search-menu)) - (define-key menu [separator-tag-isearch] + (bindings--define-key menu [i-search] + `(menu-item "Incremental Search" ,menu-bar-i-search-menu)) + (bindings--define-key menu [separator-tag-isearch] menu-bar-separator) - (define-key menu [tags-continue] - `(menu-item ,(purecopy "Continue Tags Search") tags-loop-continue - :help ,(purecopy "Continue last tags search operation"))) - (define-key menu [tags-srch] - `(menu-item ,(purecopy "Search Tagged Files...") tags-search - :help ,(purecopy "Search for a regexp in all tagged files"))) - (define-key menu [separator-tag-search] menu-bar-separator) + (bindings--define-key menu [tags-continue] + '(menu-item "Continue Tags Search" tags-loop-continue + :help "Continue last tags search operation")) + (bindings--define-key menu [tags-srch] + '(menu-item "Search Tagged Files..." tags-search + :help "Search for a regexp in all tagged files")) + (bindings--define-key menu [separator-tag-search] menu-bar-separator) - (define-key menu [repeat-search-back] - `(menu-item ,(purecopy "Repeat Backwards") + (bindings--define-key menu [repeat-search-back] + '(menu-item "Repeat Backwards" nonincremental-repeat-search-backward :enable (or (and (eq menu-bar-last-search-type 'string) search-ring) (and (eq menu-bar-last-search-type 'regexp) regexp-search-ring)) - :help ,(purecopy "Repeat last search backwards"))) - (define-key menu [repeat-search-fwd] - `(menu-item ,(purecopy "Repeat Forward") + :help "Repeat last search backwards")) + (bindings--define-key menu [repeat-search-fwd] + '(menu-item "Repeat Forward" nonincremental-repeat-search-forward :enable (or (and (eq menu-bar-last-search-type 'string) search-ring) (and (eq menu-bar-last-search-type 'regexp) regexp-search-ring)) - :help ,(purecopy "Repeat last search forward"))) - (define-key menu [separator-repeat-search] + :help "Repeat last search forward")) + (bindings--define-key menu [separator-repeat-search] menu-bar-separator) - (define-key menu [re-search-backward] - `(menu-item ,(purecopy "Regexp Backwards...") + (bindings--define-key menu [re-search-backward] + '(menu-item "Regexp Backwards..." nonincremental-re-search-backward - :help ,(purecopy - "Search backwards for a regular expression"))) - (define-key menu [re-search-forward] - `(menu-item ,(purecopy "Regexp Forward...") + :help "Search backwards for a regular expression")) + (bindings--define-key menu [re-search-forward] + '(menu-item "Regexp Forward..." nonincremental-re-search-forward - :help ,(purecopy "Search forward for a regular expression"))) + :help "Search forward for a regular expression")) - (define-key menu [search-backward] - `(menu-item ,(purecopy "String Backwards...") + (bindings--define-key menu [search-backward] + '(menu-item "String Backwards..." nonincremental-search-backward - :help ,(purecopy "Search backwards for a string"))) - (define-key menu [search-forward] - `(menu-item ,(purecopy "String Forward...") nonincremental-search-forward - :help ,(purecopy "Search forward for a string"))) + :help "Search backwards for a string")) + (bindings--define-key menu [search-forward] + '(menu-item "String Forward..." nonincremental-search-forward + :help "Search forward for a string")) menu)) ;; The Edit->Replace submenu (defvar menu-bar-replace-menu (let ((menu (make-sparse-keymap "Replace"))) - (define-key menu [tags-repl-continue] - `(menu-item ,(purecopy "Continue Replace") tags-loop-continue - :help ,(purecopy "Continue last tags replace operation"))) - (define-key menu [tags-repl] - `(menu-item ,(purecopy "Replace in Tagged Files...") tags-query-replace - :help ,(purecopy - "Interactively replace a regexp in all tagged files"))) - (define-key menu [separator-replace-tags] + (bindings--define-key menu [tags-repl-continue] + '(menu-item "Continue Replace" tags-loop-continue + :help "Continue last tags replace operation")) + (bindings--define-key menu [tags-repl] + '(menu-item "Replace in Tagged Files..." tags-query-replace + :help "Interactively replace a regexp in all tagged files")) + (bindings--define-key menu [separator-replace-tags] menu-bar-separator) - (define-key menu [query-replace-regexp] - `(menu-item ,(purecopy "Replace Regexp...") query-replace-regexp + (bindings--define-key menu [query-replace-regexp] + '(menu-item "Replace Regexp..." query-replace-regexp :enable (not buffer-read-only) - :help ,(purecopy "Replace regular expression interactively, ask about each occurrence"))) - (define-key menu [query-replace] - `(menu-item ,(purecopy "Replace String...") query-replace + :help "Replace regular expression interactively, ask about each occurrence")) + (bindings--define-key menu [query-replace] + '(menu-item "Replace String..." query-replace :enable (not buffer-read-only) - :help ,(purecopy - "Replace string interactively, ask about each occurrence"))) + :help "Replace string interactively, ask about each occurrence")) menu)) ;;; Assemble the top-level Edit menu items. (defvar menu-bar-goto-menu (let ((menu (make-sparse-keymap "Go To"))) - (define-key menu [set-tags-name] - `(menu-item ,(purecopy "Set Tags File Name...") visit-tags-table - :help ,(purecopy "Tell Tags commands which tag table file to use"))) + (bindings--define-key menu [set-tags-name] + '(menu-item "Set Tags File Name..." visit-tags-table + :help "Tell Tags commands which tag table file to use")) - (define-key menu [separator-tag-file] + (bindings--define-key menu [separator-tag-file] menu-bar-separator) - (define-key menu [apropos-tags] - `(menu-item ,(purecopy "Tags Apropos...") tags-apropos - :help ,(purecopy "Find function/variables whose names match regexp"))) - (define-key menu [next-tag-otherw] - `(menu-item ,(purecopy "Next Tag in Other Window") + (bindings--define-key menu [apropos-tags] + '(menu-item "Tags Apropos..." tags-apropos + :help "Find function/variables whose names match regexp")) + (bindings--define-key menu [next-tag-otherw] + '(menu-item "Next Tag in Other Window" menu-bar-next-tag-other-window :enable (and (boundp 'tags-location-ring) (not (ring-empty-p tags-location-ring))) - :help ,(purecopy "Find next function/variable matching last tag name in another window"))) + :help "Find next function/variable matching last tag name in another window")) - (define-key menu [next-tag] - `(menu-item ,(purecopy "Find Next Tag") + (bindings--define-key menu [next-tag] + '(menu-item "Find Next Tag" menu-bar-next-tag :enable (and (boundp 'tags-location-ring) (not (ring-empty-p tags-location-ring))) - :help ,(purecopy "Find next function/variable matching last tag name"))) - (define-key menu [find-tag-otherw] - `(menu-item ,(purecopy "Find Tag in Other Window...") find-tag-other-window - :help ,(purecopy "Find function/variable definition in another window"))) - (define-key menu [find-tag] - `(menu-item ,(purecopy "Find Tag...") find-tag - :help ,(purecopy "Find definition of function or variable"))) - - (define-key menu [separator-tags] + :help "Find next function/variable matching last tag name")) + (bindings--define-key menu [find-tag-otherw] + '(menu-item "Find Tag in Other Window..." find-tag-other-window + :help "Find function/variable definition in another window")) + (bindings--define-key menu [find-tag] + '(menu-item "Find Tag..." find-tag + :help "Find definition of function or variable")) + + (bindings--define-key menu [separator-tags] menu-bar-separator) - (define-key menu [end-of-buf] - `(menu-item ,(purecopy "Goto End of Buffer") end-of-buffer)) - (define-key menu [beg-of-buf] - `(menu-item ,(purecopy "Goto Beginning of Buffer") beginning-of-buffer)) - (define-key menu [go-to-pos] - `(menu-item ,(purecopy "Goto Buffer Position...") goto-char - :help ,(purecopy "Read a number N and go to buffer position N"))) - (define-key menu [go-to-line] - `(menu-item ,(purecopy "Goto Line...") goto-line - :help ,(purecopy "Read a line number and go to that line"))) + (bindings--define-key menu [end-of-buf] + '(menu-item "Goto End of Buffer" end-of-buffer)) + (bindings--define-key menu [beg-of-buf] + '(menu-item "Goto Beginning of Buffer" beginning-of-buffer)) + (bindings--define-key menu [go-to-pos] + '(menu-item "Goto Buffer Position..." goto-char + :help "Read a number N and go to buffer position N")) + (bindings--define-key menu [go-to-line] + '(menu-item "Goto Line..." goto-line + :help "Read a line number and go to that line")) menu)) @@ -442,59 +433,59 @@ (defvar menu-bar-edit-menu (let ((menu (make-sparse-keymap "Edit"))) - (define-key menu [props] - `(menu-item ,(purecopy "Text Properties") facemenu-menu)) + (bindings--define-key menu [props] + `(menu-item "Text Properties" facemenu-menu)) ;; ns-win.el said: Add spell for platform consistency. (if (featurep 'ns) - (define-key menu [spell] - `(menu-item ,(purecopy "Spell") ispell-menu-map))) + (bindings--define-key menu [spell] + `(menu-item "Spell" ispell-menu-map))) - (define-key menu [fill] - `(menu-item ,(purecopy "Fill") fill-region + (bindings--define-key menu [fill] + `(menu-item "Fill" fill-region :enable (and mark-active (not buffer-read-only)) :help - ,(purecopy "Fill text in region to fit between left and right margin"))) + "Fill text in region to fit between left and right margin")) - (define-key menu [separator-bookmark] + (bindings--define-key menu [separator-bookmark] menu-bar-separator) - (define-key menu [bookmark] - `(menu-item ,(purecopy "Bookmarks") menu-bar-bookmark-map)) + (bindings--define-key menu [bookmark] + `(menu-item "Bookmarks" menu-bar-bookmark-map)) - (define-key menu [goto] - `(menu-item ,(purecopy "Go To") ,menu-bar-goto-menu)) + (bindings--define-key menu [goto] + `(menu-item "Go To" ,menu-bar-goto-menu)) - (define-key menu [replace] - `(menu-item ,(purecopy "Replace") ,menu-bar-replace-menu)) + (bindings--define-key menu [replace] + `(menu-item "Replace" ,menu-bar-replace-menu)) - (define-key menu [search] - `(menu-item ,(purecopy "Search") ,menu-bar-search-menu)) + (bindings--define-key menu [search] + `(menu-item "Search" ,menu-bar-search-menu)) - (define-key menu [separator-search] + (bindings--define-key menu [separator-search] menu-bar-separator) - (define-key menu [mark-whole-buffer] - `(menu-item ,(purecopy "Select All") mark-whole-buffer - :help ,(purecopy "Mark the whole buffer for a subsequent cut/copy"))) - (define-key menu [clear] - `(menu-item ,(purecopy "Clear") delete-region + (bindings--define-key menu [mark-whole-buffer] + '(menu-item "Select All" mark-whole-buffer + :help "Mark the whole buffer for a subsequent cut/copy")) + (bindings--define-key menu [clear] + '(menu-item "Clear" delete-region :enable (and mark-active (not buffer-read-only)) :help - ,(purecopy "Delete the text in region between mark and current position"))) + "Delete the text in region between mark and current position")) - (define-key menu (if (featurep 'ns) [select-paste] + (bindings--define-key menu (if (featurep 'ns) [select-paste] [paste-from-menu]) ;; ns-win.el said: Change text to be more consistent with ;; surrounding menu items `paste', etc." - `(menu-item ,(purecopy (if (featurep 'ns) "Select and Paste" - "Paste from Kill Menu")) yank-menu - :enable (and (cdr yank-menu) (not buffer-read-only)) - :help ,(purecopy "Choose a string from the kill ring and paste it"))) - (define-key menu [paste] - `(menu-item ,(purecopy "Paste") yank + `(menu-item ,(if (featurep 'ns) "Select and Paste" + "Paste from Kill Menu") yank-menu + :enable (and (cdr yank-menu) (not buffer-read-only)) + :help "Choose a string from the kill ring and paste it")) + (bindings--define-key menu [paste] + '(menu-item "Paste" yank :enable (and (or ;; Emacs compiled --without-x (or --with-ns) ;; doesn't have x-selection-exists-p. @@ -504,35 +495,35 @@ (cdr yank-menu) kill-ring)) (not buffer-read-only)) - :help ,(purecopy "Paste (yank) text most recently cut/copied"))) - (define-key menu [copy] + :help "Paste (yank) text most recently cut/copied")) + (bindings--define-key menu [copy] ;; ns-win.el said: Substitute a Copy function that works better ;; under X (for GNUstep). - `(menu-item ,(purecopy "Copy") ,(if (featurep 'ns) - 'ns-copy-including-secondary - 'kill-ring-save) + `(menu-item "Copy" ,(if (featurep 'ns) + 'ns-copy-including-secondary + 'kill-ring-save) :enable mark-active - :help ,(purecopy "Copy text in region between mark and current position") - :keys ,(purecopy (if (featurep 'ns) - "\\[ns-copy-including-secondary]" - "\\[kill-ring-save]")))) - (define-key menu [cut] - `(menu-item ,(purecopy "Cut") kill-region + :help "Copy text in region between mark and current position" + :keys ,(if (featurep 'ns) + "\\[ns-copy-including-secondary]" + "\\[kill-ring-save]"))) + (bindings--define-key menu [cut] + '(menu-item "Cut" kill-region :enable (and mark-active (not buffer-read-only)) :help - ,(purecopy "Cut (kill) text in region between mark and current position"))) + "Cut (kill) text in region between mark and current position")) ;; ns-win.el said: Separate undo from cut/paste section. (if (featurep 'ns) - (define-key menu [separator-undo] menu-bar-separator)) + (bindings--define-key menu [separator-undo] menu-bar-separator)) - (define-key menu [undo] - `(menu-item ,(purecopy "Undo") undo + (bindings--define-key menu [undo] + '(menu-item "Undo" undo :enable (and (not buffer-read-only) (not (eq t buffer-undo-list)) (if (eq last-command 'undo) (listp pending-undo-list) (consp buffer-undo-list))) - :help ,(purecopy "Undo last operation"))) + :help "Undo last operation")) menu)) @@ -598,45 +589,45 @@ Do the same for the keys of the same name." (defvar menu-bar-custom-menu (let ((menu (make-sparse-keymap "Customize"))) - (define-key menu [customize-apropos-faces] - `(menu-item ,(purecopy "Faces Matching...") customize-apropos-faces - :help ,(purecopy "Browse faces matching a regexp or word list"))) - (define-key menu [customize-apropos-options] - `(menu-item ,(purecopy "Options Matching...") customize-apropos-options - :help ,(purecopy "Browse options matching a regexp or word list"))) - (define-key menu [customize-apropos] - `(menu-item ,(purecopy "All Settings Matching...") customize-apropos - :help ,(purecopy "Browse customizable settings matching a regexp or word list"))) - (define-key menu [separator-1] + (bindings--define-key menu [customize-apropos-faces] + '(menu-item "Faces Matching..." customize-apropos-faces + :help "Browse faces matching a regexp or word list")) + (bindings--define-key menu [customize-apropos-options] + '(menu-item "Options Matching..." customize-apropos-options + :help "Browse options matching a regexp or word list")) + (bindings--define-key menu [customize-apropos] + '(menu-item "All Settings Matching..." customize-apropos + :help "Browse customizable settings matching a regexp or word list")) + (bindings--define-key menu [separator-1] menu-bar-separator) - (define-key menu [customize-group] - `(menu-item ,(purecopy "Specific Group...") customize-group - :help ,(purecopy "Customize settings of specific group"))) - (define-key menu [customize-face] - `(menu-item ,(purecopy "Specific Face...") customize-face - :help ,(purecopy "Customize attributes of specific face"))) - (define-key menu [customize-option] - `(menu-item ,(purecopy "Specific Option...") customize-option - :help ,(purecopy "Customize value of specific option"))) - (define-key menu [separator-2] + (bindings--define-key menu [customize-group] + '(menu-item "Specific Group..." customize-group + :help "Customize settings of specific group")) + (bindings--define-key menu [customize-face] + '(menu-item "Specific Face..." customize-face + :help "Customize attributes of specific face")) + (bindings--define-key menu [customize-option] + '(menu-item "Specific Option..." customize-option + :help "Customize value of specific option")) + (bindings--define-key menu [separator-2] menu-bar-separator) - (define-key menu [customize-changed-options] - `(menu-item ,(purecopy "New Options...") customize-changed-options - :help ,(purecopy "Options added or changed in recent Emacs versions"))) - (define-key menu [customize-saved] - `(menu-item ,(purecopy "Saved Options") customize-saved - :help ,(purecopy "Customize previously saved options"))) - (define-key menu [separator-3] + (bindings--define-key menu [customize-changed-options] + '(menu-item "New Options..." customize-changed-options + :help "Options added or changed in recent Emacs versions")) + (bindings--define-key menu [customize-saved] + '(menu-item "Saved Options" customize-saved + :help "Customize previously saved options")) + (bindings--define-key menu [separator-3] menu-bar-separator) - (define-key menu [customize-browse] - `(menu-item ,(purecopy "Browse Customization Groups") customize-browse - :help ,(purecopy "Browse all customization groups"))) - (define-key menu [customize] - `(menu-item ,(purecopy "Top-level Customization Group") customize - :help ,(purecopy "The master group called `Emacs'"))) - (define-key menu [customize-themes] - `(menu-item ,(purecopy "Custom Themes") customize-themes - :help ,(purecopy "Choose a pre-defined customization theme"))) + (bindings--define-key menu [customize-browse] + '(menu-item "Browse Customization Groups" customize-browse + :help "Browse all customization groups")) + (bindings--define-key menu [customize] + '(menu-item "Top-level Customization Group" customize + :help "The master group called `Emacs'")) + (bindings--define-key menu [customize-themes] + '(menu-item "Custom Themes" customize-themes + :help "Choose a pre-defined customization theme")) menu)) ;(defvar menu-bar-preferences-menu (make-sparse-keymap "Preferences")) @@ -646,9 +637,9 @@ FNAME is the minor mode's name (variable and function). DOC is the text to use for the menu entry. HELP is the text to use for the tooltip. PROPS are additional properties." - `(list 'menu-item (purecopy ,doc) ',fname + `(list 'menu-item ,doc ',fname ,@(mapcar (lambda (p) (list 'quote p)) props) - :help (purecopy ,help) + :help ,help :button '(:toggle . (and (default-boundp ',fname) (default-value ',fname))))) @@ -673,8 +664,8 @@ by \"Save Options\" in Custom buffers.") ;; a candidate for "Save Options", and we do not want to save options ;; the user have already set explicitly in his init file. (if interactively (customize-mark-as-set ',variable))) - (list 'menu-item (purecopy ,doc) ',name - :help (purecopy ,help) + (list 'menu-item ,doc ',name + :help ,help :button '(:toggle . (and (default-boundp ',variable) (default-value ',variable)))))) @@ -775,46 +766,46 @@ by \"Save Options\" in Custom buffers.") (defvar menu-bar-showhide-fringe-ind-menu (let ((menu (make-sparse-keymap "Buffer boundaries"))) - (define-key menu [customize] - `(menu-item ,(purecopy "Other (Customize)") + (bindings--define-key menu [customize] + '(menu-item "Other (Customize)" menu-bar-showhide-fringe-ind-customize - :help ,(purecopy "Additional choices available through Custom buffer") + :help "Additional choices available through Custom buffer" :visible (display-graphic-p) :button (:radio . (not (member indicate-buffer-boundaries '(nil left right ((top . left) (bottom . right)) ((t . right) (top . left)))))))) - (define-key menu [mixed] - `(menu-item ,(purecopy "Opposite, Arrows Right") menu-bar-showhide-fringe-ind-mixed + (bindings--define-key menu [mixed] + '(menu-item "Opposite, Arrows Right" menu-bar-showhide-fringe-ind-mixed :help - ,(purecopy "Show top/bottom indicators in opposite fringes, arrows in right") + "Show top/bottom indicators in opposite fringes, arrows in right" :visible (display-graphic-p) :button (:radio . (equal indicate-buffer-boundaries '((t . right) (top . left)))))) - (define-key menu [box] - `(menu-item ,(purecopy "Opposite, No Arrows") menu-bar-showhide-fringe-ind-box - :help ,(purecopy "Show top/bottom indicators in opposite fringes, no arrows") + (bindings--define-key menu [box] + '(menu-item "Opposite, No Arrows" menu-bar-showhide-fringe-ind-box + :help "Show top/bottom indicators in opposite fringes, no arrows" :visible (display-graphic-p) :button (:radio . (equal indicate-buffer-boundaries '((top . left) (bottom . right)))))) - (define-key menu [right] - `(menu-item ,(purecopy "In Right Fringe") menu-bar-showhide-fringe-ind-right - :help ,(purecopy "Show buffer boundaries and arrows in right fringe") + (bindings--define-key menu [right] + '(menu-item "In Right Fringe" menu-bar-showhide-fringe-ind-right + :help "Show buffer boundaries and arrows in right fringe" :visible (display-graphic-p) :button (:radio . (eq indicate-buffer-boundaries 'right)))) - (define-key menu [left] - `(menu-item ,(purecopy "In Left Fringe") menu-bar-showhide-fringe-ind-left - :help ,(purecopy "Show buffer boundaries and arrows in left fringe") + (bindings--define-key menu [left] + '(menu-item "In Left Fringe" menu-bar-showhide-fringe-ind-left + :help "Show buffer boundaries and arrows in left fringe" :visible (display-graphic-p) :button (:radio . (eq indicate-buffer-boundaries 'left)))) - (define-key menu [none] - `(menu-item ,(purecopy "No Indicators") menu-bar-showhide-fringe-ind-none - :help ,(purecopy "Hide all buffer boundary indicators and arrows") + (bindings--define-key menu [none] + '(menu-item "No Indicators" menu-bar-showhide-fringe-ind-none + :help "Hide all buffer boundary indicators and arrows" :visible (display-graphic-p) :button (:radio . (eq indicate-buffer-boundaries nil)))) menu)) @@ -850,43 +841,43 @@ by \"Save Options\" in Custom buffers.") (defvar menu-bar-showhide-fringe-menu (let ((menu (make-sparse-keymap "Fringe"))) - (define-key menu [showhide-fringe-ind] - `(menu-item ,(purecopy "Buffer Boundaries") ,menu-bar-showhide-fringe-ind-menu + (bindings--define-key menu [showhide-fringe-ind] + `(menu-item "Buffer Boundaries" ,menu-bar-showhide-fringe-ind-menu :visible (display-graphic-p) - :help ,(purecopy "Indicate buffer boundaries in fringe"))) + :help "Indicate buffer boundaries in fringe")) - (define-key menu [indicate-empty-lines] + (bindings--define-key menu [indicate-empty-lines] (menu-bar-make-toggle toggle-indicate-empty-lines indicate-empty-lines "Empty Line Indicators" "Indicating of empty lines %s" "Indicate trailing empty lines in fringe, globally")) - (define-key menu [customize] - `(menu-item ,(purecopy "Customize Fringe") menu-bar-showhide-fringe-menu-customize - :help ,(purecopy "Detailed customization of fringe") + (bindings--define-key menu [customize] + '(menu-item "Customize Fringe" menu-bar-showhide-fringe-menu-customize + :help "Detailed customization of fringe" :visible (display-graphic-p))) - (define-key menu [default] - `(menu-item ,(purecopy "Default") menu-bar-showhide-fringe-menu-customize-reset - :help ,(purecopy "Default width fringe on both left and right side") + (bindings--define-key menu [default] + '(menu-item "Default" menu-bar-showhide-fringe-menu-customize-reset + :help "Default width fringe on both left and right side" :visible (display-graphic-p) :button (:radio . (eq fringe-mode nil)))) - (define-key menu [right] - `(menu-item ,(purecopy "On the Right") menu-bar-showhide-fringe-menu-customize-right - :help ,(purecopy "Fringe only on the right side") + (bindings--define-key menu [right] + '(menu-item "On the Right" menu-bar-showhide-fringe-menu-customize-right + :help "Fringe only on the right side" :visible (display-graphic-p) :button (:radio . (equal fringe-mode '(0 . nil))))) - (define-key menu [left] - `(menu-item ,(purecopy "On the Left") menu-bar-showhide-fringe-menu-customize-left - :help ,(purecopy "Fringe only on the left side") + (bindings--define-key menu [left] + '(menu-item "On the Left" menu-bar-showhide-fringe-menu-customize-left + :help "Fringe only on the left side" :visible (display-graphic-p) :button (:radio . (equal fringe-mode '(nil . 0))))) - (define-key menu [none] - `(menu-item ,(purecopy "None") menu-bar-showhide-fringe-menu-customize-disable - :help ,(purecopy "Turn off fringe") + (bindings--define-key menu [none] + '(menu-item "None" menu-bar-showhide-fringe-menu-customize-disable + :help "Turn off fringe" :visible (display-graphic-p) :button (:radio . (eq fringe-mode 0)))) menu)) @@ -909,26 +900,26 @@ by \"Save Options\" in Custom buffers.") (defvar menu-bar-showhide-scroll-bar-menu (let ((menu (make-sparse-keymap "Scroll-bar"))) - (define-key menu [right] - `(menu-item ,(purecopy "On the Right") + (bindings--define-key menu [right] + '(menu-item "On the Right" menu-bar-right-scroll-bar - :help ,(purecopy "Scroll-bar on the right side") + :help "Scroll-bar on the right side" :visible (display-graphic-p) :button (:radio . (eq (cdr (assq 'vertical-scroll-bars (frame-parameters))) 'right)))) - (define-key menu [left] - `(menu-item ,(purecopy "On the Left") + (bindings--define-key menu [left] + '(menu-item "On the Left" menu-bar-left-scroll-bar - :help ,(purecopy "Scroll-bar on the left side") + :help "Scroll-bar on the left side" :visible (display-graphic-p) :button (:radio . (eq (cdr (assq 'vertical-scroll-bars (frame-parameters))) 'left)))) - (define-key menu [none] - `(menu-item ,(purecopy "None") + (bindings--define-key menu [none] + '(menu-item "None" menu-bar-no-scroll-bar - :help ,(purecopy "Turn off scroll-bar") + :help "Turn off scroll-bar" :visible (display-graphic-p) :button (:radio . (eq (cdr (assq 'vertical-scroll-bars (frame-parameters))) nil)))) @@ -973,10 +964,10 @@ by \"Save Options\" in Custom buffers.") (defvar menu-bar-showhide-tool-bar-menu (let ((menu (make-sparse-keymap "Tool-bar"))) - (define-key menu [showhide-tool-bar-left] - `(menu-item ,(purecopy "On the Left") + (bindings--define-key menu [showhide-tool-bar-left] + '(menu-item "On the Left" menu-bar-showhide-tool-bar-menu-customize-enable-left - :help ,(purecopy "Tool-bar at the left side") + :help "Tool-bar at the left side" :visible (display-graphic-p) :button (:radio . (and tool-bar-mode @@ -985,10 +976,10 @@ by \"Save Options\" in Custom buffers.") 'tool-bar-position) 'left))))) - (define-key menu [showhide-tool-bar-right] - `(menu-item ,(purecopy "On the Right") + (bindings--define-key menu [showhide-tool-bar-right] + '(menu-item "On the Right" menu-bar-showhide-tool-bar-menu-customize-enable-right - :help ,(purecopy "Tool-bar at the right side") + :help "Tool-bar at the right side" :visible (display-graphic-p) :button (:radio . (and tool-bar-mode @@ -997,10 +988,10 @@ by \"Save Options\" in Custom buffers.") 'tool-bar-position) 'right))))) - (define-key menu [showhide-tool-bar-bottom] - `(menu-item ,(purecopy "On the Bottom") + (bindings--define-key menu [showhide-tool-bar-bottom] + '(menu-item "On the Bottom" menu-bar-showhide-tool-bar-menu-customize-enable-bottom - :help ,(purecopy "Tool-bar at the bottom") + :help "Tool-bar at the bottom" :visible (display-graphic-p) :button (:radio . (and tool-bar-mode @@ -1009,10 +1000,10 @@ by \"Save Options\" in Custom buffers.") 'tool-bar-position) 'bottom))))) - (define-key menu [showhide-tool-bar-top] - `(menu-item ,(purecopy "On the Top") + (bindings--define-key menu [showhide-tool-bar-top] + '(menu-item "On the Top" menu-bar-showhide-tool-bar-menu-customize-enable-top - :help ,(purecopy "Tool-bar at the top") + :help "Tool-bar at the top" :visible (display-graphic-p) :button (:radio . (and tool-bar-mode @@ -1021,10 +1012,10 @@ by \"Save Options\" in Custom buffers.") 'tool-bar-position) 'top))))) - (define-key menu [showhide-tool-bar-none] - `(menu-item ,(purecopy "None") + (bindings--define-key menu [showhide-tool-bar-none] + '(menu-item "None" menu-bar-showhide-tool-bar-menu-customize-disable - :help ,(purecopy "Turn tool-bar off") + :help "Turn tool-bar off" :visible (display-graphic-p) :button (:radio . (eq tool-bar-mode nil)))) menu))) @@ -1032,64 +1023,64 @@ by \"Save Options\" in Custom buffers.") (defvar menu-bar-showhide-menu (let ((menu (make-sparse-keymap "Show/Hide"))) - (define-key menu [column-number-mode] + (bindings--define-key menu [column-number-mode] (menu-bar-make-mm-toggle column-number-mode "Column Numbers" "Show the current column number in the mode line")) - (define-key menu [line-number-mode] + (bindings--define-key menu [line-number-mode] (menu-bar-make-mm-toggle line-number-mode "Line Numbers" "Show the current line number in the mode line")) - (define-key menu [size-indication-mode] + (bindings--define-key menu [size-indication-mode] (menu-bar-make-mm-toggle size-indication-mode "Size Indication" "Show the size of the buffer in the mode line")) - (define-key menu [linecolumn-separator] + (bindings--define-key menu [linecolumn-separator] menu-bar-separator) - (define-key menu [showhide-battery] + (bindings--define-key menu [showhide-battery] (menu-bar-make-mm-toggle display-battery-mode "Battery Status" "Display battery status information in mode line")) - (define-key menu [showhide-date-time] + (bindings--define-key menu [showhide-date-time] (menu-bar-make-mm-toggle display-time-mode "Time, Load and Mail" "Display time, system load averages and \ mail status in mode line")) - (define-key menu [datetime-separator] + (bindings--define-key menu [datetime-separator] menu-bar-separator) - (define-key menu [showhide-speedbar] - `(menu-item ,(purecopy "Speedbar") speedbar-frame-mode - :help ,(purecopy "Display a Speedbar quick-navigation frame") + (bindings--define-key menu [showhide-speedbar] + '(menu-item "Speedbar" speedbar-frame-mode + :help "Display a Speedbar quick-navigation frame" :button (:toggle . (and (boundp 'speedbar-frame) (frame-live-p (symbol-value 'speedbar-frame)) (frame-visible-p (symbol-value 'speedbar-frame)))))) - (define-key menu [showhide-fringe] - `(menu-item ,(purecopy "Fringe") ,menu-bar-showhide-fringe-menu + (bindings--define-key menu [showhide-fringe] + `(menu-item "Fringe" ,menu-bar-showhide-fringe-menu :visible (display-graphic-p))) - (define-key menu [showhide-scroll-bar] - `(menu-item ,(purecopy "Scroll-bar") ,menu-bar-showhide-scroll-bar-menu + (bindings--define-key menu [showhide-scroll-bar] + `(menu-item "Scroll-bar" ,menu-bar-showhide-scroll-bar-menu :visible (display-graphic-p))) - (define-key menu [showhide-tooltip-mode] - `(menu-item ,(purecopy "Tooltips") tooltip-mode - :help ,(purecopy "Turn tooltips on/off") + (bindings--define-key menu [showhide-tooltip-mode] + '(menu-item "Tooltips" tooltip-mode + :help "Turn tooltips on/off" :visible (and (display-graphic-p) (fboundp 'x-show-tip)) :button (:toggle . tooltip-mode))) - (define-key menu [menu-bar-mode] - `(menu-item ,(purecopy "Menu-bar") toggle-menu-bar-mode-from-frame - :help ,(purecopy "Turn menu-bar on/off") + (bindings--define-key menu [menu-bar-mode] + '(menu-item "Menu-bar" toggle-menu-bar-mode-from-frame + :help "Turn menu-bar on/off" :button (:toggle . (menu-bar-positive-p (frame-parameter (menu-bar-frame-for-menubar) @@ -1097,13 +1088,13 @@ mail status in mode line")) (if (and (boundp 'menu-bar-showhide-tool-bar-menu) (keymapp menu-bar-showhide-tool-bar-menu)) - (define-key menu [showhide-tool-bar] - `(menu-item ,(purecopy "Tool-bar") ,menu-bar-showhide-tool-bar-menu + (bindings--define-key menu [showhide-tool-bar] + `(menu-item "Tool-bar" ,menu-bar-showhide-tool-bar-menu :visible (display-graphic-p))) ;; else not tool bar that can move. - (define-key menu [showhide-tool-bar] - `(menu-item ,(purecopy "Tool-bar") toggle-tool-bar-mode-from-frame - :help ,(purecopy "Turn tool-bar on/off") + (bindings--define-key menu [showhide-tool-bar] + '(menu-item "Tool-bar" toggle-tool-bar-mode-from-frame + :help "Turn tool-bar on/off" :visible (display-graphic-p) :button (:toggle . (menu-bar-positive-p @@ -1123,120 +1114,120 @@ mail status in mode line")) (defvar menu-bar-line-wrapping-menu (let ((menu (make-sparse-keymap "Line Wrapping"))) - (define-key menu [word-wrap] - `(menu-item - ,(purecopy "Word Wrap (Visual Line mode)") - ,(purecopy - (lambda () - (interactive) - (unless visual-line-mode - (visual-line-mode 1)) - (message "Visual-Line mode enabled"))) - :help ,(purecopy "Wrap long lines at word boundaries") - :button (:radio . (and (null truncate-lines) - (not (truncated-partial-width-window-p)) - word-wrap)) - :visible (menu-bar-menu-frame-live-and-visible-p))) - - (define-key menu [truncate] - `(menu-item ,(purecopy "Truncate Long Lines") - (lambda () - (interactive) - (if visual-line-mode (visual-line-mode 0)) - (setq word-wrap nil) - (toggle-truncate-lines 1)) - :help ,(purecopy "Truncate long lines at window edge") + (bindings--define-key menu [word-wrap] + `(menu-item "Word Wrap (Visual Line mode)" + ,(lambda () + (interactive) + (unless visual-line-mode + (visual-line-mode 1)) + (message "Visual-Line mode enabled")) + :help "Wrap long lines at word boundaries" + :button (:radio + . (and (null truncate-lines) + (not (truncated-partial-width-window-p)) + word-wrap)) + :visible (menu-bar-menu-frame-live-and-visible-p))) + + (bindings--define-key menu [truncate] + `(menu-item "Truncate Long Lines" + ,(lambda () + (interactive) + (if visual-line-mode (visual-line-mode 0)) + (setq word-wrap nil) + (toggle-truncate-lines 1)) + :help "Truncate long lines at window edge" :button (:radio . (or truncate-lines (truncated-partial-width-window-p))) :visible (menu-bar-menu-frame-live-and-visible-p) :enable (not (truncated-partial-width-window-p)))) - (define-key menu [window-wrap] - `(menu-item ,(purecopy "Wrap at Window Edge") - (lambda () (interactive) - (if visual-line-mode (visual-line-mode 0)) - (setq word-wrap nil) - (if truncate-lines (toggle-truncate-lines -1))) - :help ,(purecopy "Wrap long lines at window edge") - :button (:radio . (and (null truncate-lines) - (not (truncated-partial-width-window-p)) - (not word-wrap))) + (bindings--define-key menu [window-wrap] + `(menu-item "Wrap at Window Edge" + ,(lambda () (interactive) + (if visual-line-mode (visual-line-mode 0)) + (setq word-wrap nil) + (if truncate-lines (toggle-truncate-lines -1))) + :help "Wrap long lines at window edge" + :button (:radio + . (and (null truncate-lines) + (not (truncated-partial-width-window-p)) + (not word-wrap))) :visible (menu-bar-menu-frame-live-and-visible-p) :enable (not (truncated-partial-width-window-p)))) menu)) (defvar menu-bar-options-menu (let ((menu (make-sparse-keymap "Options"))) - (define-key menu [customize] - `(menu-item ,(purecopy "Customize Emacs") ,menu-bar-custom-menu)) + (bindings--define-key menu [customize] + `(menu-item "Customize Emacs" ,menu-bar-custom-menu)) - (define-key menu [package] + (bindings--define-key menu [package] '(menu-item "Manage Emacs Packages" package-list-packages :help "Install or uninstall additional Emacs packages")) - (define-key menu [save] - `(menu-item ,(purecopy "Save Options") menu-bar-options-save - :help ,(purecopy "Save options set from the menu above"))) + (bindings--define-key menu [save] + '(menu-item "Save Options" menu-bar-options-save + :help "Save options set from the menu above")) - (define-key menu [custom-separator] + (bindings--define-key menu [custom-separator] menu-bar-separator) - (define-key menu [menu-set-font] - `(menu-item ,(purecopy "Set Default Font...") menu-set-font + (bindings--define-key menu [menu-set-font] + '(menu-item "Set Default Font..." menu-set-font :visible (display-multi-font-p) - :help ,(purecopy "Select a default font"))) + :help "Select a default font")) (if (featurep 'system-font-setting) - (define-key menu [menu-system-font] + (bindings--define-key menu [menu-system-font] (menu-bar-make-toggle toggle-use-system-font font-use-system-font "Use System Font" "Use system font: %s" "Use the monospaced font defined by the system"))) - (define-key menu [showhide] - `(menu-item ,(purecopy "Show/Hide") ,menu-bar-showhide-menu)) + (bindings--define-key menu [showhide] + `(menu-item "Show/Hide" ,menu-bar-showhide-menu)) - (define-key menu [showhide-separator] + (bindings--define-key menu [showhide-separator] menu-bar-separator) - (define-key menu [mule] + (bindings--define-key menu [mule] ;; It is better not to use backquote here, ;; because that makes a bootstrapping problem ;; if you need to recompile all the Lisp files using interpreted code. - `(menu-item ,(purecopy "Multilingual Environment") ,mule-menu-keymap + `(menu-item "Multilingual Environment" ,mule-menu-keymap ;; Most of the MULE menu actually does make sense in ;; unibyte mode, e.g. language selection. ;; :visible '(default-value 'enable-multibyte-characters) )) ;;(setq menu-bar-final-items (cons 'mule menu-bar-final-items)) - ;;(define-key menu [preferences] - ;; `(menu-item ,(purecopy "Preferences") ,menu-bar-preferences-menu - ;; :help ,(purecopy "Toggle important global options"))) + ;;(bindings--define-key menu [preferences] + ;; `(menu-item "Preferences" ,menu-bar-preferences-menu + ;; :help "Toggle important global options")) - (define-key menu [mule-separator] + (bindings--define-key menu [mule-separator] menu-bar-separator) - (define-key menu [debug-on-quit] + (bindings--define-key menu [debug-on-quit] (menu-bar-make-toggle toggle-debug-on-quit debug-on-quit "Enter Debugger on Quit/C-g" "Debug on Quit %s" "Enter Lisp debugger when C-g is pressed")) - (define-key menu [debug-on-error] + (bindings--define-key menu [debug-on-error] (menu-bar-make-toggle toggle-debug-on-error debug-on-error "Enter Debugger on Error" "Debug on Error %s" "Enter Lisp debugger when an error is signaled")) - (define-key menu [debugger-separator] + (bindings--define-key menu [debugger-separator] menu-bar-separator) - (define-key menu [blink-cursor-mode] + (bindings--define-key menu [blink-cursor-mode] (menu-bar-make-mm-toggle blink-cursor-mode "Blink Cursor" "Whether the cursor blinks (Blink Cursor mode)")) - (define-key menu [cursor-separator] + (bindings--define-key menu [cursor-separator] menu-bar-separator) - (define-key menu [save-place] + (bindings--define-key menu [save-place] (menu-bar-make-toggle toggle-save-place-globally save-place "Save Place in Files between Sessions" @@ -1248,7 +1239,7 @@ mail status in mode line")) (set-default 'save-place (not (symbol-value 'save-place))))) - (define-key menu [uniquify] + (bindings--define-key menu [uniquify] (menu-bar-make-toggle toggle-uniquify-buffer-names uniquify-buffer-name-style "Use Directory Names in Buffer Names" @@ -1259,9 +1250,9 @@ mail status in mode line")) (if (not uniquify-buffer-name-style) 'forward)))) - (define-key menu [edit-options-separator] + (bindings--define-key menu [edit-options-separator] menu-bar-separator) - (define-key menu [cua-mode] + (bindings--define-key menu [cua-mode] (menu-bar-make-mm-toggle cua-mode "Use CUA Keys (Cut/Paste with C-x/C-c/C-v)" @@ -1269,7 +1260,7 @@ mail status in mode line")) (:visible (or (not (boundp 'cua-enable-cua-keys)) cua-enable-cua-keys)))) - (define-key menu [cua-emulation-mode] + (bindings--define-key menu [cua-emulation-mode] (menu-bar-make-mm-toggle cua-mode "Shift movement mark region (CUA)" @@ -1277,35 +1268,35 @@ mail status in mode line")) (:visible (and (boundp 'cua-enable-cua-keys) (not cua-enable-cua-keys))))) - (define-key menu [case-fold-search] + (bindings--define-key menu [case-fold-search] (menu-bar-make-toggle toggle-case-fold-search case-fold-search "Ignore Case for Search" "Case-Insensitive Search %s" "Ignore letter-case in search commands")) - (define-key menu [auto-fill-mode] - `(menu-item - ,(purecopy "Auto Fill in Text Modes") + (bindings--define-key menu [auto-fill-mode] + '(menu-item + "Auto Fill in Text Modes" menu-bar-text-mode-auto-fill - :help ,(purecopy "Automatically fill text while typing (Auto Fill mode)") + :help "Automatically fill text while typing (Auto Fill mode)" :button (:toggle . (if (listp text-mode-hook) (member 'turn-on-auto-fill text-mode-hook) (eq 'turn-on-auto-fill text-mode-hook))))) - (define-key menu [line-wrapping] - `(menu-item ,(purecopy "Line Wrapping in This Buffer") + (bindings--define-key menu [line-wrapping] + `(menu-item "Line Wrapping in This Buffer" ,menu-bar-line-wrapping-menu)) - (define-key menu [highlight-separator] + (bindings--define-key menu [highlight-separator] menu-bar-separator) - (define-key menu [highlight-paren-mode] + (bindings--define-key menu [highlight-paren-mode] (menu-bar-make-mm-toggle show-paren-mode "Highlight Matching Parentheses" "Highlight matching/mismatched parentheses at cursor (Show Paren mode)")) - (define-key menu [transient-mark-mode] + (bindings--define-key menu [transient-mark-mode] (menu-bar-make-mm-toggle transient-mark-mode "Highlight Active Region" @@ -1339,109 +1330,109 @@ mail status in mode line")) (defvar menu-bar-games-menu (let ((menu (make-sparse-keymap "Games"))) - (define-key menu [zone] - `(menu-item ,(purecopy "Zone Out") zone - :help ,(purecopy "Play tricks with Emacs display when Emacs is idle"))) - (define-key menu [tetris] - `(menu-item ,(purecopy "Tetris") tetris - :help ,(purecopy "Falling blocks game"))) - (define-key menu [solitaire] - `(menu-item ,(purecopy "Solitaire") solitaire - :help ,(purecopy "Get rid of all the stones"))) - (define-key menu [snake] - `(menu-item ,(purecopy "Snake") snake - :help ,(purecopy "Move snake around avoiding collisions"))) - (define-key menu [pong] - `(menu-item ,(purecopy "Pong") pong - :help ,(purecopy "Bounce the ball to your opponent"))) - (define-key menu [mult] - `(menu-item ,(purecopy "Multiplication Puzzle") mpuz - :help ,(purecopy "Exercise brain with multiplication"))) - (define-key menu [life] - `(menu-item ,(purecopy "Life") life - :help ,(purecopy "Watch how John Conway's cellular automaton evolves"))) - (define-key menu [land] - `(menu-item ,(purecopy "Landmark") landmark - :help ,(purecopy "Watch a neural-network robot learn landmarks"))) - (define-key menu [hanoi] - `(menu-item ,(purecopy "Towers of Hanoi") hanoi - :help ,(purecopy "Watch Towers-of-Hanoi puzzle solved by Emacs"))) - (define-key menu [gomoku] - `(menu-item ,(purecopy "Gomoku") gomoku - :help ,(purecopy "Mark 5 contiguous squares (like tic-tac-toe)"))) - (define-key menu [bubbles] - `(menu-item ,(purecopy "Bubbles") bubbles - :help ,(purecopy "Remove all bubbles using the fewest moves"))) - (define-key menu [black-box] - `(menu-item ,(purecopy "Blackbox") blackbox - :help ,(purecopy "Find balls in a black box by shooting rays"))) - (define-key menu [adventure] - `(menu-item ,(purecopy "Adventure") dunnet - :help ,(purecopy "Dunnet, a text Adventure game for Emacs"))) - (define-key menu [5x5] - `(menu-item ,(purecopy "5x5") 5x5 - :help ,(purecopy "Fill in all the squares on a 5x5 board"))) + (bindings--define-key menu [zone] + '(menu-item "Zone Out" zone + :help "Play tricks with Emacs display when Emacs is idle")) + (bindings--define-key menu [tetris] + '(menu-item "Tetris" tetris + :help "Falling blocks game")) + (bindings--define-key menu [solitaire] + '(menu-item "Solitaire" solitaire + :help "Get rid of all the stones")) + (bindings--define-key menu [snake] + '(menu-item "Snake" snake + :help "Move snake around avoiding collisions")) + (bindings--define-key menu [pong] + '(menu-item "Pong" pong + :help "Bounce the ball to your opponent")) + (bindings--define-key menu [mult] + '(menu-item "Multiplication Puzzle" mpuz + :help "Exercise brain with multiplication")) + (bindings--define-key menu [life] + '(menu-item "Life" life + :help "Watch how John Conway's cellular automaton evolves")) + (bindings--define-key menu [land] + '(menu-item "Landmark" landmark + :help "Watch a neural-network robot learn landmarks")) + (bindings--define-key menu [hanoi] + '(menu-item "Towers of Hanoi" hanoi + :help "Watch Towers-of-Hanoi puzzle solved by Emacs")) + (bindings--define-key menu [gomoku] + '(menu-item "Gomoku" gomoku + :help "Mark 5 contiguous squares (like tic-tac-toe)")) + (bindings--define-key menu [bubbles] + '(menu-item "Bubbles" bubbles + :help "Remove all bubbles using the fewest moves")) + (bindings--define-key menu [black-box] + '(menu-item "Blackbox" blackbox + :help "Find balls in a black box by shooting rays")) + (bindings--define-key menu [adventure] + '(menu-item "Adventure" dunnet + :help "Dunnet, a text Adventure game for Emacs")) + (bindings--define-key menu [5x5] + '(menu-item "5x5" 5x5 + :help "Fill in all the squares on a 5x5 board")) menu)) (defvar menu-bar-encryption-decryption-menu (let ((menu (make-sparse-keymap "Encryption/Decryption"))) - (define-key menu [insert-keys] - `(menu-item ,(purecopy "Insert Keys") epa-insert-keys - :help ,(purecopy "Insert public keys after the current point"))) + (bindings--define-key menu [insert-keys] + '(menu-item "Insert Keys" epa-insert-keys + :help "Insert public keys after the current point")) - (define-key menu [export-keys] - `(menu-item ,(purecopy "Export Keys") epa-export-keys - :help ,(purecopy "Export public keys to a file"))) + (bindings--define-key menu [export-keys] + '(menu-item "Export Keys" epa-export-keys + :help "Export public keys to a file")) - (define-key menu [import-keys-region] - `(menu-item ,(purecopy "Import Keys from Region") epa-import-keys-region - :help ,(purecopy "Import public keys from the current region"))) + (bindings--define-key menu [import-keys-region] + '(menu-item "Import Keys from Region" epa-import-keys-region + :help "Import public keys from the current region")) - (define-key menu [import-keys] - `(menu-item ,(purecopy "Import Keys from File...") epa-import-keys - :help ,(purecopy "Import public keys from a file"))) + (bindings--define-key menu [import-keys] + '(menu-item "Import Keys from File..." epa-import-keys + :help "Import public keys from a file")) - (define-key menu [list-keys] - `(menu-item ,(purecopy "List Keys") epa-list-keys - :help ,(purecopy "Browse your public keyring"))) + (bindings--define-key menu [list-keys] + '(menu-item "List Keys" epa-list-keys + :help "Browse your public keyring")) - (define-key menu [separator-keys] + (bindings--define-key menu [separator-keys] menu-bar-separator) - (define-key menu [sign-region] - `(menu-item ,(purecopy "Sign Region") epa-sign-region - :help ,(purecopy "Create digital signature of the current region"))) + (bindings--define-key menu [sign-region] + '(menu-item "Sign Region" epa-sign-region + :help "Create digital signature of the current region")) - (define-key menu [verify-region] - `(menu-item ,(purecopy "Verify Region") epa-verify-region - :help ,(purecopy "Verify digital signature of the current region"))) + (bindings--define-key menu [verify-region] + '(menu-item "Verify Region" epa-verify-region + :help "Verify digital signature of the current region")) - (define-key menu [encrypt-region] - `(menu-item ,(purecopy "Encrypt Region") epa-encrypt-region - :help ,(purecopy "Encrypt the current region"))) + (bindings--define-key menu [encrypt-region] + '(menu-item "Encrypt Region" epa-encrypt-region + :help "Encrypt the current region")) - (define-key menu [decrypt-region] - `(menu-item ,(purecopy "Decrypt Region") epa-decrypt-region - :help ,(purecopy "Decrypt the current region"))) + (bindings--define-key menu [decrypt-region] + '(menu-item "Decrypt Region" epa-decrypt-region + :help "Decrypt the current region")) - (define-key menu [separator-file] + (bindings--define-key menu [separator-file] menu-bar-separator) - (define-key menu [sign-file] - `(menu-item ,(purecopy "Sign File...") epa-sign-file - :help ,(purecopy "Create digital signature of a file"))) + (bindings--define-key menu [sign-file] + '(menu-item "Sign File..." epa-sign-file + :help "Create digital signature of a file")) - (define-key menu [verify-file] - `(menu-item ,(purecopy "Verify File...") epa-verify-file - :help ,(purecopy "Verify digital signature of a file"))) + (bindings--define-key menu [verify-file] + '(menu-item "Verify File..." epa-verify-file + :help "Verify digital signature of a file")) - (define-key menu [encrypt-file] - `(menu-item ,(purecopy "Encrypt File...") epa-encrypt-file - :help ,(purecopy "Encrypt a file"))) + (bindings--define-key menu [encrypt-file] + '(menu-item "Encrypt File..." epa-encrypt-file + :help "Encrypt a file")) - (define-key menu [decrypt-file] - `(menu-item ,(purecopy "Decrypt File...") epa-decrypt-file - :help ,(purecopy "Decrypt a file"))) + (bindings--define-key menu [decrypt-file] + '(menu-item "Decrypt File..." epa-decrypt-file + :help "Decrypt a file")) menu)) @@ -1453,102 +1444,103 @@ mail status in mode line")) (defvar menu-bar-tools-menu (let ((menu (make-sparse-keymap "Tools"))) - (define-key menu [games] - `(menu-item ,(purecopy "Games") ,menu-bar-games-menu)) + (bindings--define-key menu [games] + `(menu-item "Games" ,menu-bar-games-menu)) - (define-key menu [separator-games] + (bindings--define-key menu [separator-games] menu-bar-separator) - (define-key menu [encryption-decryption] - `(menu-item ,(purecopy "Encryption/Decryption") ,menu-bar-encryption-decryption-menu)) + (bindings--define-key menu [encryption-decryption] + `(menu-item "Encryption/Decryption" + ,menu-bar-encryption-decryption-menu)) - (define-key menu [separator-encryption-decryption] + (bindings--define-key menu [separator-encryption-decryption] menu-bar-separator) - (define-key menu [simple-calculator] - `(menu-item ,(purecopy "Simple Calculator") calculator - :help ,(purecopy "Invoke the Emacs built-in quick calculator"))) - (define-key menu [calc] - `(menu-item ,(purecopy "Programmable Calculator") calc - :help ,(purecopy "Invoke the Emacs built-in full scientific calculator"))) - (define-key menu [calendar] - `(menu-item ,(purecopy "Calendar") calendar - :help ,(purecopy "Invoke the Emacs built-in calendar"))) - - (define-key menu [separator-net] + (bindings--define-key menu [simple-calculator] + '(menu-item "Simple Calculator" calculator + :help "Invoke the Emacs built-in quick calculator")) + (bindings--define-key menu [calc] + '(menu-item "Programmable Calculator" calc + :help "Invoke the Emacs built-in full scientific calculator")) + (bindings--define-key menu [calendar] + '(menu-item "Calendar" calendar + :help "Invoke the Emacs built-in calendar")) + + (bindings--define-key menu [separator-net] menu-bar-separator) - (define-key menu [directory-search] - `(menu-item ,(purecopy "Directory Search") eudc-tools-menu)) - (define-key menu [compose-mail] - `(menu-item (format "Send Mail (with %s)" (send-mail-item-name)) compose-mail + (bindings--define-key menu [directory-search] + '(menu-item "Directory Search" eudc-tools-menu)) + (bindings--define-key menu [compose-mail] + '(menu-item (format "Send Mail (with %s)" (send-mail-item-name)) compose-mail :visible (and mail-user-agent (not (eq mail-user-agent 'ignore))) - :help ,(purecopy "Send a mail message"))) - (define-key menu [rmail] - `(menu-item (format "Read Mail (with %s)" (read-mail-item-name)) + :help "Send a mail message")) + (bindings--define-key menu [rmail] + '(menu-item (format "Read Mail (with %s)" (read-mail-item-name)) menu-bar-read-mail :visible (and read-mail-command (not (eq read-mail-command 'ignore))) - :help ,(purecopy "Read your mail and reply to it"))) + :help "Read your mail and reply to it")) - (define-key menu [gnus] - `(menu-item ,(purecopy "Read Net News (Gnus)") gnus - :help ,(purecopy "Read network news groups"))) + (bindings--define-key menu [gnus] + '(menu-item "Read Net News (Gnus)" gnus + :help "Read network news groups")) - (define-key menu [separator-vc] + (bindings--define-key menu [separator-vc] menu-bar-separator) - (define-key menu [pcl-cvs] - `(menu-item ,(purecopy "PCL-CVS") cvs-global-menu)) - (define-key menu [vc] nil) ;Create the place for the VC menu. + (bindings--define-key menu [pcl-cvs] + '(menu-item "PCL-CVS" cvs-global-menu)) + (bindings--define-key menu [vc] nil) ;Create the place for the VC menu. - (define-key menu [separator-compare] + (bindings--define-key menu [separator-compare] menu-bar-separator) - (define-key menu [epatch] - `(menu-item ,(purecopy "Apply Patch") menu-bar-epatch-menu)) - (define-key menu [ediff-merge] - `(menu-item ,(purecopy "Merge") menu-bar-ediff-merge-menu)) - (define-key menu [compare] - `(menu-item ,(purecopy "Compare (Ediff)") menu-bar-ediff-menu)) + (bindings--define-key menu [epatch] + '(menu-item "Apply Patch" menu-bar-epatch-menu)) + (bindings--define-key menu [ediff-merge] + '(menu-item "Merge" menu-bar-ediff-merge-menu)) + (bindings--define-key menu [compare] + '(menu-item "Compare (Ediff)" menu-bar-ediff-menu)) - (define-key menu [separator-spell] + (bindings--define-key menu [separator-spell] menu-bar-separator) - (define-key menu [spell] - `(menu-item ,(purecopy "Spell Checking") ispell-menu-map)) + (bindings--define-key menu [spell] + '(menu-item "Spell Checking" ispell-menu-map)) - (define-key menu [separator-prog] + (bindings--define-key menu [separator-prog] menu-bar-separator) - (define-key menu [semantic] - `(menu-item ,(purecopy "Source Code Parsers (Semantic)") + (bindings--define-key menu [semantic] + '(menu-item "Source Code Parsers (Semantic)" semantic-mode - :help ,(purecopy "Toggle automatic parsing in source code buffers (Semantic mode)") + :help "Toggle automatic parsing in source code buffers (Semantic mode)" :button (:toggle . (bound-and-true-p semantic-mode)))) - (define-key menu [ede] - `(menu-item ,(purecopy "Project support (EDE)") + (bindings--define-key menu [ede] + '(menu-item "Project support (EDE)" global-ede-mode - :help ,(purecopy "Toggle the Emacs Development Environment (Global EDE mode)") + :help "Toggle the Emacs Development Environment (Global EDE mode)" :button (:toggle . (bound-and-true-p global-ede-mode)))) - (define-key menu [gdb] - `(menu-item ,(purecopy "Debugger (GDB)...") gdb - :help ,(purecopy "Debug a program from within Emacs with GDB"))) - (define-key menu [shell-on-region] - `(menu-item ,(purecopy "Shell Command on Region...") shell-command-on-region + (bindings--define-key menu [gdb] + '(menu-item "Debugger (GDB)..." gdb + :help "Debug a program from within Emacs with GDB")) + (bindings--define-key menu [shell-on-region] + '(menu-item "Shell Command on Region..." shell-command-on-region :enable mark-active - :help ,(purecopy "Pass marked region to a shell command"))) - (define-key menu [shell] - `(menu-item ,(purecopy "Shell Command...") shell-command - :help ,(purecopy "Invoke a shell command and catch its output"))) - (define-key menu [compile] - `(menu-item ,(purecopy "Compile...") compile - :help ,(purecopy "Invoke compiler or Make, view compilation errors"))) - (define-key menu [grep] - `(menu-item ,(purecopy "Search Files (Grep)...") grep - :help ,(purecopy "Search files for strings or regexps (with Grep)"))) + :help "Pass marked region to a shell command")) + (bindings--define-key menu [shell] + '(menu-item "Shell Command..." shell-command + :help "Invoke a shell command and catch its output")) + (bindings--define-key menu [compile] + '(menu-item "Compile..." compile + :help "Invoke compiler or Make, view compilation errors")) + (bindings--define-key menu [grep] + '(menu-item "Search Files (Grep)..." grep + :help "Search files for strings or regexps (with Grep)")) menu)) ;; The "Help" menu items @@ -1556,54 +1548,54 @@ mail status in mode line")) (defvar menu-bar-describe-menu (let ((menu (make-sparse-keymap "Describe"))) - (define-key menu [mule-diag] - `(menu-item ,(purecopy "Show All of Mule Status") mule-diag + (bindings--define-key menu [mule-diag] + '(menu-item "Show All of Mule Status" mule-diag :visible (default-value 'enable-multibyte-characters) - :help ,(purecopy "Display multilingual environment settings"))) - (define-key menu [describe-coding-system-briefly] - `(menu-item ,(purecopy "Describe Coding System (Briefly)") + :help "Display multilingual environment settings")) + (bindings--define-key menu [describe-coding-system-briefly] + '(menu-item "Describe Coding System (Briefly)" describe-current-coding-system-briefly :visible (default-value 'enable-multibyte-characters))) - (define-key menu [describe-coding-system] - `(menu-item ,(purecopy "Describe Coding System...") describe-coding-system + (bindings--define-key menu [describe-coding-system] + '(menu-item "Describe Coding System..." describe-coding-system :visible (default-value 'enable-multibyte-characters))) - (define-key menu [describe-input-method] - `(menu-item ,(purecopy "Describe Input Method...") describe-input-method + (bindings--define-key menu [describe-input-method] + '(menu-item "Describe Input Method..." describe-input-method :visible (default-value 'enable-multibyte-characters) - :help ,(purecopy "Keyboard layout for specific input method"))) - (define-key menu [describe-language-environment] - `(menu-item ,(purecopy "Describe Language Environment") + :help "Keyboard layout for specific input method")) + (bindings--define-key menu [describe-language-environment] + `(menu-item "Describe Language Environment" ,describe-language-environment-map)) - (define-key menu [separator-desc-mule] + (bindings--define-key menu [separator-desc-mule] menu-bar-separator) - (define-key menu [list-keybindings] - `(menu-item ,(purecopy "List Key Bindings") describe-bindings - :help ,(purecopy "Display all current key bindings (keyboard shortcuts)"))) - (define-key menu [describe-current-display-table] - `(menu-item ,(purecopy "Describe Display Table") describe-current-display-table - :help ,(purecopy "Describe the current display table"))) - (define-key menu [describe-package] - `(menu-item ,(purecopy "Describe Package...") describe-package - :help ,(purecopy "Display documentation of a Lisp package"))) - (define-key menu [describe-face] - `(menu-item ,(purecopy "Describe Face...") describe-face - :help ,(purecopy "Display the properties of a face"))) - (define-key menu [describe-variable] - `(menu-item ,(purecopy "Describe Variable...") describe-variable - :help ,(purecopy "Display documentation of variable/option"))) - (define-key menu [describe-function] - `(menu-item ,(purecopy "Describe Function...") describe-function - :help ,(purecopy "Display documentation of function/command"))) - (define-key menu [describe-key-1] - `(menu-item ,(purecopy "Describe Key or Mouse Operation...") describe-key + (bindings--define-key menu [list-keybindings] + '(menu-item "List Key Bindings" describe-bindings + :help "Display all current key bindings (keyboard shortcuts)")) + (bindings--define-key menu [describe-current-display-table] + '(menu-item "Describe Display Table" describe-current-display-table + :help "Describe the current display table")) + (bindings--define-key menu [describe-package] + '(menu-item "Describe Package..." describe-package + :help "Display documentation of a Lisp package")) + (bindings--define-key menu [describe-face] + '(menu-item "Describe Face..." describe-face + :help "Display the properties of a face")) + (bindings--define-key menu [describe-variable] + '(menu-item "Describe Variable..." describe-variable + :help "Display documentation of variable/option")) + (bindings--define-key menu [describe-function] + '(menu-item "Describe Function..." describe-function + :help "Display documentation of function/command")) + (bindings--define-key menu [describe-key-1] + '(menu-item "Describe Key or Mouse Operation..." describe-key ;; Users typically don't identify keys and menu items... - :help ,(purecopy "Display documentation of command bound to a \ -key, a click, or a menu-item"))) - (define-key menu [describe-mode] - `(menu-item ,(purecopy "Describe Buffer Modes") describe-mode - :help ,(purecopy "Describe this buffer's major and minor mode"))) + :help "Display documentation of command bound to a \ +key, a click, or a menu-item")) + (bindings--define-key menu [describe-mode] + '(menu-item "Describe Buffer Modes" describe-mode + :help "Describe this buffer's major and minor mode")) menu)) (defun menu-bar-read-lispref () @@ -1636,64 +1628,64 @@ key, a click, or a menu-item"))) (defvar menu-bar-search-documentation-menu (let ((menu (make-sparse-keymap "Search Documentation"))) - (define-key menu [search-documentation-strings] - `(menu-item ,(purecopy "Search Documentation Strings...") apropos-documentation + (bindings--define-key menu [search-documentation-strings] + '(menu-item "Search Documentation Strings..." apropos-documentation :help - ,(purecopy "Find functions and variables whose doc strings match a regexp"))) - (define-key menu [find-any-object-by-name] - `(menu-item ,(purecopy "Find Any Object by Name...") apropos - :help ,(purecopy "Find symbols of any kind whose names match a regexp"))) - (define-key menu [find-option-by-value] - `(menu-item ,(purecopy "Find Options by Value...") apropos-value - :help ,(purecopy "Find variables whose values match a regexp"))) - (define-key menu [find-options-by-name] - `(menu-item ,(purecopy "Find Options by Name...") apropos-variable - :help ,(purecopy "Find variables whose names match a regexp"))) - (define-key menu [find-commands-by-name] - `(menu-item ,(purecopy "Find Commands by Name...") apropos-command - :help ,(purecopy "Find commands whose names match a regexp"))) - (define-key menu [sep1] + "Find functions and variables whose doc strings match a regexp")) + (bindings--define-key menu [find-any-object-by-name] + '(menu-item "Find Any Object by Name..." apropos + :help "Find symbols of any kind whose names match a regexp")) + (bindings--define-key menu [find-option-by-value] + '(menu-item "Find Options by Value..." apropos-value + :help "Find variables whose values match a regexp")) + (bindings--define-key menu [find-options-by-name] + '(menu-item "Find Options by Name..." apropos-variable + :help "Find variables whose names match a regexp")) + (bindings--define-key menu [find-commands-by-name] + '(menu-item "Find Commands by Name..." apropos-command + :help "Find commands whose names match a regexp")) + (bindings--define-key menu [sep1] menu-bar-separator) - (define-key menu [lookup-command-in-manual] - `(menu-item ,(purecopy "Look Up Command in User Manual...") Info-goto-emacs-command-node - :help ,(purecopy "Display manual section that describes a command"))) - (define-key menu [lookup-key-in-manual] - `(menu-item ,(purecopy "Look Up Key in User Manual...") Info-goto-emacs-key-command-node - :help ,(purecopy "Display manual section that describes a key"))) - (define-key menu [lookup-subject-in-elisp-manual] - `(menu-item ,(purecopy "Look Up Subject in ELisp Manual...") elisp-index-search - :help ,(purecopy "Find description of a subject in Emacs Lisp manual"))) - (define-key menu [lookup-subject-in-emacs-manual] - `(menu-item ,(purecopy "Look Up Subject in User Manual...") emacs-index-search - :help ,(purecopy "Find description of a subject in Emacs User manual"))) - (define-key menu [emacs-terminology] - `(menu-item ,(purecopy "Emacs Terminology") search-emacs-glossary - :help ,(purecopy "Display the Glossary section of the Emacs manual"))) + (bindings--define-key menu [lookup-command-in-manual] + '(menu-item "Look Up Command in User Manual..." Info-goto-emacs-command-node + :help "Display manual section that describes a command")) + (bindings--define-key menu [lookup-key-in-manual] + '(menu-item "Look Up Key in User Manual..." Info-goto-emacs-key-command-node + :help "Display manual section that describes a key")) + (bindings--define-key menu [lookup-subject-in-elisp-manual] + '(menu-item "Look Up Subject in ELisp Manual..." elisp-index-search + :help "Find description of a subject in Emacs Lisp manual")) + (bindings--define-key menu [lookup-subject-in-emacs-manual] + '(menu-item "Look Up Subject in User Manual..." emacs-index-search + :help "Find description of a subject in Emacs User manual")) + (bindings--define-key menu [emacs-terminology] + '(menu-item "Emacs Terminology" search-emacs-glossary + :help "Display the Glossary section of the Emacs manual")) menu)) (defvar menu-bar-manuals-menu (let ((menu (make-sparse-keymap "More Manuals"))) - (define-key menu [man] - `(menu-item ,(purecopy "Read Man Page...") manual-entry - :help ,(purecopy "Man-page docs for external commands and libraries"))) - (define-key menu [sep2] + (bindings--define-key menu [man] + '(menu-item "Read Man Page..." manual-entry + :help "Man-page docs for external commands and libraries")) + (bindings--define-key menu [sep2] menu-bar-separator) - (define-key menu [order-emacs-manuals] - `(menu-item ,(purecopy "Ordering Manuals") view-order-manuals - :help ,(purecopy "How to order manuals from the Free Software Foundation"))) - (define-key menu [lookup-subject-in-all-manuals] - `(menu-item ,(purecopy "Lookup Subject in all Manuals...") info-apropos - :help ,(purecopy "Find description of a subject in all installed manuals"))) - (define-key menu [other-manuals] - `(menu-item ,(purecopy "All Other Manuals (Info)") Info-directory - :help ,(purecopy "Read any of the installed manuals"))) - (define-key menu [emacs-lisp-reference] - `(menu-item ,(purecopy "Emacs Lisp Reference") menu-bar-read-lispref - :help ,(purecopy "Read the Emacs Lisp Reference manual"))) - (define-key menu [emacs-lisp-intro] - `(menu-item ,(purecopy "Introduction to Emacs Lisp") menu-bar-read-lispintro - :help ,(purecopy "Read the Introduction to Emacs Lisp Programming"))) + (bindings--define-key menu [order-emacs-manuals] + '(menu-item "Ordering Manuals" view-order-manuals + :help "How to order manuals from the Free Software Foundation")) + (bindings--define-key menu [lookup-subject-in-all-manuals] + '(menu-item "Lookup Subject in all Manuals..." info-apropos + :help "Find description of a subject in all installed manuals")) + (bindings--define-key menu [other-manuals] + '(menu-item "All Other Manuals (Info)" Info-directory + :help "Read any of the installed manuals")) + (bindings--define-key menu [emacs-lisp-reference] + '(menu-item "Emacs Lisp Reference" menu-bar-read-lispref + :help "Read the Emacs Lisp Reference manual")) + (bindings--define-key menu [emacs-lisp-intro] + '(menu-item "Introduction to Emacs Lisp" menu-bar-read-lispintro + :help "Read the Introduction to Emacs Lisp Programming")) menu)) (defun menu-bar-help-extra-packages () @@ -1711,94 +1703,94 @@ key, a click, or a menu-item"))) (defvar menu-bar-help-menu (let ((menu (make-sparse-keymap "Help"))) - (define-key menu [about-gnu-project] - `(menu-item ,(purecopy "About GNU") describe-gnu-project - :help ,(purecopy "About the GNU System, GNU Project, and GNU/Linux"))) - (define-key menu [about-emacs] - `(menu-item ,(purecopy "About Emacs") about-emacs - :help ,(purecopy "Display version number, copyright info, and basic help"))) - (define-key menu [sep4] + (bindings--define-key menu [about-gnu-project] + '(menu-item "About GNU" describe-gnu-project + :help "About the GNU System, GNU Project, and GNU/Linux")) + (bindings--define-key menu [about-emacs] + '(menu-item "About Emacs" about-emacs + :help "Display version number, copyright info, and basic help")) + (bindings--define-key menu [sep4] menu-bar-separator) - (define-key menu [describe-no-warranty] - `(menu-item ,(purecopy "(Non)Warranty") describe-no-warranty - :help ,(purecopy "Explain that Emacs has NO WARRANTY"))) - (define-key menu [describe-copying] - `(menu-item ,(purecopy "Copying Conditions") describe-copying - :help ,(purecopy "Show the Emacs license (GPL)"))) - (define-key menu [getting-new-versions] - `(menu-item ,(purecopy "Getting New Versions") describe-distribution - :help ,(purecopy "How to get the latest version of Emacs"))) - (define-key menu [sep2] + (bindings--define-key menu [describe-no-warranty] + '(menu-item "(Non)Warranty" describe-no-warranty + :help "Explain that Emacs has NO WARRANTY")) + (bindings--define-key menu [describe-copying] + '(menu-item "Copying Conditions" describe-copying + :help "Show the Emacs license (GPL)")) + (bindings--define-key menu [getting-new-versions] + '(menu-item "Getting New Versions" describe-distribution + :help "How to get the latest version of Emacs")) + (bindings--define-key menu [sep2] menu-bar-separator) - (define-key menu [external-packages] - `(menu-item ,(purecopy "Finding Extra Packages") menu-bar-help-extra-packages - :help ,(purecopy "Lisp packages distributed separately for use in Emacs"))) - (define-key menu [find-emacs-packages] - `(menu-item ,(purecopy "Search Built-in Packages") finder-by-keyword - :help ,(purecopy "Find built-in packages and features by keyword"))) - (define-key menu [more-manuals] - `(menu-item ,(purecopy "More Manuals") ,menu-bar-manuals-menu)) - (define-key menu [emacs-manual] - `(menu-item ,(purecopy "Read the Emacs Manual") info-emacs-manual - :help ,(purecopy "Full documentation of Emacs features"))) - (define-key menu [describe] - `(menu-item ,(purecopy "Describe") ,menu-bar-describe-menu)) - (define-key menu [search-documentation] - `(menu-item ,(purecopy "Search Documentation") ,menu-bar-search-documentation-menu)) - (define-key menu [sep1] + (bindings--define-key menu [external-packages] + '(menu-item "Finding Extra Packages" menu-bar-help-extra-packages + :help "Lisp packages distributed separately for use in Emacs")) + (bindings--define-key menu [find-emacs-packages] + '(menu-item "Search Built-in Packages" finder-by-keyword + :help "Find built-in packages and features by keyword")) + (bindings--define-key menu [more-manuals] + `(menu-item "More Manuals" ,menu-bar-manuals-menu)) + (bindings--define-key menu [emacs-manual] + '(menu-item "Read the Emacs Manual" info-emacs-manual + :help "Full documentation of Emacs features")) + (bindings--define-key menu [describe] + `(menu-item "Describe" ,menu-bar-describe-menu)) + (bindings--define-key menu [search-documentation] + `(menu-item "Search Documentation" ,menu-bar-search-documentation-menu)) + (bindings--define-key menu [sep1] menu-bar-separator) - (define-key menu [emacs-psychotherapist] - `(menu-item ,(purecopy "Emacs Psychotherapist") doctor - :help ,(purecopy "Our doctor will help you feel better"))) - (define-key menu [send-emacs-bug-report] - `(menu-item ,(purecopy "Send Bug Report...") report-emacs-bug - :help ,(purecopy "Send e-mail to Emacs maintainers"))) - (define-key menu [emacs-manual-bug] - `(menu-item ,(purecopy "How to Report a Bug") info-emacs-bug - :help ,(purecopy "Read about how to report an Emacs bug"))) - (define-key menu [emacs-known-problems] - `(menu-item ,(purecopy "Emacs Known Problems") view-emacs-problems - :help ,(purecopy "Read about known problems with Emacs"))) - (define-key menu [emacs-news] - `(menu-item ,(purecopy "Emacs News") view-emacs-news - :help ,(purecopy "New features of this version"))) - (define-key menu [emacs-faq] - `(menu-item ,(purecopy "Emacs FAQ") view-emacs-FAQ - :help ,(purecopy "Frequently asked (and answered) questions about Emacs"))) - - (define-key menu [emacs-tutorial-language-specific] - `(menu-item ,(purecopy "Emacs Tutorial (choose language)...") + (bindings--define-key menu [emacs-psychotherapist] + '(menu-item "Emacs Psychotherapist" doctor + :help "Our doctor will help you feel better")) + (bindings--define-key menu [send-emacs-bug-report] + '(menu-item "Send Bug Report..." report-emacs-bug + :help "Send e-mail to Emacs maintainers")) + (bindings--define-key menu [emacs-manual-bug] + '(menu-item "How to Report a Bug" info-emacs-bug + :help "Read about how to report an Emacs bug")) + (bindings--define-key menu [emacs-known-problems] + '(menu-item "Emacs Known Problems" view-emacs-problems + :help "Read about known problems with Emacs")) + (bindings--define-key menu [emacs-news] + '(menu-item "Emacs News" view-emacs-news + :help "New features of this version")) + (bindings--define-key menu [emacs-faq] + '(menu-item "Emacs FAQ" view-emacs-FAQ + :help "Frequently asked (and answered) questions about Emacs")) + + (bindings--define-key menu [emacs-tutorial-language-specific] + '(menu-item "Emacs Tutorial (choose language)..." help-with-tutorial-spec-language - :help ,(purecopy "Learn how to use Emacs (choose a language)"))) - (define-key menu [emacs-tutorial] - `(menu-item ,(purecopy "Emacs Tutorial") help-with-tutorial - :help ,(purecopy "Learn how to use Emacs"))) + :help "Learn how to use Emacs (choose a language)")) + (bindings--define-key menu [emacs-tutorial] + '(menu-item "Emacs Tutorial" help-with-tutorial + :help "Learn how to use Emacs")) ;; In OS X it's in the app menu already. ;; FIXME? There already is an "About Emacs" (sans ...) entry in the Help menu. (and (featurep 'ns) (not (eq system-type 'darwin)) - (define-key menu [info-panel] - `(menu-item ,(purecopy "About Emacs...") ns-do-emacs-info-panel))) + (bindings--define-key menu [info-panel] + '(menu-item "About Emacs..." ns-do-emacs-info-panel))) menu)) -(define-key global-map [menu-bar tools] - (cons (purecopy "Tools") menu-bar-tools-menu)) -(define-key global-map [menu-bar buffer] - (cons (purecopy "Buffers") global-buffers-menu-map)) -(define-key global-map [menu-bar options] - (cons (purecopy "Options") menu-bar-options-menu)) -(define-key global-map [menu-bar edit] - (cons (purecopy "Edit") menu-bar-edit-menu)) -(define-key global-map [menu-bar file] - (cons (purecopy "File") menu-bar-file-menu)) +(bindings--define-key global-map [menu-bar tools] + (cons "Tools" menu-bar-tools-menu)) +(bindings--define-key global-map [menu-bar buffer] + (cons "Buffers" global-buffers-menu-map)) +(bindings--define-key global-map [menu-bar options] + (cons "Options" menu-bar-options-menu)) +(bindings--define-key global-map [menu-bar edit] + (cons "Edit" menu-bar-edit-menu)) +(bindings--define-key global-map [menu-bar file] + (cons "File" menu-bar-file-menu)) ;; Put "Help" menu at the end, or Info at the front. ;; If running under GNUstep, "Help" is moved and renamed "Info" (see below). (if (and (featurep 'ns) (not (eq system-type 'darwin))) - (define-key global-map [menu-bar help-menu] - (cons (purecopy "Info") menu-bar-help-menu)) + (bindings--define-key global-map [menu-bar help-menu] + (cons "Info" menu-bar-help-menu)) (define-key-after global-map [menu-bar help-menu] (cons (purecopy "Help") menu-bar-help-menu))) @@ -2118,40 +2110,40 @@ It must accept a buffer as its only required argument.") ;; This shouldn't be necessary, but there's a funny ;; bug in keymap.c that I don't understand yet. -stef minibuffer-local-completion-map)) - (define-key map [menu-bar minibuf] - (cons (purecopy "Minibuf") (make-sparse-keymap "Minibuf")))) + (bindings--define-key map [menu-bar minibuf] + (cons "Minibuf" (make-sparse-keymap "Minibuf")))) (let ((map minibuffer-local-completion-map)) - (define-key map [menu-bar minibuf ?\?] - `(menu-item ,(purecopy "List Completions") minibuffer-completion-help - :help ,(purecopy "Display all possible completions"))) - (define-key map [menu-bar minibuf space] - `(menu-item ,(purecopy "Complete Word") minibuffer-complete-word - :help ,(purecopy "Complete at most one word"))) - (define-key map [menu-bar minibuf tab] - `(menu-item ,(purecopy "Complete") minibuffer-complete - :help ,(purecopy "Complete as far as possible")))) + (bindings--define-key map [menu-bar minibuf ?\?] + '(menu-item "List Completions" minibuffer-completion-help + :help "Display all possible completions")) + (bindings--define-key map [menu-bar minibuf space] + '(menu-item "Complete Word" minibuffer-complete-word + :help "Complete at most one word")) + (bindings--define-key map [menu-bar minibuf tab] + '(menu-item "Complete" minibuffer-complete + :help "Complete as far as possible"))) (let ((map minibuffer-local-map)) - (define-key map [menu-bar minibuf quit] - `(menu-item ,(purecopy "Quit") abort-recursive-edit - :help ,(purecopy "Abort input and exit minibuffer"))) - (define-key map [menu-bar minibuf return] - `(menu-item ,(purecopy "Enter") exit-minibuffer - :key-sequence ,(purecopy "\r") - :help ,(purecopy "Terminate input and exit minibuffer"))) - (define-key map [menu-bar minibuf isearch-forward] - `(menu-item ,(purecopy "Isearch History Forward") isearch-forward - :help ,(purecopy "Incrementally search minibuffer history forward"))) - (define-key map [menu-bar minibuf isearch-backward] - `(menu-item ,(purecopy "Isearch History Backward") isearch-backward - :help ,(purecopy "Incrementally search minibuffer history backward"))) - (define-key map [menu-bar minibuf next] - `(menu-item ,(purecopy "Next History Item") next-history-element - :help ,(purecopy "Put next minibuffer history element in the minibuffer"))) - (define-key map [menu-bar minibuf previous] - `(menu-item ,(purecopy "Previous History Item") previous-history-element - :help ,(purecopy "Put previous minibuffer history element in the minibuffer")))) + (bindings--define-key map [menu-bar minibuf quit] + '(menu-item "Quit" abort-recursive-edit + :help "Abort input and exit minibuffer")) + (bindings--define-key map [menu-bar minibuf return] + '(menu-item "Enter" exit-minibuffer + :key-sequence "\r" + :help "Terminate input and exit minibuffer")) + (bindings--define-key map [menu-bar minibuf isearch-forward] + '(menu-item "Isearch History Forward" isearch-forward + :help "Incrementally search minibuffer history forward")) + (bindings--define-key map [menu-bar minibuf isearch-backward] + '(menu-item "Isearch History Backward" isearch-backward + :help "Incrementally search minibuffer history backward")) + (bindings--define-key map [menu-bar minibuf next] + '(menu-item "Next History Item" next-history-element + :help "Put next minibuffer history element in the minibuffer")) + (bindings--define-key map [menu-bar minibuf previous] + '(menu-item "Previous History Item" previous-history-element + :help "Put previous minibuffer history element in the minibuffer"))) (define-minor-mode menu-bar-mode "Toggle display of a menu bar on each frame (Menu Bar mode). diff --git a/lisp/replace.el b/lisp/replace.el index ad87d474b8b..5baf68224c4 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -763,48 +763,47 @@ a previously found match." (defvar occur-menu-map (let ((map (make-sparse-keymap))) - (define-key map [next-error-follow-minor-mode] - `(menu-item ,(purecopy "Auto Occurrence Display") + (bindings--define-key map [next-error-follow-minor-mode] + '(menu-item "Auto Occurrence Display" next-error-follow-minor-mode - :help ,(purecopy - "Display another occurrence when moving the cursor") + :help "Display another occurrence when moving the cursor" :button (:toggle . (and (boundp 'next-error-follow-minor-mode) next-error-follow-minor-mode)))) - (define-key map [separator-1] menu-bar-separator) - (define-key map [kill-this-buffer] - `(menu-item ,(purecopy "Kill Occur Buffer") kill-this-buffer - :help ,(purecopy "Kill the current *Occur* buffer"))) - (define-key map [quit-window] - `(menu-item ,(purecopy "Quit Occur Window") quit-window - :help ,(purecopy "Quit the current *Occur* buffer. Bury it, and maybe delete the selected frame"))) - (define-key map [revert-buffer] - `(menu-item ,(purecopy "Revert Occur Buffer") revert-buffer - :help ,(purecopy "Replace the text in the *Occur* buffer with the results of rerunning occur"))) - (define-key map [clone-buffer] - `(menu-item ,(purecopy "Clone Occur Buffer") clone-buffer - :help ,(purecopy "Create and return a twin copy of the current *Occur* buffer"))) - (define-key map [occur-rename-buffer] - `(menu-item ,(purecopy "Rename Occur Buffer") occur-rename-buffer - :help ,(purecopy "Rename the current *Occur* buffer to *Occur: original-buffer-name*."))) - (define-key map [occur-edit-buffer] - `(menu-item ,(purecopy "Edit Occur Buffer") occur-edit-mode - :help ,(purecopy "Edit the *Occur* buffer and apply changes to the original buffers."))) - (define-key map [separator-2] menu-bar-separator) - (define-key map [occur-mode-goto-occurrence-other-window] - `(menu-item ,(purecopy "Go To Occurrence Other Window") occur-mode-goto-occurrence-other-window - :help ,(purecopy "Go to the occurrence the current line describes, in another window"))) - (define-key map [occur-mode-goto-occurrence] - `(menu-item ,(purecopy "Go To Occurrence") occur-mode-goto-occurrence - :help ,(purecopy "Go to the occurrence the current line describes"))) - (define-key map [occur-mode-display-occurrence] - `(menu-item ,(purecopy "Display Occurrence") occur-mode-display-occurrence - :help ,(purecopy "Display in another window the occurrence the current line describes"))) - (define-key map [occur-next] - `(menu-item ,(purecopy "Move to Next Match") occur-next - :help ,(purecopy "Move to the Nth (default 1) next match in an Occur mode buffer"))) - (define-key map [occur-prev] - `(menu-item ,(purecopy "Move to Previous Match") occur-prev - :help ,(purecopy "Move to the Nth (default 1) previous match in an Occur mode buffer"))) + (bindings--define-key map [separator-1] menu-bar-separator) + (bindings--define-key map [kill-this-buffer] + '(menu-item "Kill Occur Buffer" kill-this-buffer + :help "Kill the current *Occur* buffer")) + (bindings--define-key map [quit-window] + '(menu-item "Quit Occur Window" quit-window + :help "Quit the current *Occur* buffer. Bury it, and maybe delete the selected frame")) + (bindings--define-key map [revert-buffer] + '(menu-item "Revert Occur Buffer" revert-buffer + :help "Replace the text in the *Occur* buffer with the results of rerunning occur")) + (bindings--define-key map [clone-buffer] + '(menu-item "Clone Occur Buffer" clone-buffer + :help "Create and return a twin copy of the current *Occur* buffer")) + (bindings--define-key map [occur-rename-buffer] + '(menu-item "Rename Occur Buffer" occur-rename-buffer + :help "Rename the current *Occur* buffer to *Occur: original-buffer-name*.")) + (bindings--define-key map [occur-edit-buffer] + '(menu-item "Edit Occur Buffer" occur-edit-mode + :help "Edit the *Occur* buffer and apply changes to the original buffers.")) + (bindings--define-key map [separator-2] menu-bar-separator) + (bindings--define-key map [occur-mode-goto-occurrence-other-window] + '(menu-item "Go To Occurrence Other Window" occur-mode-goto-occurrence-other-window + :help "Go to the occurrence the current line describes, in another window")) + (bindings--define-key map [occur-mode-goto-occurrence] + '(menu-item "Go To Occurrence" occur-mode-goto-occurrence + :help "Go to the occurrence the current line describes")) + (bindings--define-key map [occur-mode-display-occurrence] + '(menu-item "Display Occurrence" occur-mode-display-occurrence + :help "Display in another window the occurrence the current line describes")) + (bindings--define-key map [occur-next] + '(menu-item "Move to Next Match" occur-next + :help "Move to the Nth (default 1) next match in an Occur mode buffer")) + (bindings--define-key map [occur-prev] + '(menu-item "Move to Previous Match" occur-prev + :help "Move to the Nth (default 1) previous match in an Occur mode buffer")) map) "Menu keymap for `occur-mode'.") @@ -822,7 +821,7 @@ a previously found match." (define-key map "r" 'occur-rename-buffer) (define-key map "c" 'clone-buffer) (define-key map "\C-c\C-f" 'next-error-follow-minor-mode) - (define-key map [menu-bar occur] (cons (purecopy "Occur") occur-menu-map)) + (bindings--define-key map [menu-bar occur] (cons "Occur" occur-menu-map)) map) "Keymap for `occur-mode'.") @@ -870,7 +869,7 @@ Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. (define-key map "\C-c\C-c" 'occur-cease-edit) (define-key map "\C-o" 'occur-mode-display-occurrence) (define-key map "\C-c\C-f" 'next-error-follow-minor-mode) - (define-key map [menu-bar occur] (cons (purecopy "Occur") occur-menu-map)) + (bindings--define-key map [menu-bar occur] (cons "Occur" occur-menu-map)) map) "Keymap for `occur-edit-mode'.") diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index bba72177050..dff49c26e4e 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -947,66 +947,66 @@ current, and kill the buffer that visits the link." (let ((map (make-sparse-keymap "Version Control"))) ;;(define-key map [show-files] ;; '("Show Files under VC" . (vc-directory t))) - (define-key map [vc-retrieve-tag] - `(menu-item ,(purecopy "Retrieve Tag") vc-retrieve-tag - :help ,(purecopy "Retrieve tagged version or branch"))) - (define-key map [vc-create-tag] - `(menu-item ,(purecopy "Create Tag") vc-create-tag - :help ,(purecopy "Create version tag"))) - (define-key map [separator1] menu-bar-separator) - (define-key map [vc-annotate] - `(menu-item ,(purecopy "Annotate") vc-annotate - :help ,(purecopy "Display the edit history of the current file using colors"))) - (define-key map [vc-rename-file] - `(menu-item ,(purecopy "Rename File") vc-rename-file - :help ,(purecopy "Rename file"))) - (define-key map [vc-revision-other-window] - `(menu-item ,(purecopy "Show Other Version") vc-revision-other-window - :help ,(purecopy "Visit another version of the current file in another window"))) - (define-key map [vc-diff] - `(menu-item ,(purecopy "Compare with Base Version") vc-diff - :help ,(purecopy "Compare file set with the base version"))) - (define-key map [vc-root-diff] - `(menu-item ,(purecopy "Compare Tree with Base Version") vc-root-diff - :help ,(purecopy "Compare current tree with the base version"))) - (define-key map [vc-update-change-log] - `(menu-item ,(purecopy "Update ChangeLog") vc-update-change-log - :help ,(purecopy "Find change log file and add entries from recent version control logs"))) - (define-key map [vc-log-out] - `(menu-item ,(purecopy "Show Outgoing Log") vc-log-outgoing - :help ,(purecopy "Show a log of changes that will be sent with a push operation"))) - (define-key map [vc-log-in] - `(menu-item ,(purecopy "Show Incoming Log") vc-log-incoming - :help ,(purecopy "Show a log of changes that will be received with a pull operation"))) - (define-key map [vc-print-log] - `(menu-item ,(purecopy "Show History") vc-print-log - :help ,(purecopy "List the change log of the current file set in a window"))) - (define-key map [vc-print-root-log] - `(menu-item ,(purecopy "Show Top of the Tree History ") vc-print-root-log - :help ,(purecopy "List the change log for the current tree in a window"))) - (define-key map [separator2] menu-bar-separator) - (define-key map [vc-insert-header] - `(menu-item ,(purecopy "Insert Header") vc-insert-headers - :help ,(purecopy "Insert headers into a file for use with a version control system. -"))) - (define-key map [undo] - `(menu-item ,(purecopy "Undo Last Check-In") vc-rollback - :help ,(purecopy "Remove the most recent changeset committed to the repository"))) - (define-key map [vc-revert] - `(menu-item ,(purecopy "Revert to Base Version") vc-revert - :help ,(purecopy "Revert working copies of the selected file set to their repository contents"))) - (define-key map [vc-update] - `(menu-item ,(purecopy "Update to Latest Version") vc-update - :help ,(purecopy "Update the current fileset's files to their tip revisions"))) - (define-key map [vc-next-action] - `(menu-item ,(purecopy "Check In/Out") vc-next-action - :help ,(purecopy "Do the next logical version control operation on the current fileset"))) - (define-key map [vc-register] - `(menu-item ,(purecopy "Register") vc-register - :help ,(purecopy "Register file set into a version control system"))) - (define-key map [vc-dir] - `(menu-item ,(purecopy "VC Dir") vc-dir - :help ,(purecopy "Show the VC status of files in a directory"))) + (bindings--define-key map [vc-retrieve-tag] + '(menu-item "Retrieve Tag" vc-retrieve-tag + :help "Retrieve tagged version or branch")) + (bindings--define-key map [vc-create-tag] + '(menu-item "Create Tag" vc-create-tag + :help "Create version tag")) + (bindings--define-key map [separator1] menu-bar-separator) + (bindings--define-key map [vc-annotate] + '(menu-item "Annotate" vc-annotate + :help "Display the edit history of the current file using colors")) + (bindings--define-key map [vc-rename-file] + '(menu-item "Rename File" vc-rename-file + :help "Rename file")) + (bindings--define-key map [vc-revision-other-window] + '(menu-item "Show Other Version" vc-revision-other-window + :help "Visit another version of the current file in another window")) + (bindings--define-key map [vc-diff] + '(menu-item "Compare with Base Version" vc-diff + :help "Compare file set with the base version")) + (bindings--define-key map [vc-root-diff] + '(menu-item "Compare Tree with Base Version" vc-root-diff + :help "Compare current tree with the base version")) + (bindings--define-key map [vc-update-change-log] + '(menu-item "Update ChangeLog" vc-update-change-log + :help "Find change log file and add entries from recent version control logs")) + (bindings--define-key map [vc-log-out] + '(menu-item "Show Outgoing Log" vc-log-outgoing + :help "Show a log of changes that will be sent with a push operation")) + (bindings--define-key map [vc-log-in] + '(menu-item "Show Incoming Log" vc-log-incoming + :help "Show a log of changes that will be received with a pull operation")) + (bindings--define-key map [vc-print-log] + '(menu-item "Show History" vc-print-log + :help "List the change log of the current file set in a window")) + (bindings--define-key map [vc-print-root-log] + '(menu-item "Show Top of the Tree History " vc-print-root-log + :help "List the change log for the current tree in a window")) + (bindings--define-key map [separator2] menu-bar-separator) + (bindings--define-key map [vc-insert-header] + '(menu-item "Insert Header" vc-insert-headers + :help "Insert headers into a file for use with a version control system. +")) + (bindings--define-key map [undo] + '(menu-item "Undo Last Check-In" vc-rollback + :help "Remove the most recent changeset committed to the repository")) + (bindings--define-key map [vc-revert] + '(menu-item "Revert to Base Version" vc-revert + :help "Revert working copies of the selected file set to their repository contents")) + (bindings--define-key map [vc-update] + '(menu-item "Update to Latest Version" vc-update + :help "Update the current fileset's files to their tip revisions")) + (bindings--define-key map [vc-next-action] + '(menu-item "Check In/Out" vc-next-action + :help "Do the next logical version control operation on the current fileset")) + (bindings--define-key map [vc-register] + '(menu-item "Register" vc-register + :help "Register file set into a version control system")) + (bindings--define-key map [vc-dir] + '(menu-item "VC Dir" vc-dir + :help "Show the VC status of files in a directory")) map)) (defalias 'vc-menu-map vc-menu-map) diff --git a/src/ChangeLog b/src/ChangeLog index fc70a99a170..9af61d41353 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2012-06-27 Stefan Monnier + + * fns.c (maybe_resize_hash_table): Output message when growing the + purify-hashtable. + 2012-06-27 Dmitry Antipov * alloc.c (allocate_string_data): Remove dead code. @@ -29,7 +34,7 @@ 2012-06-26 John Wiegley - * unexmacosx.c (copy_data_segment): Added two section names used + * unexmacosx.c (copy_data_segment): Add two section names used on Mac OS X Lion: __mod_init_func and __mod_term_func. * alloc.c (mark_memory): Do not check with -faddress-sanitizer diff --git a/src/data.c b/src/data.c index bd757cfdad1..fe7b9420344 100644 --- a/src/data.c +++ b/src/data.c @@ -517,7 +517,7 @@ DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0, return newcdr; } -/* Extract and set components of symbols */ +/* Extract and set components of symbols. */ DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0, doc: /* Return t if SYMBOL's value is not void. */) diff --git a/src/fns.c b/src/fns.c index 515cd28328b..f734520fedb 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3749,6 +3749,17 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) if (INDEX_SIZE_BOUND < nsize) error ("Hash table too large to resize"); +#ifdef ENABLE_CHECKING + if (HASH_TABLE_P (Vpurify_flag) + && XHASH_TABLE (Vpurify_flag) == h) + { + Lisp_Object args[2]; + args[0] = build_string ("Growing hash table to: %d"); + args[1] = make_number (new_size); + Fmessage (2, args); + } +#endif + h->key_and_value = larger_vector (h->key_and_value, 2 * (new_size - old_size), -1); h->next = larger_vector (h->next, new_size - old_size, -1); diff --git a/src/puresize.h b/src/puresize.h index 7f8f279f568..2f024345d61 100644 --- a/src/puresize.h +++ b/src/puresize.h @@ -47,9 +47,9 @@ along with GNU Emacs. If not, see . */ #ifndef PURESIZE_RATIO #if EMACS_INT_MAX >> 31 != 0 #if PTRDIFF_MAX >> 31 != 0 -#define PURESIZE_RATIO 10/6 /* Don't surround with `()'. */ +#define PURESIZE_RATIO 10 / 6 /* Don't surround with `()'. */ #else -#define PURESIZE_RATIO 8/6 /* Don't surround with `()'. */ +#define PURESIZE_RATIO 8 / 6 /* Don't surround with `()'. */ #endif #else #define PURESIZE_RATIO 1 @@ -60,7 +60,7 @@ along with GNU Emacs. If not, see . */ /* ENABLE_CHECKING somehow increases the purespace used, probably because it tends to cause some macro arguments to be evaluated twice. This is a bug, but it's difficult to track it down. */ -#define PURESIZE_CHECKING_RATIO 12/10 /* Don't surround with `()'. */ +#define PURESIZE_CHECKING_RATIO 12 / 10 /* Don't surround with `()'. */ #else #define PURESIZE_CHECKING_RATIO 1 #endif -- cgit v1.2.3 From 7abaf5ccc9f11e657b6671e7a6d5a7533bba5f31 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 25 Jul 2012 21:27:33 -0400 Subject: Autoload more carefully from Lisp. Follow aliases for function properties. * lisp/subr.el (autoloadp): New function. (symbol-file): Use it. (function-get): New function. * lisp/emacs-lisp/macroexp.el (macroexp--expand-all): Use function-get and autoload-do-load. * lisp/emacs-lisp/lisp-mode.el (lisp-font-lock-syntactic-face-function) (lisp-indent-function): * lisp/emacs-lisp/gv.el (gv-get): * lisp/emacs-lisp/edebug.el (get-edebug-spec, edebug-basic-spec): * lisp/emacs-lisp/byte-opt.el (byte-optimize-form): * lisp/emacs-lisp/bytecomp.el (byte-compile-arglist-warn): * lisp/emacs-lisp/autoload.el (make-autoload, autoload-print-form): Use function-get. * lisp/emacs-lisp/cl.el: Don't propagate function properties any more. * src/eval.c (Fautoload_do_load): Rename from do_autoload, export to Lisp, add argument, tune behavior, and adjust all callers. * lisp/speedbar.el (speedbar-add-localized-speedbar-support): * lisp/emacs-lisp/disass.el (disassemble-internal): * lisp/desktop.el (desktop-load-file): * lisp/help-fns.el (help-function-arglist, find-lisp-object-file-name) (describe-function-1): * lisp/emacs-lisp/find-func.el (find-function-noselect): * lisp/emacs-lisp/elp.el (elp-instrument-function): * lisp/emacs-lisp/advice.el (ad-has-proper-definition): * lisp/apropos.el (apropos-safe-documentation, apropos-macrop): * lisp/emacs-lisp/debug.el (debug-on-entry): * lisp/emacs-lisp/cl-macs.el (cl-compiler-macroexpand): * lisp/emacs-lisp/byte-opt.el (byte-compile-inline-expand): * lisp/calc/calc.el (name): Use autoloadp & autoload-do-load. --- etc/NEWS | 4 +++ lisp/ChangeLog | 34 +++++++++++++++++++ lisp/apropos.el | 4 +-- lisp/calc/calc.el | 2 +- lisp/desktop.el | 7 ++-- lisp/emacs-lisp/advice.el | 2 +- lisp/emacs-lisp/autoload.el | 28 ++++++++-------- lisp/emacs-lisp/byte-opt.el | 13 ++++---- lisp/emacs-lisp/bytecomp.el | 2 +- lisp/emacs-lisp/cl-macs.el | 4 +-- lisp/emacs-lisp/cl.el | 11 +------ lisp/emacs-lisp/debug.el | 4 +-- lisp/emacs-lisp/disass.el | 8 ++--- lisp/emacs-lisp/edebug.el | 13 +++++--- lisp/emacs-lisp/elp.el | 2 +- lisp/emacs-lisp/find-func.el | 3 +- lisp/emacs-lisp/gv.el | 9 +---- lisp/emacs-lisp/lisp-mode.el | 6 ++-- lisp/emacs-lisp/macroexp.el | 14 ++------ lisp/emacs-lisp/pcase.el | 3 +- lisp/help-fns.el | 8 ++--- lisp/speedbar.el | 4 +-- lisp/subr.el | 33 ++++++++++++++++++- src/ChangeLog | 5 +++ src/data.c | 4 +-- src/eval.c | 78 ++++++++++++++++++++++++++------------------ src/keyboard.c | 10 ++---- src/keymap.c | 4 +-- src/lisp.h | 7 ++-- 29 files changed, 190 insertions(+), 136 deletions(-) (limited to 'lisp/emacs-lisp/lisp-mode.el') diff --git a/etc/NEWS b/etc/NEWS index 0f903c790c2..ce44a530e26 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -498,6 +498,10 @@ still be supported for Emacs 24.x. * Lisp changes in Emacs 24.2 +** New functions `autoloadp' and `autoload-do-load'. + +** `function-get' fetches the property of a function, following aliases. + ** `toggle-read-only' accepts a second argument specifying whether to print a message, if called from Lisp. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 1d4baa8b054..40cded6f9cc 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,37 @@ +2012-07-26 Stefan Monnier + + Autoload from Lisp with more care. Follow aliases when looking for + function properties. + * subr.el (autoloadp): New function. + (symbol-file): Use it. + (function-get): New function. + * emacs-lisp/macroexp.el (macroexp--expand-all): Use function-get and + autoload-do-load. + * emacs-lisp/lisp-mode.el (lisp-font-lock-syntactic-face-function) + (lisp-indent-function): + * emacs-lisp/gv.el (gv-get): + * emacs-lisp/edebug.el (get-edebug-spec, edebug-basic-spec): + * emacs-lisp/byte-opt.el (byte-optimize-form): + * emacs-lisp/bytecomp.el (byte-compile-arglist-warn): + * emacs-lisp/autoload.el (make-autoload, autoload-print-form): + Use function-get. + * emacs-lisp/cl.el: Don't propagate function properties any more. + + * speedbar.el (speedbar-add-localized-speedbar-support): + * emacs-lisp/disass.el (disassemble-internal): + * desktop.el (desktop-load-file): + * help-fns.el (help-function-arglist, find-lisp-object-file-name) + (describe-function-1): + * emacs-lisp/find-func.el (find-function-noselect): + * emacs-lisp/elp.el (elp-instrument-function): + * emacs-lisp/advice.el (ad-has-proper-definition): + * apropos.el (apropos-safe-documentation, apropos-macrop): + * emacs-lisp/debug.el (debug-on-entry): + * emacs-lisp/cl-macs.el (cl-compiler-macroexpand): + * emacs-lisp/byte-opt.el (byte-compile-inline-expand): + * calc/calc.el (name): Use autoloadp & autoload-do-load. + + 2012-07-25 Alp Aker * international/mule-cmds.el (ucs-insert): Mark it as an obsolete diff --git a/lisp/apropos.el b/lisp/apropos.el index e1c3e06752d..6c6e3b325e8 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -980,7 +980,7 @@ Will return nil instead." (setq function (if (byte-code-function-p function) (if (> (length function) 4) (aref function 4)) - (if (eq (car-safe function) 'autoload) + (if (autoloadp function) (nth 2 function) (if (eq (car-safe function) 'lambda) (if (stringp (nth 2 function)) @@ -1114,7 +1114,7 @@ If non-nil TEXT is a string that will be printed as a heading." (consp (setq symbol (symbol-function symbol))) (or (eq (car symbol) 'macro) - (if (eq (car symbol) 'autoload) + (if (autoloadp symbol) (memq (nth 4 symbol) '(macro t)))))) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 4d64209dd36..7fb9148535a 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -914,7 +914,7 @@ Used by `calc-user-invocation'.") ;; Set up the autoloading linkage. (let ((name (and (fboundp 'calc-dispatch) - (eq (car-safe (symbol-function 'calc-dispatch)) 'autoload) + (autoloadp (symbol-function 'calc-dispatch)) (nth 1 (symbol-function 'calc-dispatch)))) (p load-path)) diff --git a/lisp/desktop.el b/lisp/desktop.el index 2c2106e18b7..a873a6b63bf 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -1119,11 +1119,8 @@ directory DIRNAME." (defun desktop-load-file (function) "Load the file where auto loaded FUNCTION is defined." - (when function - (let ((fcell (and (fboundp function) (symbol-function function)))) - (when (and (listp fcell) - (eq 'autoload (car fcell))) - (load (cadr fcell)))))) + (when (fboundp function) + (autoload-do-load (symbol-function function) function))) ;; ---------------------------------------------------------------------------- ;; Create a buffer, load its file, set its mode, ...; diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 09dde2c1c17..cac76d2bce1 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -2542,7 +2542,7 @@ definition (see the code for `documentation')." For that it has to be fbound with a non-autoload definition." (and (symbolp function) (fboundp function) - (not (eq (car-safe (symbol-function function)) 'autoload)))) + (not (autoloadp (symbol-function function))))) ;; The following two are necessary for the sake of packages such as ;; ange-ftp which redefine functions via fcell indirection: diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 1bdd6d8fc4b..3fc185dda25 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -163,23 +163,23 @@ expression, in which case we want to handle forms differently." ((or `define-generic-mode `define-derived-mode `define-compilation-mode) nil) (_ t))) - (body (nthcdr (or (get car 'doc-string-elt) 3) form)) + (body (nthcdr (or (function-get car 'doc-string-elt) 3) form)) (doc (if (stringp (car body)) (pop body)))) ;; Add the usage form at the end where describe-function-1 ;; can recover it. (when (listp args) (setq doc (help-add-fundoc-usage doc args))) ;; `define-generic-mode' quotes the name, so take care of that - (list 'autoload (if (listp name) name (list 'quote name)) - file doc - (or (and (memq car '(define-skeleton define-derived-mode - define-generic-mode - easy-mmode-define-global-mode - define-global-minor-mode - define-globalized-minor-mode - easy-mmode-define-minor-mode - define-minor-mode)) t) - (eq (car-safe (car body)) 'interactive)) - (if macrop (list 'quote 'macro) nil)))) + `(autoload ,(if (listp name) name (list 'quote name)) + ,file ,doc + ,(or (and (memq car '(define-skeleton define-derived-mode + define-generic-mode + easy-mmode-define-global-mode + define-global-minor-mode + define-globalized-minor-mode + easy-mmode-define-minor-mode + define-minor-mode)) t) + (eq (car-safe (car body)) 'interactive)) + ,(if macrop ''macro nil)))) ;; For defclass forms, use `eieio-defclass-autoload'. ((eq car 'defclass) @@ -277,7 +277,7 @@ put the output in." ;; Symbols at the toplevel are meaningless. ((symbolp form) nil) (t - (let ((doc-string-elt (get (car-safe form) 'doc-string-elt)) + (let ((doc-string-elt (function-get (car-safe form) 'doc-string-elt)) (outbuf autoload-print-form-outbuf)) (if (and doc-string-elt (stringp (nth doc-string-elt form))) ;; We need to hack the printing because the @@ -356,7 +356,7 @@ not be relied upon." "Insert the section-header line, which lists the file name and which functions are in it, etc." (insert generate-autoload-section-header) - (prin1 (list 'autoloads autoloads load-name file time) + (prin1 `(autoloads ,autoloads ,load-name ,file ,time) outbuf) (terpri outbuf) ;; Break that line at spaces, to avoid very long lines. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 5a3fd7dddb1..a4c3e8aac4e 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -249,8 +249,8 @@ (let* ((name (car form)) (localfn (cdr (assq name byte-compile-function-environment))) (fn (or localfn (and (fboundp name) (symbol-function name))))) - (when (and (consp fn) (eq (car fn) 'autoload)) - (load (nth 1 fn)) + (when (autoloadp fn) + (autoload-do-load fn) (setq fn (or (and (fboundp name) (symbol-function name)) (cdr (assq name byte-compile-function-environment))))) (pcase fn @@ -586,10 +586,11 @@ (let (opt new) (if (and (consp form) (symbolp (car form)) - (or (and for-effect - ;; we don't have any of these yet, but we might. - (setq opt (get (car form) 'byte-for-effect-optimizer))) - (setq opt (get (car form) 'byte-optimizer))) + (or ;; (and for-effect + ;; ;; We don't have any of these yet, but we might. + ;; (setq opt (get (car form) + ;; 'byte-for-effect-optimizer))) + (setq opt (function-get (car form) 'byte-optimizer))) (not (eq form (setq new (funcall opt form))))) (progn ;; (if (equal form new) (error "bogus optimizer -- %s" opt)) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 97d7ab924ed..e5df8dd112c 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1355,7 +1355,7 @@ extra args." nums sig min max) (when calls (when (and (symbolp name) - (eq (get name 'byte-optimizer) + (eq (function-get name 'byte-optimizer) 'byte-compile-inline-expand)) (byte-compile-warn "defsubst `%s' was used before it was defined" name)) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 70d907a14c1..00ba6b9e0d0 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2420,8 +2420,8 @@ and then returning foo." (while (and (symbolp func) (not (setq handler (get func 'compiler-macro))) (fboundp func) - (or (not (eq (car-safe (symbol-function func)) 'autoload)) - (load (nth 1 (symbol-function func))))) + (or (not (autoloadp (symbol-function func))) + (autoload-do-load (symbol-function func) func))) (setq func (symbol-function func))) (and handler (not (eq form (setq form (apply handler form (cdr form)))))))) diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index 32cf1670744..8174de786c7 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -320,16 +320,7 @@ )) (let ((new (if (consp fun) (prog1 (cdr fun) (setq fun (car fun))) (intern (format "cl-%s" fun))))) - (defalias fun new) - ;; If `cl-foo' is declare inline, then make `foo' inline as well, and - ;; similarly. Same for edebug specifications, indent rules and - ;; doc-string position. - ;; FIXME: For most of them, we should instead follow aliases - ;; where applicable. - (dolist (prop '(byte-optimizer doc-string-elt edebug-form-spec - lisp-indent-function)) - (if (get new prop) - (put fun prop (get new prop)))))) + (defalias fun new))) ;;; Features provided a bit differently in Elisp. diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index b0813aebef6..7bc93a19d1a 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -805,9 +805,9 @@ Redefining FUNCTION also cancels it." ,(interactive-form (symbol-function function)) (apply ',(symbol-function function) debug-on-entry-args))) - (when (eq (car-safe (symbol-function function)) 'autoload) + (when (autoloadp (symbol-function function)) ;; The function is autoloaded. Load its real definition. - (load (cadr (symbol-function function)) nil noninteractive nil t)) + (autoload-do-load (symbol-function function) function)) (when (or (not (consp (symbol-function function))) (and (eq (car (symbol-function function)) 'macro) (not (consp (cdr (symbol-function function)))))) diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el index ba720b42868..206166bc77a 100644 --- a/lisp/emacs-lisp/disass.el +++ b/lisp/emacs-lisp/disass.el @@ -80,14 +80,10 @@ redefine OBJECT if it is a symbol." obj (symbol-function obj))) (if (subrp obj) (error "Can't disassemble #" name)) - (when (and (listp obj) (eq (car obj) 'autoload)) - (load (nth 1 obj)) - (setq obj (symbol-function name))) - (if (eq (car-safe obj) 'macro) ;handle macros + (setq obj (autoload-do-load obj name)) + (if (eq (car-safe obj) 'macro) ;Handle macros. (setq macro t obj (cdr obj))) - (when (and (listp obj) (eq (car obj) 'closure)) - (error "Don't know how to compile an interpreted closure")) (if (and (listp obj) (eq (car obj) 'byte-code)) (setq obj (list 'lambda nil obj))) (if (and (listp obj) (not (eq (car obj) 'lambda))) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index c1c65b6f661..bbf0757c3bc 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -242,10 +242,13 @@ If the result is non-nil, then break. Errors are ignored." (defun get-edebug-spec (symbol) ;; Get the spec of symbol resolving all indirection. - (let ((edebug-form-spec (get symbol 'edebug-form-spec)) - indirect) - (while (and (symbolp edebug-form-spec) - (setq indirect (get edebug-form-spec 'edebug-form-spec))) + (let ((edebug-form-spec nil) + (indirect symbol)) + (while + (progn + (and (symbolp indirect) + (setq indirect + (function-get indirect 'edebug-form-spec 'autoload)))) ;; (edebug-trace "indirection: %s" edebug-form-spec) (setq edebug-form-spec indirect)) edebug-form-spec @@ -263,7 +266,7 @@ An extant spec symbol is a symbol that is not a function and has a (setq spec (cdr spec))) t)) ((symbolp spec) - (unless (functionp spec) (get spec 'edebug-form-spec))))) + (unless (functionp spec) (function-get spec 'edebug-form-spec))))) ;;; Utilities diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index 08390327414..b94817cdb02 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -258,7 +258,7 @@ FUNSYM must be a symbol of a defined function." ;; the autoload here, since that could have side effects, and ;; elp-instrument-function is similar (in my mind) to defun-ish ;; type functionality (i.e. it shouldn't execute the function). - (and (eq (car-safe funguts) 'autoload) + (and (autoloadp funguts) (error "ELP cannot profile autoloaded function: %s" funsym)) ;; We cannot profile functions used internally during profiling. (unless (elp-profilable-p funsym) diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index d64281d0e81..e1e153d9117 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -347,8 +347,7 @@ in `load-path'." (if aliases (message "%s" aliases)) (let ((library - (cond ((eq (car-safe def) 'autoload) - (nth 1 def)) + (cond ((autoloadp def) (nth 1 def)) ((subrp def) (if lisp-only (error "%s is a built-in function" function)) diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index eb0e64e22b8..d1f997c99c4 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -84,14 +84,7 @@ DO must return an Elisp expression." (if (symbolp place) (funcall do place (lambda (v) `(setq ,place ,v))) (let* ((head (car place)) - (gf (get head 'gv-expander))) - ;; Autoload the head, if applicable, since that might define - ;; `gv-expander'. - (when (and (null gf) (fboundp head) - (eq 'autoload (car-safe (symbol-function head)))) - (with-demoted-errors - (load (nth 1 (symbol-function head)) 'noerror 'nomsg) - (setq gf (get head 'gv-expander)))) + (gf (function-get head 'gv-expander 'autoload))) (if gf (apply gf do (cdr place)) (let ((me (macroexpand place ;FIXME: expand one step at a time! ;; (append macroexpand-all-environment diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 350b0bd949d..e29407f5a8b 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -158,7 +158,8 @@ It has `lisp-mode-abbrev-table' as its parent." (goto-char listbeg) (and (looking-at "([ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)") (match-string 1))))) - (docelt (and firstsym (get (intern-soft firstsym) + (docelt (and firstsym + (function-get (intern-soft firstsym) lisp-doc-string-elt-property)))) (if (and docelt ;; It's a string in a form that can have a docstring. @@ -1135,7 +1136,8 @@ Lisp function does not specify a special indentation." (let ((function (buffer-substring (point) (progn (forward-sexp 1) (point)))) method) - (setq method (or (get (intern-soft function) 'lisp-indent-function) + (setq method (or (function-get (intern-soft function) + 'lisp-indent-function) (get (intern-soft function) 'lisp-indent-hook))) (cond ((or (eq method 'defun) (and (null method) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 65a72aa5312..70eab149837 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -185,12 +185,7 @@ Assumes the caller has bound `macroexpand-all-environment'." ;; Macro expand compiler macros. This cannot be delayed to ;; byte-optimize-form because the output of the compiler-macro can ;; use macros. - (let ((handler nil)) - (while (and (symbolp func) - (not (setq handler (get func 'compiler-macro))) - (fboundp func)) - ;; Follow the sequence of aliases. - (setq func (symbol-function func))) + (let ((handler (function-get func 'compiler-macro))) (if (null handler) ;; No compiler macro. We just expand each argument (for ;; setq/setq-default this works alright because the variable names @@ -198,12 +193,9 @@ Assumes the caller has bound `macroexpand-all-environment'." (macroexp--all-forms form 1) ;; If the handler is not loaded yet, try (auto)loading the ;; function itself, which may in turn load the handler. - (when (and (not (functionp handler)) - (fboundp func) (eq (car-safe (symbol-function func)) - 'autoload)) + (unless (functionp handler) (ignore-errors - (load (nth 1 (symbol-function func)) - 'noerror 'nomsg))) + (autoload-do-load (indirect-function func) func))) (let ((newform (macroexp--compiler-macro handler form))) (if (eq form newform) ;; The compiler macro did not find anything to do. diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 3f4ce605cb0..4aeed7e4d0e 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -114,7 +114,8 @@ QPatterns for vectors are not implemented yet. PRED can take the form FUNCTION in which case it gets called with one argument. - (FUN ARG1 .. ARGN) in which case it gets called with N+1 arguments. + (FUN ARG1 .. ARGN) in which case it gets called with an N+1'th argument + which is the value being matched. A PRED of the form FUNCTION is equivalent to one of the form (FUNCTION). PRED patterns can refer to variables bound earlier in the pattern. E.g. you can match pairs where the cdr is larger than the car with a pattern diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 2e56da0bcaa..f585bff871f 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -150,7 +150,7 @@ the same names as used in the original source code, when possible." arglist))) (unless (zerop rest) (push '&rest arglist) (push 'rest arglist)) (nreverse arglist)))) - ((and (eq (car-safe def) 'autoload) (not (eq (nth 4 def) 'keymap))) + ((and (autoloadp def) (not (eq (nth 4 def) 'keymap))) "[Arg list not available until function definition is loaded.]") (t t))) @@ -288,7 +288,7 @@ defined. If several such files exist, preference is given to a file found via `load-path'. The return value can also be `C-source', which means that OBJECT is a function or variable defined in C. If no suitable file is found, return nil." - (let* ((autoloaded (eq (car-safe type) 'autoload)) + (let* ((autoloaded (autoloadp type)) (file-name (or (and autoloaded (nth 1 type)) (symbol-file object (if (memq type (list 'defvar 'defface)) @@ -468,7 +468,7 @@ FILE is the file where FUNCTION was probably defined." (concat beg "Lisp macro")) ((eq (car-safe def) 'closure) (concat beg "Lisp closure")) - ((eq (car-safe def) 'autoload) + ((autoloadp def) (format "%s autoloaded %s" (if (commandp def) "an interactive" "an") (if (eq (nth 4 def) 'keymap) "keymap" @@ -563,7 +563,7 @@ FILE is the file where FUNCTION was probably defined." ;; If the function is autoloaded, and its docstring has ;; key substitution constructs, load the library. (doc (progn - (and (eq (car-safe real-def) 'autoload) + (and (autoloadp real-def) help-enable-auto-load (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]" doc-raw) diff --git a/lisp/speedbar.el b/lisp/speedbar.el index d8c8c4a56be..16993ce1891 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -1864,9 +1864,7 @@ of the special mode functions." ;; If it is autoloaded, we need to load it now so that ;; we have access to the variable -speedbar-menu-items. ;; Is this XEmacs safe? - (let ((sf (symbol-function v))) - (if (and (listp sf) (eq (car sf) 'autoload)) - (load-library (car (cdr sf))))) + (autoload-do-load (symbol-function v) v) (setq speedbar-special-mode-expansion-list (list v)) (setq v (intern-soft (concat ms "-speedbar-key-map"))) (if (not v) diff --git a/lisp/subr.el b/lisp/subr.el index 882ad3cd23d..76fec5dd5ac 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1691,6 +1691,23 @@ If TOGGLE has a `:menu-tag', that is used for the menu item's label." ;;; Load history +(defsubst autoloadp (object) + "Non-nil if OBJECT is an autoload." + (eq 'autoload (car-safe object))) + +;; (defun autoload-type (object) +;; "Returns the type of OBJECT or `function' or `command' if the type is nil. +;; OBJECT should be an autoload object." +;; (when (autoloadp object) +;; (let ((type (nth 3 object))) +;; (cond ((null type) (if (nth 2 object) 'command 'function)) +;; ((eq 'keymap t) 'macro) +;; (type))))) + +;; (defalias 'autoload-file #'cadr +;; "Return the name of the file from which AUTOLOAD will be loaded. +;; \n\(fn AUTOLOAD)") + (defun symbol-file (symbol &optional type) "Return the name of the file that defined SYMBOL. The value is normally an absolute file name. It can also be nil, @@ -1703,7 +1720,7 @@ TYPE is `defun', `defvar', or `defface', that specifies function definition, variable definition, or face definition only." (if (and (or (null type) (eq type 'defun)) (symbolp symbol) (fboundp symbol) - (eq 'autoload (car-safe (symbol-function symbol)))) + (autoloadp (symbol-function symbol))) (nth 1 (symbol-function symbol)) (let ((files load-history) file) @@ -2752,6 +2769,20 @@ computing the hash. If BINARY is non-nil, return a string in binary form." (secure-hash 'sha1 object start end binary)) +(defun function-get (f prop &optional autoload) + "Return the value of property PROP of function F. +If AUTOLOAD is non-nil and F is an autoloaded macro, try to autoload +the macro in the hope that it will set PROP." + (let ((val nil)) + (while (and (symbolp f) + (null (setq val (get f prop))) + (fboundp f)) + (let ((fundef (symbol-function f))) + (if (and autoload (autoloadp fundef) + (not (equal fundef (autoload-do-load fundef f 'macro)))) + nil ;Re-try `get' on the same `f'. + (setq f fundef)))) + val)) ;;;; Support for yanking and text properties. diff --git a/src/ChangeLog b/src/ChangeLog index 88c90dd84d8..eb74f458942 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2012-07-26 Stefan Monnier + + * eval.c (Fautoload_do_load): Rename from do_autoload, export to Lisp, + add argument, tune behavior, and adjust all callers. + 2012-07-25 Paul Eggert Use typedef for EMACS_INT, EMACS_UINT. diff --git a/src/data.c b/src/data.c index 110e8ae41ab..b23bcbe15b3 100644 --- a/src/data.c +++ b/src/data.c @@ -761,7 +761,7 @@ Value, if non-nil, is a list \(interactive SPEC). */) { struct gcpro gcpro1; GCPRO1 (cmd); - do_autoload (fun, cmd); + Fautoload_do_load (fun, cmd, Qnil); UNGCPRO; return Finteractive_form (cmd); } @@ -2059,7 +2059,7 @@ function chain of symbols. */) return Qnil; } -/* Extract and set vector and string elements */ +/* Extract and set vector and string elements. */ DEFUN ("aref", Faref, Saref, 2, 2, 0, doc: /* Return the element of ARRAY at index IDX. diff --git a/src/eval.c b/src/eval.c index a0143c372de..a0a05ebf0dc 100644 --- a/src/eval.c +++ b/src/eval.c @@ -988,26 +988,14 @@ definitions to shadow the loaded ones for use in file byte-compilation. */) { /* SYM is not mentioned in ENVIRONMENT. Look at its function definition. */ + struct gcpro gcpro1; + GCPRO1 (form); + def = Fautoload_do_load (def, sym, Qmacro); + UNGCPRO; if (EQ (def, Qunbound) || !CONSP (def)) /* Not defined or definition not suitable. */ break; - if (EQ (XCAR (def), Qautoload)) - { - /* Autoloading function: will it be a macro when loaded? */ - tem = Fnth (make_number (4), def); - if (EQ (tem, Qt) || EQ (tem, Qmacro)) - /* Yes, load it and try again. */ - { - struct gcpro gcpro1; - GCPRO1 (form); - do_autoload (def, sym); - UNGCPRO; - continue; - } - else - break; - } - else if (!EQ (XCAR (def), Qmacro)) + if (!EQ (XCAR (def), Qmacro)) break; else expander = XCDR (def); } @@ -1952,22 +1940,35 @@ un_autoload (Lisp_Object oldqueue) FUNNAME is the symbol which is the function's name. FUNDEF is the autoload definition (a list). */ -void -do_autoload (Lisp_Object fundef, Lisp_Object funname) +DEFUN ("autoload-do-load", Fautoload_do_load, Sautoload_do_load, 1, 3, 0, + doc: /* Load FUNDEF which should be an autoload. +If non-nil, FUNNAME should be the symbol whose function value is FUNDEF, +in which case the function returns the new autoloaded function value. +If equal to `macro', MACRO-ONLY specifies that FUNDEF should only be loaded if +it is defines a macro. */) + (Lisp_Object fundef, Lisp_Object funname, Lisp_Object macro_only) { ptrdiff_t count = SPECPDL_INDEX (); - Lisp_Object fun; struct gcpro gcpro1, gcpro2, gcpro3; + if (!CONSP (fundef) || !EQ (Qautoload, XCAR (fundef))) + return fundef; + + if (EQ (macro_only, Qmacro)) + { + Lisp_Object kind = Fnth (make_number (4), fundef); + if (! (EQ (kind, Qt) || EQ (kind, Qmacro))) + return fundef; + } + /* This is to make sure that loadup.el gives a clear picture of what files are preloaded and when. */ if (! NILP (Vpurify_flag)) error ("Attempt to autoload %s while preparing to dump", SDATA (SYMBOL_NAME (funname))); - fun = funname; CHECK_SYMBOL (funname); - GCPRO3 (fun, funname, fundef); + GCPRO3 (funname, fundef, macro_only); /* Preserve the match data. */ record_unwind_save_match_data (); @@ -1982,18 +1983,28 @@ do_autoload (Lisp_Object fundef, Lisp_Object funname) The value saved here is to be restored into Vautoload_queue. */ record_unwind_protect (un_autoload, Vautoload_queue); Vautoload_queue = Qt; - Fload (Fcar (Fcdr (fundef)), Qnil, Qt, Qnil, Qt); + /* If `macro_only', assume this autoload to be a "best-effort", + so don't signal an error if autoloading fails. */ + Fload (Fcar (Fcdr (fundef)), macro_only, Qt, Qnil, Qt); /* Once loading finishes, don't undo it. */ Vautoload_queue = Qt; unbind_to (count, Qnil); - fun = Findirect_function (fun, Qnil); - - if (!NILP (Fequal (fun, fundef))) - error ("Autoloading failed to define function %s", - SDATA (SYMBOL_NAME (funname))); UNGCPRO; + + if (NILP (funname)) + return Qnil; + else + { + Lisp_Object fun = Findirect_function (funname, Qnil); + + if (!NILP (Fequal (fun, fundef))) + error ("Autoloading failed to define function %s", + SDATA (SYMBOL_NAME (funname))); + else + return fun; + } } @@ -2200,7 +2211,7 @@ eval_sub (Lisp_Object form) xsignal1 (Qinvalid_function, original_fun); if (EQ (funcar, Qautoload)) { - do_autoload (fun, original_fun); + Fautoload_do_load (fun, original_fun, Qnil); goto retry; } if (EQ (funcar, Qmacro)) @@ -2729,7 +2740,6 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) ptrdiff_t i; QUIT; - maybe_gc (); if (++lisp_eval_depth > max_lisp_eval_depth) { @@ -2742,10 +2752,13 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) backtrace.next = backtrace_list; backtrace_list = &backtrace; backtrace.function = &args[0]; - backtrace.args = &args[1]; + backtrace.args = &args[1]; /* This also GCPROs them. */ backtrace.nargs = nargs - 1; backtrace.debug_on_exit = 0; + /* Call GC after setting up the backtrace, so the latter GCPROs the args. */ + maybe_gc (); + if (debug_on_next_call) do_debug_on_call (Qlambda); @@ -2857,7 +2870,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) val = funcall_lambda (fun, numargs, args + 1); else if (EQ (funcar, Qautoload)) { - do_autoload (fun, original_fun); + Fautoload_do_load (fun, original_fun, Qnil); CHECK_CONS_LIST (); goto retry; } @@ -3582,6 +3595,7 @@ alist of active lexical bindings. */); defsubr (&Scalled_interactively_p); defsubr (&Scommandp); defsubr (&Sautoload); + defsubr (&Sautoload_do_load); defsubr (&Seval); defsubr (&Sapply); defsubr (&Sfuncall); diff --git a/src/keyboard.c b/src/keyboard.c index 0c03a2143d8..1f6c47eaf79 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -8827,18 +8827,12 @@ access_keymap_keyremap (Lisp_Object map, Lisp_Object key, Lisp_Object prompt, next = access_keymap (map, key, 1, 0, 1); - /* Handle symbol with autoload definition. */ - if (SYMBOLP (next) && !NILP (Ffboundp (next)) - && CONSP (XSYMBOL (next)->function) - && EQ (XCAR (XSYMBOL (next)->function), Qautoload)) - do_autoload (XSYMBOL (next)->function, next); - /* Handle a symbol whose function definition is a keymap or an array. */ if (SYMBOLP (next) && !NILP (Ffboundp (next)) && (ARRAYP (XSYMBOL (next)->function) || KEYMAPP (XSYMBOL (next)->function))) - next = XSYMBOL (next)->function; + next = Fautoload_do_load (XSYMBOL (next)->function, next, Qnil); /* If the keymap gives a function, not an array, then call the function with one arg and use @@ -10282,7 +10276,7 @@ a special event, so ignore the prefix argument and don't clear it. */) struct gcpro gcpro1, gcpro2; GCPRO2 (cmd, prefixarg); - do_autoload (final, cmd); + Fautoload_do_load (final, cmd, Qnil); UNGCPRO; } else diff --git a/src/keymap.c b/src/keymap.c index 510c5ea7f3e..feaf0cfd961 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -225,7 +225,7 @@ when reading a key-sequence to be looked-up in this keymap. */) Fdefine_key should cause keymaps to be autoloaded. This function can GC when AUTOLOAD is non-zero, because it calls - do_autoload which can GC. */ + Fautoload_do_load which can GC. */ Lisp_Object get_keymap (Lisp_Object object, int error_if_not_keymap, int autoload) @@ -259,7 +259,7 @@ get_keymap (Lisp_Object object, int error_if_not_keymap, int autoload) struct gcpro gcpro1, gcpro2; GCPRO2 (tem, object); - do_autoload (tem, object); + Fautoload_do_load (tem, object, Qnil); UNGCPRO; goto autoload_retry; diff --git a/src/lisp.h b/src/lisp.h index e4eb8ce5084..d9305555778 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2822,7 +2822,6 @@ extern Lisp_Object unbind_to (ptrdiff_t, Lisp_Object); extern _Noreturn void error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2); extern _Noreturn void verror (const char *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0); -extern void do_autoload (Lisp_Object, Lisp_Object); extern Lisp_Object un_autoload (Lisp_Object); extern void init_eval_once (void); extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object *); @@ -2834,7 +2833,7 @@ extern void mark_backtrace (void); #endif extern void syms_of_eval (void); -/* Defined in editfns.c */ +/* Defined in editfns.c. */ extern Lisp_Object Qfield; extern void insert1 (Lisp_Object); extern Lisp_Object format2 (const char *, Lisp_Object, Lisp_Object); @@ -2851,7 +2850,7 @@ const char *get_system_name (void); extern void syms_of_editfns (void); extern void set_time_zone_rule (const char *); -/* Defined in buffer.c */ +/* Defined in buffer.c. */ extern int mouse_face_overlay_overlaps (Lisp_Object); extern _Noreturn void nsberror (Lisp_Object); extern void adjust_overlays_for_insert (ptrdiff_t, ptrdiff_t); @@ -2870,7 +2869,7 @@ extern void init_buffer (void); extern void syms_of_buffer (void); extern void keys_of_buffer (void); -/* Defined in marker.c */ +/* Defined in marker.c. */ extern ptrdiff_t marker_position (Lisp_Object); extern ptrdiff_t marker_byte_position (Lisp_Object); -- cgit v1.2.3 From b7ccbdc2e39ff834a03a7f30516b71cd98e84a44 Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sun, 5 Aug 2012 22:14:54 +0800 Subject: In Imenu, don't show defvars with no second argument. * lisp/emacs-lisp/lisp-mode.el (lisp-imenu-generic-expression): Don't show defvars which have no second argument. * lisp/imenu.el (imenu-generic-expression): Move documentation here from imenu--generic-function. (imenu--generic-function): Refer to imenu-generic-expression. Fixes: debbugs:8638 --- lisp/ChangeLog | 9 ++++++ lisp/emacs-lisp/lisp-mode.el | 7 +++- lisp/imenu.el | 77 ++++++++++++++++++++------------------------ 3 files changed, 50 insertions(+), 43 deletions(-) (limited to 'lisp/emacs-lisp/lisp-mode.el') diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 004a3eaf451..e211bacbb02 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2012-08-05 Chong Yidong + + * emacs-lisp/lisp-mode.el (lisp-imenu-generic-expression): Don't + show defvars which have no second argument (Bug#8638). + + * imenu.el (imenu-generic-expression): Move documentation here + from imenu--generic-function. + (imenu--generic-function): Refer to imenu-generic-expression. + 2012-08-05 Vegard Øye (tiny change) * emulation/viper-init.el (viper-deflocalvar): Add docstring and diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index e29407f5a8b..7e9dd9e6cfe 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -117,10 +117,15 @@ It has `lisp-mode-abbrev-table' as its parent." (purecopy (concat "^\\s-*(" (eval-when-compile (regexp-opt - '("defvar" "defconst" "defconstant" "defcustom" + '("defconst" "defconstant" "defcustom" "defparameter" "define-symbol-macro") t)) "\\s-+\\(\\(\\sw\\|\\s_\\)+\\)")) 2) + ;; For `defvar', we ignore (defvar FOO) constructs. + (list (purecopy "Variables") + (purecopy (concat "^\\s-*(defvar\\s-+\\(\\(\\sw\\|\\s_\\)+\\)" + "[[:space:]\n]+[^)]")) + 1) (list (purecopy "Types") (purecopy (concat "^\\s-*(" (eval-when-compile diff --git a/lisp/imenu.el b/lisp/imenu.el index 8cef5161a37..c2a80d69675 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -187,16 +187,39 @@ with name concatenation." ;;;###autoload (defvar imenu-generic-expression nil - "The regex pattern to use for creating a buffer index. + "List of definition matchers for creating an Imenu index. +Each element of this list should have the form + + (MENU-TITLE REGEXP INDEX [FUNCTION] [ARGUMENTS...]) + +MENU-TITLE should be nil (in which case the matches for this +element are put in the top level of the buffer index) or a +string (which specifies the title of a submenu into which the +matches are put). +REGEXP is a regular expression matching a definition construct +which is to be displayed in the menu. REGEXP may also be a +function, called without arguments. It is expected to search +backwards. It must return true and set `match-data' if it finds +another element. +INDEX is an integer specifying which subexpression of REGEXP +matches the definition's name; this subexpression is displayed as +the menu item. +FUNCTION, if present, specifies a function to call when the index +item is selected by the user. This function is called with +arguments consisting of the item name, the buffer position, and +the ARGUMENTS. + +The variable `imenu-case-fold-search' determines whether or not +the regexp matches are case sensitive, and `imenu-syntax-alist' +can be used to alter the syntax table for the search. If non-nil this pattern is passed to `imenu--generic-function' to -create a buffer index. Look there for the documentation of this -pattern's structure. +create a buffer index. -For example, see the value of `fortran-imenu-generic-expression' used by -`fortran-mode' with `imenu-syntax-alist' set locally to give the -characters which normally have \"symbol\" syntax \"word\" syntax -during matching.") +For example, see the value of `fortran-imenu-generic-expression' +used by `fortran-mode' with `imenu-syntax-alist' set locally to +give the characters which normally have \"symbol\" syntax +\"word\" syntax during matching.") ;;;###autoload(put 'imenu-generic-expression 'risky-local-variable t) ;;;###autoload @@ -694,46 +717,16 @@ for modes which use `imenu--generic-function'. If it is not set, but ;; so it needs to be careful never to loop! (defun imenu--generic-function (patterns) "Return an index alist of the current buffer based on PATTERNS. +PATTERNS should be an alist which has the same form as +`imenu-generic-expression'. -PATTERNS is an alist with elements that look like this: - (MENU-TITLE REGEXP INDEX) -or like this: - (MENU-TITLE REGEXP INDEX FUNCTION ARGUMENTS...) -with zero or more ARGUMENTS. The former format creates a simple -element in the index alist when it matches; the latter creates a -special element of the form (INDEX-NAME POSITION-MARKER FUNCTION -ARGUMENTS...) with FUNCTION and ARGUMENTS copied from PATTERNS. - -MENU-TITLE is a string used as the title for the submenu or nil -if the entries are not nested. - -REGEXP is a regexp that should match a construct in the buffer -that is to be displayed in the menu; i.e., function or variable -definitions, etc. It contains a substring which is the name to -appear in the menu. See the info section on Regexps for more -information. REGEXP may also be a function, called without -arguments. It is expected to search backwards. It shall return -true and set `match-data' if it finds another element. - -INDEX points to the substring in REGEXP that contains the -name (of the function, variable or type) that is to appear in the -menu. - -The variable `imenu-case-fold-search' determines whether or not the -regexp matches are case sensitive, and `imenu-syntax-alist' can be -used to alter the syntax table for the search. - -See `lisp-imenu-generic-expression' for an example of PATTERNS. - -Returns an index of the current buffer as an alist. The elements in -the alist look like: +The return value is an alist of the form (INDEX-NAME . INDEX-POSITION) -or like: +or (INDEX-NAME INDEX-POSITION FUNCTION ARGUMENTS...) -They may also be nested index alists like: +The return value may also consist of nested index alists like: (INDEX-NAME . INDEX-ALIST) depending on PATTERNS." - (let ((index-alist (list 'dummy)) (case-fold-search (if (or (local-variable-p 'imenu-case-fold-search) (not (local-variable-p 'font-lock-defaults))) -- cgit v1.2.3 From 6125983ea69b948a3419cec4526f9ea9ef4268b8 Mon Sep 17 00:00:00 2001 From: Andreas Schwab Date: Tue, 7 Aug 2012 23:52:54 +0200 Subject: * emacs-lisp/lisp-mode.el (eval-defun-1): Handle standard value of a defcustom that is quoted with backquote. --- lisp/ChangeLog | 3 +++ lisp/emacs-lisp/lisp-mode.el | 4 +++- 2 files changed, 6 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp/lisp-mode.el') diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 4ef05337ccb..7a220293eac 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,8 @@ 2012-08-07 Andreas Schwab + * emacs-lisp/lisp-mode.el (eval-defun-1): Handle standard value of + a defcustom that is quoted with backquote. + * calc/calc-prog.el (math-do-defmath): Use backquote forms. Fix handling of interactive spec when the body uses return. (math-do-arg-check, math-define-function-body): Use backquote forms. diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 7e9dd9e6cfe..99677551a47 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -776,7 +776,9 @@ Reinitialize the face according to the `defface' specification." (default-boundp (eval (nth 1 form) lexical-binding))) ;; Force variable to be bound. (set-default (eval (nth 1 form) lexical-binding) - (eval (nth 1 (nth 2 form)) lexical-binding)) + ;; The value may be quoted with quote or backquote. + (eval (eval (nth 2 form) lexical-binding) + lexical-binding)) form) ;; `defface' is macroexpanded to `custom-declare-face'. ((eq (car form) 'custom-declare-face) -- cgit v1.2.3 From 4250fdf5b34a9fddf6ee1cf12270d9e269c1aa6e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 8 Aug 2012 14:56:01 -0400 Subject: * lisp/emacs-lisp/cl.el (cl-map-keymap-recursively, cl-map-intervals) (cl-map-extents): Add compatibility aliases. Fixes: debbugs:12135 --- lisp/ChangeLog | 31 ++++++++++++++++++------------- lisp/emacs-lisp/cl.el | 5 +++++ lisp/emacs-lisp/lisp-mode.el | 9 ++++++--- 3 files changed, 29 insertions(+), 16 deletions(-) (limited to 'lisp/emacs-lisp/lisp-mode.el') diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d958c028ffd..f1039adc111 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2012-08-08 Stefan Monnier + + * emacs-lisp/cl.el (cl-map-keymap-recursively, cl-map-intervals) + (cl-map-extents): Add compatibility aliases (bug#12135). + 2012-08-08 Michael Albinus * net/tramp-sh.el (tramp-find-file-exists-command): Protect the @@ -62,8 +67,8 @@ * emacs-lisp/lisp-mode.el (eval-defun-1): Handle standard value of a defcustom that is quoted with backquote. - * calc/calc-prog.el (math-do-defmath): Use backquote forms. Fix - handling of interactive spec when the body uses return. + * calc/calc-prog.el (math-do-defmath): Use backquote forms. + Fix handling of interactive spec when the body uses return. (math-do-arg-check, math-define-function-body): Use backquote forms. * calc/calc-ext.el (math-defcache): Likewise. * calc/calc-rewr.el (math-rwfail, math-rweval): Likewise. @@ -75,8 +80,8 @@ * menu-bar.el (menu-bar-make-mm-toggle, menu-bar-make-toggle): Construct menu-item directly. - * progmodes/autoconf.el (font-lock-syntactic-keywords): Don't - declare. + * progmodes/autoconf.el (font-lock-syntactic-keywords): + Don't declare. 2012-08-07 Chong Yidong @@ -142,8 +147,8 @@ * proced.el (proced): Add substitution string to docstring to trigger autoloading of the proced library on C-h f (Bug#1768). - * emacs-lisp/lisp-mode.el (lisp-imenu-generic-expression): Don't - show defvars which have no second argument (Bug#8638). + * emacs-lisp/lisp-mode.el (lisp-imenu-generic-expression): + Don't show defvars which have no second argument (Bug#8638). * imenu.el (imenu-generic-expression): Move documentation here from imenu--generic-function. @@ -221,8 +226,8 @@ * files.el (file-truename): Don't skip symlink-chasing part on windows-nt. Incorporate the resolution of 8+3 short aliases on - Windows into the loop that recursively chases symlinks. Compare - directory and its parent case-insensitively on MS-Windows and + Windows into the loop that recursively chases symlinks. + Compare directory and its parent case-insensitively on MS-Windows and MS-DOS. 2012-08-03 Chong Yidong @@ -500,7 +505,7 @@ 2012-07-27 Fabián Ezequiel Gallina - * progmodes/python.el (python-mode-map): Added keybinding for + * progmodes/python.el (python-mode-map): Add keybinding for run-python. (python-shell-make-comint): Fix pop-to-buffer call. (run-python): Autoload. New arg SHOW. @@ -516,8 +521,8 @@ 2012-07-27 Tassilo Horn - * textmodes/reftex-vars.el (reftex-label-alist-builtin): Add - support for the lstlisting and minted environments, and for the + * textmodes/reftex-vars.el (reftex-label-alist-builtin): + Add support for the lstlisting and minted environments, and for the ctable macro. * textmodes/reftex.el (reftex-compile-variables): Also recognize labels written in keyvals syntax. @@ -532,8 +537,8 @@ * makefile.w32-in ($(lisp)/calendar/cal-loaddefs.el) ($(lisp)/calendar/diary-loaddefs.el) ($(lisp)/calendar/hol-loaddefs.el, $(lisp)/mh-e/mh-loaddefs.el) - ($(lisp)/net/tramp-loaddefs.el): Depend on update-subdirs. Fixes - failures in parallel bootstrap because subdirs.el is being + ($(lisp)/net/tramp-loaddefs.el): Depend on update-subdirs. + Fixes failures in parallel bootstrap because subdirs.el is being rewritten while the autoload files are built at the same time, which needs to load subdirs.el. diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index 8174de786c7..c9ed9efe0c5 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -686,6 +686,11 @@ from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)" (define-obsolete-function-alias 'cl-hash-table-p 'hash-table-p "24.2") (define-obsolete-function-alias 'cl-hash-table-count 'hash-table-count "24.2") +(define-obsolete-function-alias 'cl-map-keymap-recursively + 'cl--map-keymap-recursively "24.2") +(define-obsolete-function-alias 'cl-map-intervals 'cl--map-intervals "24.2") +(define-obsolete-function-alias 'cl-map-extents 'cl--map-overlays "24.2") + (defun cl-maclisp-member (item list) (declare (obsolete member "24.2")) (while (and list (not (equal item (car list)))) (setq list (cdr list))) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 99677551a47..666e31f690f 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -776,9 +776,12 @@ Reinitialize the face according to the `defface' specification." (default-boundp (eval (nth 1 form) lexical-binding))) ;; Force variable to be bound. (set-default (eval (nth 1 form) lexical-binding) - ;; The value may be quoted with quote or backquote. - (eval (eval (nth 2 form) lexical-binding) - lexical-binding)) + ;; The second arg is an expression that evaluates to + ;; an expression. The second evaluation is the one + ;; normally performed not be normal execution but by + ;; custom-initialize-set (for example), which does not + ;; use lexical-binding. + (eval (eval (nth 2 form) lexical-binding))) form) ;; `defface' is macroexpanded to `custom-declare-face'. ((eq (car form) 'custom-declare-face) -- cgit v1.2.3 From 9b851e2550c1d627413ecc6c626a0dfe1bbbf33b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 9 Sep 2012 21:16:13 -0400 Subject: New emacs-lisp-byte-code-mode; misc minor changes. * lisp/emacs-lisp/lisp-mode.el (emacs-list-byte-code-comment-re): New var. (emacs-lisp-byte-code-comment) (emacs-lisp-byte-code-syntax-propertize, emacs-lisp-byte-code-mode): New functions. (eval-sexp-add-defvars): Don't skip defvars in column >0. (eval-defun-2): Remove bogus interactive spec. (lisp-indent-line): Remove redundant whole-exp code, now done in indent-according-to-mode. (save-match-data): Remove redundant indent data. * lisp/emacs-lisp/benchmark.el (benchmark-run, benchmark-run-compiled): Use `declare'. * lisp/gnus/qp.el (quoted-printable-decode-region): Inline+CSE+strength-reduction. --- lisp/ChangeLog | 15 ++++++++ lisp/emacs-lisp/benchmark.el | 6 ++-- lisp/emacs-lisp/cl-loaddefs.el | 2 +- lisp/emacs-lisp/cl-macs.el | 8 +++++ lisp/emacs-lisp/lisp-mode.el | 77 +++++++++++++++++++++++++++++++++--------- lisp/gnus/ChangeLog | 4 +++ lisp/gnus/qp.el | 20 +++++------ 7 files changed, 101 insertions(+), 31 deletions(-) (limited to 'lisp/emacs-lisp/lisp-mode.el') diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6ec52876d49..8de59875674 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,18 @@ +2012-09-10 Stefan Monnier + + * emacs-lisp/lisp-mode.el (emacs-list-byte-code-comment-re): New var. + (emacs-lisp-byte-code-comment) + (emacs-lisp-byte-code-syntax-propertize, emacs-lisp-byte-code-mode): + New functions. + (eval-sexp-add-defvars): Don't skip defvars in column >0. + (eval-defun-2): Remove bogus interactive spec. + (lisp-indent-line): Remove redundant whole-exp code, now done in + indent-according-to-mode. + (save-match-data): Remove redundant indent data. + + * emacs-lisp/benchmark.el (benchmark-run, benchmark-run-compiled): + Use `declare'. + 2012-09-09 Juri Linkov * replace.el (replace-regexp-lax-whitespace): New defcustom. diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el index 646be3e1b71..9029c81f279 100644 --- a/lisp/emacs-lisp/benchmark.el +++ b/lisp/emacs-lisp/benchmark.el @@ -53,6 +53,7 @@ FORMS once. Return a list of the total elapsed time for execution, the number of garbage collections that ran, and the time taken by garbage collection. See also `benchmark-run-compiled'." + (declare (indent 1) (debug t)) (unless (natnump repetitions) (setq forms (cons repetitions forms) repetitions 1)) @@ -69,8 +70,6 @@ See also `benchmark-run-compiled'." `(benchmark-elapse ,@forms)) (- gcs-done ,gcs) (- gc-elapsed ,gc))))) -(put 'benchmark-run 'edebug-form-spec t) -(put 'benchmark-run 'lisp-indent-function 2) ;;;###autoload (defmacro benchmark-run-compiled (&optional repetitions &rest forms) @@ -78,6 +77,7 @@ See also `benchmark-run-compiled'." This is like `benchmark-run', but what is timed is a funcall of the byte code obtained by wrapping FORMS in a `lambda' and compiling the result. The overhead of the `lambda's is accounted for." + (declare (indent 1) (debug t)) (unless (natnump repetitions) (setq forms (cons repetitions forms) repetitions 1)) @@ -96,8 +96,6 @@ result. The overhead of the `lambda's is accounted for." (funcall ,lambda-code)))) `(benchmark-elapse (funcall ,code))) (- gcs-done ,gcs) (- gc-elapsed ,gc))))) -(put 'benchmark-run-compiled 'edebug-form-spec t) -(put 'benchmark-run-compiled 'lisp-indent-function 2) ;;;###autoload (defun benchmark (repetitions form) diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index a59beaeb7ac..c12e8ccacb1 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -260,7 +260,7 @@ Remove from SYMBOL's plist the property PROPNAME and its value. ;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when ;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp ;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*) -;;;;;; "cl-macs" "cl-macs.el" "9f9bae5b8ccaf325bd59ba9be2b27c44") +;;;;;; "cl-macs" "cl-macs.el" "6d0676869af66e5b5a671f95ee069461") ;;; Generated autoloads from cl-macs.el (autoload 'cl--compiler-macro-list* "cl-macs" "\ diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 312c37261e2..16ac14f8fe9 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -1463,8 +1463,15 @@ Valid clauses are: cl--loop-accum-var)))) (defun cl--loop-build-ands (clauses) + "Return various representations of (and . CLAUSES). +CLAUSES is a list of Elisp expressions, where clauses of the form +\(progn E1 E2 E3 .. t) are the focus of particular optimizations. +The return value has shape (COND BODY COMBO) +such that COMBO is equivalent to (and . CLAUSES)." (let ((ands nil) (body nil)) + ;; Look through `clauses', trying to optimize (progn ,@A t) (progn ,@B) ,@C + ;; into (progn ,@A ,@B) ,@C. (while clauses (if (and (eq (car-safe (car clauses)) 'progn) (eq (car (last (car clauses))) t)) @@ -1475,6 +1482,7 @@ Valid clauses are: (cl-cdadr clauses) (list (cadr clauses)))) (cddr clauses))) + ;; A final (progn ,@A t) is moved outside of the `and'. (setq body (cdr (butlast (pop clauses))))) (push (pop clauses) ands))) (setq ands (or (nreverse ands) (list t))) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 666e31f690f..64aac4b81db 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -431,6 +431,61 @@ if that value is non-nil." (add-hook 'completion-at-point-functions 'lisp-completion-at-point nil 'local)) +;;; Emacs Lisp Byte-Code mode + +(eval-and-compile + (defconst emacs-list-byte-code-comment-re + (concat "\\(#\\)@\\([0-9]+\\) " + ;; Make sure it's a docstring and not a lazy-loaded byte-code. + "\\(?:[^(]\\|([^\"]\\)"))) + +(defun emacs-lisp-byte-code-comment (end &optional _point) + "Try to syntactically mark the #@NNN ....^_ docstrings in byte-code files." + (let ((ppss (syntax-ppss))) + (when (and (nth 4 ppss) + (eq (char-after (nth 8 ppss)) ?#)) + (let* ((n (save-excursion + (goto-char (nth 8 ppss)) + (when (looking-at emacs-list-byte-code-comment-re) + (string-to-number (match-string 2))))) + ;; `maxdiff' tries to make sure the loop below terminates. + (maxdiff n)) + (when n + (let* ((bchar (match-end 2)) + (b (position-bytes bchar))) + (goto-char (+ b n)) + (while (let ((diff (- (position-bytes (point)) b n))) + (unless (zerop diff) + (when (> diff maxdiff) (setq diff maxdiff)) + (forward-char (- diff)) + (setq maxdiff (if (> diff 0) diff + (max (1- maxdiff) 1))) + t)))) + (if (<= (point) end) + (put-text-property (1- (point)) (point) + 'syntax-table + (string-to-syntax "> b")) + (goto-char end))))))) + +(defun emacs-lisp-byte-code-syntax-propertize (start end) + (emacs-lisp-byte-code-comment end (point)) + (funcall + (syntax-propertize-rules + (emacs-list-byte-code-comment-re + (1 (prog1 "< b" (emacs-lisp-byte-code-comment end (point)))))) + start end)) + +(add-to-list 'auto-mode-alist '("\\.elc\\'" . emacs-lisp-byte-code-mode)) +(define-derived-mode emacs-lisp-byte-code-mode emacs-lisp-mode + "Elisp-Byte-Code" + "Major mode for *.elc files." + ;; TODO: Add way to disassemble byte-code under point. + (setq-local open-paren-in-column-0-is-defun-start nil) + (setq-local syntax-propertize-function + #'emacs-lisp-byte-code-syntax-propertize)) + +;;; Generic Lisp mode. + (defvar lisp-mode-map (let ((map (make-sparse-keymap)) (menu-map (make-sparse-keymap "Lisp"))) @@ -730,10 +785,12 @@ POS specifies the starting position where EXP was found and defaults to point." (let ((vars ())) (goto-char (point-min)) (while (re-search-forward - "^(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)" + "(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)" pos t) (let ((var (intern (match-string 1)))) - (unless (special-variable-p var) + (and (not (special-variable-p var)) + (save-excursion + (zerop (car (syntax-ppss (match-beginning 0))))) (push var vars)))) `(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp))))) @@ -820,7 +877,6 @@ if it already has a value.\) With argument, insert value in current buffer after the defun. Return the result of evaluation." - (interactive "P") ;; FIXME: the print-length/level bindings should only be applied while ;; printing, not while evaluating. (let ((debug-on-error eval-expression-debug-on-error) @@ -925,6 +981,7 @@ rigidly along with this one." (if (or (null indent) (looking-at "\\s<\\s<\\s<")) ;; Don't alter indentation of a ;;; comment line ;; or a line that starts in a string. + ;; FIXME: inconsistency: comment-indent moves ;;; to column 0. (goto-char (- (point-max) pos)) (if (and (looking-at "\\s<") (not (looking-at "\\s<\\s<"))) ;; Single-semicolon comment lines should be indented @@ -939,18 +996,7 @@ rigidly along with this one." ;; If initial point was within line's indentation, ;; position after the indentation. Else stay at same point in text. (if (> (- (point-max) pos) (point)) - (goto-char (- (point-max) pos))) - ;; If desired, shift remaining lines of expression the same amount. - (and whole-exp (not (zerop shift-amt)) - (save-excursion - (goto-char beg) - (forward-sexp 1) - (setq end (point)) - (goto-char beg) - (forward-line 1) - (setq beg (point)) - (> end beg)) - (indent-code-rigidly beg end shift-amt))))) + (goto-char (- (point-max) pos)))))) (defvar calculate-lisp-indent-last-sexp) @@ -1230,7 +1276,6 @@ Lisp function does not specify a special indentation." (put 'prog2 'lisp-indent-function 2) (put 'save-excursion 'lisp-indent-function 0) (put 'save-restriction 'lisp-indent-function 0) -(put 'save-match-data 'lisp-indent-function 0) (put 'save-current-buffer 'lisp-indent-function 0) (put 'let 'lisp-indent-function 1) (put 'let* 'lisp-indent-function 1) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index d9f80103435..5644c394f7e 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,7 @@ +2012-09-10 Stefan Monnier + + * qp.el (quoted-printable-decode-region): Inline+CSE+strength-reduction. + 2012-09-07 Chong Yidong * gnus-util.el diff --git a/lisp/gnus/qp.el b/lisp/gnus/qp.el index bfa1fe0a6d4..c4487c68b5c 100644 --- a/lisp/gnus/qp.el +++ b/lisp/gnus/qp.el @@ -53,14 +53,7 @@ them into characters should be done separately." ;; or both of which are lowercase letters in "abcdef", is ;; formally illegal. A robust implementation might choose to ;; recognize them as the corresponding uppercase letters.'' - (let ((case-fold-search t) - (decode-hex #'(lambda (n1 n2) - (+ (* (if (<= n1 ?9) (- n1 ?0) - (if (<= n1 ?F) (+ (- n1 ?A) 10) - (+ (- n1 ?a) 10))) 16) - (if (<= n2 ?9) (- n2 ?0) - (if (<= n2 ?F) (+ (- n2 ?A) 10) - (+ (- n2 ?a) 10))))))) + (let ((case-fold-search t)) (narrow-to-region from to) ;; Do this in case we're called from Gnus, say, in a buffer ;; which already contains non-ASCII characters which would @@ -78,8 +71,15 @@ them into characters should be done separately." (let* ((n (/ (- (match-end 0) (point)) 3)) (str (make-string n 0))) (dotimes (i n) - (aset str i (funcall decode-hex (char-after (1+ (point))) - (char-after (+ 2 (point))))) + (let ((n1 (char-after (1+ (point)))) + (n2 (char-after (+ 2 (point))))) + (aset str i + (+ (* 16 (- n1 (if (<= n1 ?9) ?0 + (if (<= n1 ?F) (- ?A 10) + (- ?a 10))))) + (- n2 (if (<= n2 ?9) ?0 + (if (<= n2 ?F) (- ?A 10) + (- ?a 10))))))) (forward-char 3)) (delete-region (match-beginning 0) (match-end 0)) (insert str))) -- cgit v1.2.3