summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/authors.el79
-rw-r--r--lisp/emacs-lisp/autoload.el150
-rw-r--r--lisp/emacs-lisp/bytecomp.el40
-rw-r--r--lisp/emacs-lisp/cl-loaddefs.el5
-rw-r--r--lisp/emacs-lisp/cl-macs.el62
-rw-r--r--lisp/emacs-lisp/derived.el2
-rw-r--r--lisp/emacs-lisp/easy-mmode.el80
-rw-r--r--lisp/emacs-lisp/lisp-mnt.el4
-rw-r--r--lisp/emacs-lisp/lisp-mode.el13
-rw-r--r--lisp/emacs-lisp/lisp.el41
10 files changed, 330 insertions, 146 deletions
diff --git a/lisp/emacs-lisp/authors.el b/lisp/emacs-lisp/authors.el
index 7728215bb91..7093ca78d3d 100644
--- a/lisp/emacs-lisp/authors.el
+++ b/lisp/emacs-lisp/authors.el
@@ -220,6 +220,9 @@ If REALNAME is nil, ignore that author.")
'("vc-\\*\\.el$"
"spec.txt$"
".*loaddefs.el$" ; not obsolete, but auto-generated
+ "\\.\\(cvs\\|git\\)ignore$" ; obsolete or uninteresting
+ "\\.arch-inventory$"
+ "preferences\\.\\(nib\\|gorm\\)"
"vc-\\(rcs\\|cvs\\|sccs\\)-hooks\\.el$")
"List of regexps matching obsolete files.
Changes to files matching one of the regexps in this list are not
@@ -244,6 +247,14 @@ listed.")
"Imakefile" "icons/sink.ico" "aixcc.lex"
"nxml/char-name/unicode"
"js2-mode.el" ; only installed very briefly, replaced by js.el
+ "cedet/tests/testtemplates.cpp"
+ "cedet/tests/testusing.cpp"
+ "cedet/tests/scopetest.cpp"
+ "cedet/tests/scopetest.java"
+ "cedet/tests/test.cpp"
+ "cedet/tests/test.py"
+ "cedet/tests/teststruct.cpp"
+ "*.el"
;; Autogen:
"cus-load.el" "finder-inf.el" "ldefs-boot.el"
;; Never had any meaningful changes logged, now deleted:
@@ -286,6 +297,42 @@ listed.")
"List of files and directories to ignore.
Changes to files in this list are not listed.")
+;; List via: find . -name '*.el' | sed 's/.*\///g' | sort | uniq -d
+;; FIXME It would be better to discover these dynamically.
+;; Note that traditionally "Makefile.in" etc have not been in this list.
+;; Ditto for "abbrev.texi" etc.
+(defconst authors-ambiguous-files
+ '("chart.el"
+ "compile.el"
+ "complete.el"
+ "cpp.el"
+ "ctxt.el"
+ "debug.el"
+ "dired.el"
+ "el.el"
+ "files.el"
+ "find.el"
+ "format.el"
+ "grep.el"
+ "imenu.el"
+ "java.el"
+ "linux.el"
+ "locate.el"
+ "make.el"
+ "mode.el"
+ "python.el"
+ "semantic.el"
+ "shell.el"
+ "simple.el"
+ "sort.el"
+ "speedbar.el"
+ "srecode.el"
+ "table.el"
+ "texi.el"
+ "util.el"
+ "wisent.el")
+ "List of basenames occurring more than once in the source.")
+
;; FIXME :cowrote entries here can be overwritten by :wrote entries
;; derived from a file's Author: header (eg mh-e). This really means
;; the Author: header is erroneous.
@@ -427,6 +474,7 @@ Changes to files in this list are not listed.")
("Geoff Voelker" :wrote "w32-fns.el" "w32.c" "w32.h" "w32heap.c"
"w32heap.h" "w32inevt.c" "w32proc.c" "w32term.c" "ms-w32.h")
("Morten Welinder" :wrote "dosfns.c" "[many MS-DOS files]" "msdos.h")
+ ("Eli Zaretskii" :wrote "bidi.c" "[bidirectional display in xdisp.c]")
;; Not using this version any more.
;;; ("Pace Willisson" :wrote "ispell.el")
;; FIXME overwritten by Author:.
@@ -463,11 +511,14 @@ Changes to files in this list are not listed.")
"emacs16_mac.png" "emacs24_mac.png"
"emacs256_mac.png" "emacs32_mac.png"
"emacs48_mac.png" "emacs512_mac.png"
+ "revdiff" ; admin/
+ "mainmake" "sed1.inp" "sed2.inp" "sed3.inp" ; msdos/
+ "mac-fix-env.m"
;; Deleted vms stuff:
"temacs.opt" "descrip.mms" "compile.com" "link.com"
)
- "File names which are valid, but no longer exist (or cannot be
-found) in the repository.")
+ "File names which are valid, but no longer exist (or cannot be found)
+in the repository.")
(defconst authors-renamed-files-alist
'(("nt.c" . "w32.c") ("nt.h" . "w32.h")
@@ -504,6 +555,7 @@ found) in the repository.")
;; index and pick merged into search.
("mh-index.el" . "mh-search.el")
("mh-pick.el" . "mh-search.el")
+ ("font-setting.el" . "dynamic-setting.el")
;; INSTALL-CVS -> .CVS -> .BZR
("INSTALL-CVS" . "INSTALL.BZR")
("INSTALL.CVS" . "INSTALL.BZR")
@@ -529,6 +581,7 @@ found) in the repository.")
("schema/docbook-dyntbl.rnc" . "schema/docbk-dyntbl.rnc")
("schema/docbook-soextbl.rnc" . "schema/docbk-soextbl.rn" )
("texi/url.txi" . "url.texi")
+ ("edt-user.doc" . "edt.texi")
;; Moved to different directories.
("ctags.1" . "ctags.1")
("etags.1" . "etags.1")
@@ -573,10 +626,25 @@ Otherwise, the file name is accepted as is.")
(defvar authors-checked-files-alist)
(defvar authors-invalid-file-names)
+(defun authors-disambiguate-file-name (fullname)
+ "Convert FULLNAME to an unambiguous relative-name."
+ (let ((relname (file-name-nondirectory fullname))
+ parent)
+ (if (member relname authors-ambiguous-files)
+ ;; In case of ambiguity, just prepend the parent directory.
+ ;; FIXME obviously this is not a perfect solution.
+ (if (string-equal "lisp"
+ (setq parent (file-name-nondirectory
+ (directory-file-name
+ (file-name-directory fullname)))))
+ relname
+ (format "%s/%s" parent relname))
+ relname)))
+
(defun authors-canonical-file-name (file log-file pos author)
"Return canonical file name for FILE found in LOG-FILE.
Checks whether FILE is a valid (existing) file name, has been renamed,
-or is on the list of removed files. Returns the non-diretory part of
+or is on the list of removed files. Returns the non-directory part of
the file name. Only uses the LOG-FILE position POS and associated AUTHOR
to print a message if FILE is not found."
;; FILE should be re-checked in every different directory associated
@@ -593,7 +661,7 @@ to print a message if FILE is not found."
(file-exists-p file)
(file-exists-p relname)
(file-exists-p (concat "etc/" relname)))
- (setq valid relname)
+ (setq valid (authors-disambiguate-file-name fullname))
(setq valid (assoc file authors-renamed-files-alist))
(if valid
(setq valid (cdr valid))
@@ -610,6 +678,7 @@ to print a message if FILE is not found."
(cons (cons fullname valid) authors-checked-files-alist))
(unless (or valid
(member file authors-ignored-files)
+ (authors-obsolete-file-p file)
(string-match "[*]" file)
(string-match "^[0-9.]+$" file))
(setq authors-invalid-file-names
@@ -758,7 +827,7 @@ TABLE is a hash table to add author information to."
(enable-local-variables :safe) ; for find-file, hence let*
(enable-local-eval nil)
(buffer (find-file-noselect file)))
- (setq file (file-name-nondirectory file))
+ (setq file (authors-disambiguate-file-name (expand-file-name file)))
(with-current-buffer buffer
(save-restriction
(widen)
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index c985aae07b6..c5316d06429 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -1,7 +1,8 @@
;; autoload.el --- maintain autoloads in loaddefs.el
;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; 2004, 2005, 2006, 2007, 2008, 2009, 2010
+;; Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
;; Keywords: maint
@@ -258,14 +259,17 @@ put the output in."
TYPE (default \"autoloads\") is a string stating the type of
information contained in FILE. If FEATURE is non-nil, FILE
will provide a feature. FEATURE may be a string naming the
-feature, otherwise it will be based on FILE's name."
+feature, otherwise it will be based on FILE's name.
+
+At present, a feature is in fact always provided, but this should
+not be relied upon."
(let ((basename (file-name-nondirectory file)))
(concat ";;; " basename
" --- automatically extracted " (or type "autoloads") "\n"
";;\n"
";;; Code:\n\n"
" \n"
- ;; This is used outside of autoload.el.
+ ;; This is used outside of autoload.el, eg cus-dep, finder.
"(provide '"
(if (stringp feature)
feature
@@ -324,7 +328,29 @@ which lists the file name and which functions are in it, etc."
"File local variable to prevent scanning this file for autoload cookies.")
(defun autoload-file-load-name (file)
- (let ((name (file-name-nondirectory file)))
+ "Compute the name that will be used to load FILE."
+ ;; OUTFILE should be the name of the global loaddefs.el file, which
+ ;; is expected to be at the root directory of the files we're
+ ;; scanning for autoloads and will be in the `load-path'.
+ (let* ((outfile (default-value 'generated-autoload-file))
+ (name (file-relative-name file (file-name-directory outfile)))
+ (names '())
+ (dir (file-name-directory outfile)))
+ ;; If `name' has directory components, only keep the
+ ;; last few that are really needed.
+ (while name
+ (setq name (directory-file-name name))
+ (push (file-name-nondirectory name) names)
+ (setq name (file-name-directory name)))
+ (while (not name)
+ (cond
+ ((null (cdr names)) (setq name (car names)))
+ ((file-exists-p (expand-file-name "subdirs.el" dir))
+ ;; FIXME: here we only check the existence of subdirs.el,
+ ;; without checking its content. This makes it generate wrong load
+ ;; names for cases like lisp/term which is not added to load-path.
+ (setq dir (expand-file-name (pop names) dir)))
+ (t (setq name (mapconcat 'identity names "/")))))
(if (string-match "\\.elc?\\(\\.\\|\\'\\)" name)
(substring name 0 (match-beginning 0))
name)))
@@ -339,6 +365,8 @@ Return non-nil in the case where no autoloads were added at point."
(interactive "fGenerate autoloads for file: ")
(autoload-generate-file-autoloads file (current-buffer)))
+(defvar print-readably)
+
;; When called from `generate-file-autoloads' we should ignore
;; `generated-autoload-file' altogether. When called from
;; `update-file-autoloads' we don't know `outbuf'. And when called from
@@ -369,9 +397,8 @@ Return non-nil if and only if FILE adds no autoloads to OUTFILE
(visited (get-file-buffer file))
(otherbuf nil)
(absfile (expand-file-name file))
- relfile
;; nil until we found a cookie.
- output-start)
+ output-start ostart)
(with-current-buffer (or visited
;; It is faster to avoid visiting the file.
(autoload-find-file file))
@@ -381,7 +408,10 @@ Return non-nil if and only if FILE adds no autoloads to OUTFILE
(setq load-name
(if (stringp generated-autoload-load-name)
generated-autoload-load-name
- (autoload-file-load-name file)))
+ (autoload-file-load-name absfile)))
+ (when (and outfile
+ (not (equal outfile (autoload-generated-file))))
+ (setq otherbuf t))
(save-excursion
(save-restriction
(widen)
@@ -392,26 +422,22 @@ Return non-nil if and only if FILE adds no autoloads to OUTFILE
((looking-at (regexp-quote generate-autoload-cookie))
;; If not done yet, figure out where to insert this text.
(unless output-start
- (when (and outfile
- (not (equal outfile (autoload-generated-file))))
- ;; A file-local setting of autoload-generated-file says
- ;; we should ignore OUTBUF.
- (setq outbuf nil)
- (setq otherbuf t))
- (unless outbuf
- (setq outbuf (autoload-find-destination absfile))
- (unless outbuf
- ;; The file has autoload cookies, but they're
- ;; already up-to-date. If OUTFILE is nil, the
- ;; entries are in the expected OUTBUF, otherwise
- ;; they're elsewhere.
- (throw 'done outfile)))
- (with-current-buffer outbuf
- (setq relfile (file-relative-name absfile))
- (setq output-start (point)))
- ;; (message "file=%S, relfile=%S, dest=%S"
- ;; file relfile (autoload-generated-file))
- )
+ (let ((outbuf
+ (or (if otherbuf
+ ;; A file-local setting of
+ ;; autoload-generated-file says we
+ ;; should ignore OUTBUF.
+ nil
+ outbuf)
+ (autoload-find-destination absfile load-name)
+ ;; The file has autoload cookies, but they're
+ ;; already up-to-date. If OUTFILE is nil, the
+ ;; entries are in the expected OUTBUF,
+ ;; otherwise they're elsewhere.
+ (throw 'done otherbuf))))
+ (with-current-buffer outbuf
+ (setq output-start (point-marker)
+ ostart (point)))))
(search-forward generate-autoload-cookie)
(skip-chars-forward " \t")
(if (eolp)
@@ -423,7 +449,8 @@ Return non-nil if and only if FILE adds no autoloads to OUTFILE
(if autoload
(push (nth 1 form) autoloads-done)
(setq autoload form))
- (let ((autoload-print-form-outbuf outbuf))
+ (let ((autoload-print-form-outbuf
+ (marker-buffer output-start)))
(autoload-print-form autoload)))
(error
(message "Error in %s: %S" file err)))
@@ -438,7 +465,7 @@ Return non-nil if and only if FILE adds no autoloads to OUTFILE
(forward-char 1))
(point))
(progn (forward-line 1) (point)))
- outbuf)))
+ (marker-buffer output-start))))
((looking-at ";")
;; Don't read the comment.
(forward-line 1))
@@ -450,40 +477,44 @@ Return non-nil if and only if FILE adds no autoloads to OUTFILE
(let ((secondary-autoloads-file-buf
(if (local-variable-p 'generated-autoload-file)
(current-buffer))))
- (with-current-buffer outbuf
+ (with-current-buffer (marker-buffer output-start)
(save-excursion
;; Insert the section-header line which lists the file name
;; and which functions are in it, etc.
+ (assert (= ostart output-start))
(goto-char output-start)
- (autoload-insert-section-header
- outbuf autoloads-done load-name relfile
- (if secondary-autoloads-file-buf
- ;; MD5 checksums are much better because they do not
- ;; change unless the file changes (so they'll be
- ;; equal on two different systems and will change
- ;; less often than time-stamps, thus leading to fewer
- ;; unneeded changes causing spurious conflicts), but
- ;; using time-stamps is a very useful optimization,
- ;; so we use time-stamps for the main autoloads file
- ;; (loaddefs.el) where we have special ways to
- ;; circumvent the "random change problem", and MD5
- ;; checksum in secondary autoload files where we do
- ;; not need the time-stamp optimization because it is
- ;; already provided by the primary autoloads file.
- (md5 secondary-autoloads-file-buf
- ;; We'd really want to just use
- ;; `emacs-internal' instead.
- nil nil 'emacs-mule-unix)
- (nth 5 (file-attributes relfile))))
- (insert ";;; Generated autoloads from " relfile "\n"))
+ (let ((relfile (file-relative-name absfile)))
+ (autoload-insert-section-header
+ (marker-buffer output-start)
+ autoloads-done load-name relfile
+ (if secondary-autoloads-file-buf
+ ;; MD5 checksums are much better because they do not
+ ;; change unless the file changes (so they'll be
+ ;; equal on two different systems and will change
+ ;; less often than time-stamps, thus leading to fewer
+ ;; unneeded changes causing spurious conflicts), but
+ ;; using time-stamps is a very useful optimization,
+ ;; so we use time-stamps for the main autoloads file
+ ;; (loaddefs.el) where we have special ways to
+ ;; circumvent the "random change problem", and MD5
+ ;; checksum in secondary autoload files where we do
+ ;; not need the time-stamp optimization because it is
+ ;; already provided by the primary autoloads file.
+ (md5 secondary-autoloads-file-buf
+ ;; We'd really want to just use
+ ;; `emacs-internal' instead.
+ nil nil 'emacs-mule-unix)
+ (nth 5 (file-attributes relfile))))
+ (insert ";;; Generated autoloads from " relfile "\n")))
(insert generate-autoload-section-trailer))))
(message "Generating autoloads for %s...done" file))
(or visited
;; We created this buffer, so we should kill it.
(kill-buffer (current-buffer))))
- ;; If the entries were added to some other buffer, then the file
- ;; doesn't add entries to OUTFILE.
- (or (not output-start) otherbuf))))
+ (or (not output-start)
+ ;; If the entries were added to some other buffer, then the file
+ ;; doesn't add entries to OUTFILE.
+ otherbuf))))
(defun autoload-save-buffers ()
(while autoload-modified-buffers
@@ -507,15 +538,14 @@ Return FILE if there was no autoload cookie in it, else nil."
(message "Autoload section for %s is up to date." file)))
(if no-autoloads file)))
-(defun autoload-find-destination (file)
+(defun autoload-find-destination (file load-name)
"Find the destination point of the current buffer's autoloads.
FILE is the file name of the current buffer.
Returns a buffer whose point is placed at the requested location.
Returns nil if the file's autoloads are uptodate, otherwise
removes any prior now out-of-date autoload entries."
(catch 'up-to-date
- (let* ((load-name (autoload-file-load-name file))
- (buf (current-buffer))
+ (let* ((buf (current-buffer))
(existing-buffer (if buffer-file-name buf))
(found nil))
(with-current-buffer
@@ -528,7 +558,7 @@ removes any prior now out-of-date autoload entries."
(unless (zerop (coding-system-eol-type buffer-file-coding-system))
(set-buffer-file-coding-system 'unix))
(or (> (buffer-size) 0)
- (error "Autoloads file %s does not exist" buffer-file-name))
+ (error "Autoloads file %s lacks boilerplate" buffer-file-name))
(or (file-writable-p buffer-file-name)
(error "Autoloads file %s is not writable" buffer-file-name))
(widen)
@@ -648,6 +678,7 @@ directory or directories specified."
(t
(autoload-remove-section (match-beginning 0))
(if (autoload-generate-file-autoloads
+ ;; Passing `current-buffer' makes it insert at point.
file (current-buffer) buffer-file-name)
(push file no-autoloads))))
(push file done)
@@ -656,6 +687,9 @@ directory or directories specified."
(dolist (file files)
(cond
((member (expand-file-name file) autoload-excludes) nil)
+ ;; Passing nil as second argument forces
+ ;; autoload-generate-file-autoloads to look for the right
+ ;; spot where to insert each autoloads section.
((autoload-generate-file-autoloads file nil buffer-file-name)
(push file no-autoloads))))
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index b593596a526..0c3a7b69798 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -3333,21 +3333,31 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
(setq for-effect nil)))
(defun byte-compile-setq-default (form)
- (let ((bytecomp-args (cdr form))
- setters)
- (while bytecomp-args
- (let ((var (car bytecomp-args)))
- (and (or (not (symbolp var))
- (byte-compile-const-symbol-p var t))
- (byte-compile-warning-enabled-p 'constants)
- (byte-compile-warn
- "variable assignment to %s `%s'"
- (if (symbolp var) "constant" "nonvariable")
- (prin1-to-string var)))
- (push (list 'set-default (list 'quote var) (car (cdr bytecomp-args)))
- setters))
- (setq bytecomp-args (cdr (cdr bytecomp-args))))
- (byte-compile-form (cons 'progn (nreverse setters)))))
+ (setq form (cdr form))
+ (if (> (length form) 2)
+ (let ((setters ()))
+ (while (consp form)
+ (push `(setq-default ,(pop form) ,(pop form)) setters))
+ (byte-compile-form (cons 'progn (nreverse setters))))
+ (let ((var (car form)))
+ (and (or (not (symbolp var))
+ (byte-compile-const-symbol-p var t))
+ (byte-compile-warning-enabled-p 'constants)
+ (byte-compile-warn
+ "variable assignment to %s `%s'"
+ (if (symbolp var) "constant" "nonvariable")
+ (prin1-to-string var)))
+ (byte-compile-normal-call `(set-default ',var ,@(cdr form))))))
+
+(byte-defop-compiler-1 set-default)
+(defun byte-compile-set-default (form)
+ (let ((varexp (car-safe (cdr-safe form))))
+ (if (eq (car-safe varexp) 'quote)
+ ;; If the varexp is constant, compile it as a setq-default
+ ;; so we get more warnings.
+ (byte-compile-setq-default `(setq-default ,(car-safe (cdr varexp))
+ ,@(cddr form)))
+ (byte-compile-normal-call form))))
(defun byte-compile-quote (form)
(byte-compile-constant (car (cdr form))))
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el
index bdae05e7774..e828325bd0e 100644
--- a/lisp/emacs-lisp/cl-loaddefs.el
+++ b/lisp/emacs-lisp/cl-loaddefs.el
@@ -282,7 +282,7 @@ Not documented
;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist
;;;;;; do* do loop return-from return block etypecase typecase ecase
;;;;;; case load-time-value eval-when destructuring-bind function*
-;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "273ba25f4a116c61a464dbe55f1f8c63")
+;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "0faa39d8f21ae59f2cc1baa835e28a5f")
;;; Generated autoloads from cl-macs.el
(autoload 'gensym "cl-macs" "\
@@ -1242,7 +1242,6 @@ Keywords supported: :test :test-not :key
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
+;; coding: utf-8
;; End:
-
-;; arch-tag: 08cc5aab-e992-47f6-992e-12a7428c1a0e
;;; cl-loaddefs.el ends here
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 8a60ffdf1fe..57870b19066 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -128,6 +128,12 @@
(and (eq (cl-const-expr-p x) t) (if (consp x) (nth 1 x) x)))
(defun cl-expr-access-order (x v)
+ ;; This apparently tries to return nil iff the expression X evaluates
+ ;; the variables V in the same order as they appear in V (so as to
+ ;; be able to replace those vars with the expressions they're bound
+ ;; to).
+ ;; FIXME: This is very naive, it doesn't even check to see if those
+ ;; variables appear more than once.
(if (cl-const-expr-p x) v
(if (consp x)
(progn
@@ -1763,6 +1769,7 @@ Example:
(defsetf frame-visible-p cl-set-frame-visible-p)
(defsetf frame-width set-screen-width t)
(defsetf frame-parameter set-frame-parameter t)
+(defsetf terminal-parameter set-terminal-parameter)
(defsetf getenv setenv t)
(defsetf get-register set-register)
(defsetf global-key-binding global-set-key)
@@ -1815,10 +1822,26 @@ Example:
(defsetf x-get-secondary-selection x-own-secondary-selection t)
(defsetf x-get-selection x-own-selection t)
+;; This is a hack that allows (setf (eq a 7) B) to mean either
+;; (setq a 7) or (setq a nil) depending on whether B is nil or not.
+;; This is useful when you have control over the PLACE but not over
+;; the VALUE, as is the case in define-minor-mode's :variable.
+(define-setf-method eq (place val)
+ (let ((method (get-setf-method place cl-macro-environment))
+ (val-temp (make-symbol "--eq-val--"))
+ (store-temp (make-symbol "--eq-store--")))
+ (list (append (nth 0 method) (list val-temp))
+ (append (nth 1 method) (list val))
+ (list store-temp)
+ `(let ((,(car (nth 2 method))
+ (if ,store-temp ,val-temp (not ,val-temp))))
+ ,(nth 3 method) ,store-temp)
+ `(eq ,(nth 4 method) ,val-temp))))
+
;;; More complex setf-methods.
-;;; These should take &environment arguments, but since full arglists aren't
-;;; available while compiling cl-macs, we fake it by referring to the global
-;;; variable cl-macro-environment directly.
+;; These should take &environment arguments, but since full arglists aren't
+;; available while compiling cl-macs, we fake it by referring to the global
+;; variable cl-macro-environment directly.
(define-setf-method apply (func arg1 &rest rest)
(or (and (memq (car-safe func) '(quote function function*))
@@ -2616,21 +2639,36 @@ surrounded by (block NAME ...).
(cons '&cl-quote args))
(list* 'cl-defsubst-expand (list 'quote argns)
(list 'quote (list* 'block name body))
- (not (or unsafe (cl-expr-access-order pbody argns)))
+ ;; We used to pass `simple' as
+ ;; (not (or unsafe (cl-expr-access-order pbody argns)))
+ ;; But this is much too simplistic since it
+ ;; does not pay attention to the argvs (and
+ ;; cl-expr-access-order itself is also too naive).
+ nil
(and (memq '&key args) 'cl-whole) unsafe argns)))
(list* 'defun* name args body))))
(defun cl-defsubst-expand (argns body simple whole unsafe &rest argvs)
(if (and whole (not (cl-safe-expr-p (cons 'progn argvs)))) whole
(if (cl-simple-exprs-p argvs) (setq simple t))
- (let ((lets (delq nil
- (mapcar* (function
- (lambda (argn argv)
- (if (or simple (cl-const-expr-p argv))
- (progn (setq body (subst argv argn body))
- (and unsafe (list argn argv)))
- (list argn argv))))
- argns argvs))))
+ (let* ((substs ())
+ (lets (delq nil
+ (mapcar* (function
+ (lambda (argn argv)
+ (if (or simple (cl-const-expr-p argv))
+ (progn (push (cons argn argv) substs)
+ (and unsafe (list argn argv)))
+ (list argn argv))))
+ argns argvs))))
+ ;; FIXME: `sublis/subst' will happily substitute the symbol
+ ;; `argn' in places where it's not used as a reference
+ ;; to a variable.
+ ;; FIXME: `sublis/subst' will happily copy `argv' to a different
+ ;; scope, leading to name capture.
+ (setq body (cond ((null substs) body)
+ ((null (cdr substs))
+ (subst (cdar substs) (caar substs) body))
+ (t (sublis substs body))))
(if lets (list 'let lets body) body))))
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index debef5535f5..d6f717ccda7 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -230,7 +230,7 @@ No problems result if this variable is not bound.
; Run the parent.
(delay-mode-hooks
- (,(or parent 'kill-all-local-variables))
+ (,(or parent 'fundamental-mode))
; Identify the child mode.
(setq major-mode (quote ,child))
(setq mode-name ,name)
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 13e08667839..5a21946183e 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -116,6 +116,11 @@ BODY contains code to execute each time the mode is activated or deactivated.
:lighter SPEC Same as the LIGHTER argument.
:keymap MAP Same as the KEYMAP argument.
:require SYM Same as in `defcustom'.
+:variable PLACE The location (as can be used with `setf') to use instead
+ of the variable MODE to store the state of the mode. PLACE
+ can also be of the form (GET . SET) where GET is an expression
+ that returns the current state and SET is a function that takes
+ a new state and sets it.
For example, you could write
(define-minor-mode foo-mode \"If enabled, foo on you!\"
@@ -147,6 +152,9 @@ For example, you could write
(type nil)
(extra-args nil)
(extra-keywords nil)
+ (variable nil) ;The PLACE where the state is stored.
+ (setter nil) ;The function (if any) to set the mode var.
+ (modefun mode) ;The minor mode function name we're defining.
(require t)
(hook (intern (concat mode-name "-hook")))
(hook-on (intern (concat mode-name "-on-hook")))
@@ -167,6 +175,12 @@ For example, you could write
(:type (setq type (list :type (pop body))))
(:require (setq require (pop body)))
(:keymap (setq keymap (pop body)))
+ (:variable (setq variable (pop body))
+ (if (not (functionp (cdr-safe variable)))
+ ;; PLACE is not of the form (GET . SET).
+ (setq mode variable)
+ (setq mode (car variable))
+ (setq setter (cdr variable))))
(t (push keyw extra-keywords) (push (pop body) extra-keywords))))
(setq keymap-sym (if (and keymap (symbolp keymap)) keymap
@@ -187,12 +201,16 @@ For example, you could write
`(progn
;; Define the variable to enable or disable the mode.
- ,(if (not globalp)
- `(progn
- (defvar ,mode ,init-value ,(format "Non-nil if %s is enabled.
+ ,(cond
+ ;; If :variable is specified, then the var will be
+ ;; declared elsewhere.
+ (variable nil)
+ ((not globalp)
+ `(progn
+ (defvar ,mode ,init-value ,(format "Non-nil if %s is enabled.
Use the command `%s' to change this variable." pretty-name mode))
- (make-variable-buffer-local ',mode))
-
+ (make-variable-buffer-local ',mode)))
+ (t
(let ((base-doc-string
(concat "Non-nil if %s is enabled.
See the command `%s' for a description of this minor mode."
@@ -207,10 +225,10 @@ or call the function `%s'."))))
,@group
,@type
,@(unless (eq require t) `(:require ,require))
- ,@(nreverse extra-keywords))))
+ ,@(nreverse extra-keywords)))))
;; The actual function.
- (defun ,mode (&optional arg ,@extra-args)
+ (defun ,modefun (&optional arg ,@extra-args)
,(or doc
(format (concat "Toggle %s on or off.
Interactively, with no prefix argument, toggle the mode.
@@ -221,22 +239,19 @@ With zero or negative ARG turn mode off.
;; repeat-command still does the toggling correctly.
(interactive (list (or current-prefix-arg 'toggle)))
(let ((,last-message (current-message)))
- (setq ,mode
- (cond
- ((eq arg 'toggle) (not ,mode))
- (arg (> (prefix-numeric-value arg) 0))
- (t
- (if (null ,mode) t
- (message
- "Toggling %s off; better pass an explicit argument."
- ',mode)
- nil))))
+ (,@(if setter (list setter)
+ (list (if (symbolp mode) 'setq 'setf) mode))
+ (if (eq arg 'toggle)
+ (not ,mode)
+ ;; A nil argument also means ON now.
+ (> (prefix-numeric-value arg) 0)))
,@body
;; The on/off hooks are here for backward compatibility only.
(run-hooks ',hook (if ,mode ',hook-on ',hook-off))
(if (called-interactively-p 'any)
(progn
- ,(if globalp `(customize-mark-as-set ',mode))
+ ,(if (and globalp (symbolp mode))
+ `(customize-mark-as-set ',mode))
;; Avoid overwriting a message shown by the body,
;; but do overwrite previous messages.
(unless (and (current-message)
@@ -261,9 +276,15 @@ With zero or negative ARG turn mode off.
(t (error "Invalid keymap %S" ,keymap))))
,(format "Keymap for `%s'." mode-name)))
- (add-minor-mode ',mode ',lighter
- ,(if keymap keymap-sym
- `(if (boundp ',keymap-sym) ,keymap-sym))))))
+ ,(if (not (symbolp mode))
+ (if (or lighter keymap)
+ (error ":lighter and :keymap unsupported with mode expression %s" mode))
+ `(with-no-warnings
+ (add-minor-mode ',mode ',lighter
+ ,(if keymap keymap-sym
+ `(if (boundp ',keymap-sym) ,keymap-sym))
+ nil
+ ,(unless (eq mode modefun) 'modefun)))))))
;;;
;;; make global minor mode
@@ -343,9 +364,11 @@ See `%s' for more information on %s."
(progn
(add-hook 'after-change-major-mode-hook
',MODE-enable-in-buffers)
+ (add-hook 'fundamental-mode-hook ',MODE-enable-in-buffers)
(add-hook 'find-file-hook ',MODE-check-buffers)
(add-hook 'change-major-mode-hook ',MODE-cmhh))
(remove-hook 'after-change-major-mode-hook ',MODE-enable-in-buffers)
+ (remove-hook 'fundamental-mode-hook ',MODE-enable-in-buffers)
(remove-hook 'find-file-hook ',MODE-check-buffers)
(remove-hook 'change-major-mode-hook ',MODE-cmhh))
@@ -366,13 +389,14 @@ See `%s' for more information on %s."
(dolist (buf ,MODE-buffers)
(when (buffer-live-p buf)
(with-current-buffer buf
- (if ,mode
- (unless (eq ,MODE-major-mode major-mode)
- (,mode -1)
- (,turn-on)
- (setq ,MODE-major-mode major-mode))
- (,turn-on)
- (setq ,MODE-major-mode major-mode))))))
+ (unless (eq ,MODE-major-mode major-mode)
+ (if ,mode
+ (progn
+ (,mode -1)
+ (,turn-on)
+ (setq ,MODE-major-mode major-mode))
+ (,turn-on)
+ (setq ,MODE-major-mode major-mode)))))))
(put ',MODE-enable-in-buffers 'definition-name ',global-mode)
(defun ,MODE-check-buffers ()
diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el
index 8a1c753f5f6..10b7baf294f 100644
--- a/lisp/emacs-lisp/lisp-mnt.el
+++ b/lisp/emacs-lisp/lisp-mnt.el
@@ -458,7 +458,9 @@ each line."
"Return list of keywords given in file FILE."
(let ((keywords (lm-keywords file)))
(if keywords
- (split-string keywords "[, \t\n]+" t))))
+ (if (string-match-p "," keywords)
+ (split-string keywords ",[ \t\n]*" t)
+ (split-string keywords "[ \t\n]+" t)))))
(defvar finder-known-keywords)
(defun lm-keywords-finder-p (&optional file)
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 4b58a4e68c2..4a7f59e26fb 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -466,7 +466,7 @@ if that value is non-nil."
"Keymap for ordinary Lisp mode.
All commands in `lisp-mode-shared-map' are inherited by this map.")
-(defun lisp-mode ()
+(define-derived-mode lisp-mode nil "Lisp"
"Major mode for editing Lisp code for Lisps other than GNU Emacs Lisp.
Commands:
Delete converts tabs to spaces as it moves back.
@@ -478,19 +478,12 @@ or to switch back to an existing one.
Entry to this mode calls the value of `lisp-mode-hook'
if that value is non-nil."
- (interactive)
- (kill-all-local-variables)
- (use-local-map lisp-mode-map)
- (setq major-mode 'lisp-mode)
- (setq mode-name "Lisp")
(lisp-mode-variables nil t)
+ (set (make-local-variable 'find-tag-default-function) 'lisp-find-tag-default)
(make-local-variable 'comment-start-skip)
(setq comment-start-skip
"\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *")
- (setq imenu-case-fold-search t)
- (set-syntax-table lisp-mode-syntax-table)
- (run-mode-hooks 'lisp-mode-hook))
-(put 'lisp-mode 'find-tag-default-function 'lisp-find-tag-default)
+ (setq imenu-case-fold-search t))
(defun lisp-find-tag-default ()
(let ((default (find-tag-default)))
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index 54fa4d615cd..4ef6dab8968 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -624,21 +624,25 @@ considered."
(interactive)
(let* ((data (lisp-completion-at-point predicate))
(plist (nthcdr 3 data)))
- (let ((completion-annotate-function (plist-get plist :annotate-function)))
+ (if (null data)
+ (minibuffer-message "Nothing to complete")
+ (let ((completion-annotate-function
+ (plist-get plist :annotate-function)))
(completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)
- (plist-get plist :predicate)))))
+ (plist-get plist :predicate))))))
(defun lisp-completion-at-point (&optional predicate)
"Function used for `completion-at-point-functions' in `emacs-lisp-mode'."
;; FIXME: the `end' could be after point?
- (let* ((end (point))
+ (let* ((pos (point))
(beg (with-syntax-table emacs-lisp-mode-syntax-table
- (save-excursion
- (backward-sexp 1)
- (while (= (char-syntax (following-char)) ?\')
- (forward-char 1))
- (point))))
+ (condition-case nil
+ (save-excursion
+ (backward-sexp 1)
+ (skip-syntax-forward "'")
+ (point))
+ (scan-error pos))))
(predicate
(or predicate
(save-excursion
@@ -657,12 +661,23 @@ considered."
;; Maybe a `let' varlist or something.
nil
;; Else, we assume that a function name is expected.
- 'fboundp))))))
- (list beg end obarray
- :predicate predicate
- :annotate-function
+ 'fboundp)))))
+ (end
+ (unless (or (eq beg (point-max))
+ (member (char-syntax (char-after beg)) '(?\" ?\( ?\))))
+ (condition-case nil
+ (save-excursion
+ (goto-char beg)
+ (forward-sexp 1)
+ (when (>= (point) pos)
+ (point)))
+ (scan-error pos)))))
+ (when end
+ (list beg end obarray
+ :predicate predicate
+ :annotate-function
(unless (eq predicate 'fboundp)
- (lambda (str) (if (fboundp (intern-soft str)) " <f>"))))))
+ (lambda (str) (if (fboundp (intern-soft str)) " <f>")))))))
;; arch-tag: aa7fa8a4-2e6f-4e9b-9cd9-fef06340e67e
;;; lisp.el ends here
generated by cgit v1.2.3 (git 2.39.1) at 2025-05-09 05:59:38 +0000