diff options
Diffstat (limited to 'lisp/emacs-lisp')
27 files changed, 172 insertions, 283 deletions
diff --git a/lisp/emacs-lisp/assoc.el b/lisp/emacs-lisp/assoc.el deleted file mode 100644 index 264374ed721..00000000000 --- a/lisp/emacs-lisp/assoc.el +++ /dev/null @@ -1,139 +0,0 @@ -;;; assoc.el --- insert/delete functions on association lists - -;; Copyright (C) 1996, 2001-2012 Free Software Foundation, Inc. - -;; Author: Barry A. Warsaw <bwarsaw@cen.com> -;; Keywords: extensions - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Association list utilities providing insertion, deletion, sorting -;; fetching off key-value pairs in association lists. - -;;; Code: -(eval-when-compile (require 'cl)) - -(defun asort (alist-symbol key) - "Move a specified key-value pair to the head of an alist. -The alist is referenced by ALIST-SYMBOL. Key-value pair to move to -head is one matching KEY. Returns the sorted list and doesn't affect -the order of any other key-value pair. Side effect sets alist to new -sorted list." - (set alist-symbol - (sort (copy-alist (symbol-value alist-symbol)) - (function (lambda (a b) (equal (car a) key)))))) - - -(defun aelement (key value) - "Make a list of a cons cell containing car of KEY and cdr of VALUE. -The returned list is suitable for concatenating with an existing -alist, via `nconc'." - (list (cons key value))) - - -(defun aheadsym (alist) - "Return the key symbol at the head of ALIST." - (car (car alist))) - - -(defun anot-head-p (alist key) - "Find out if a specified key-value pair is not at the head of an alist. -The alist to check is specified by ALIST and the key-value pair is the -one matching the supplied KEY. Returns nil if ALIST is nil, or if -key-value pair is at the head of the alist. Returns t if key-value -pair is not at the head of alist. ALIST is not altered." - (not (equal (aheadsym alist) key))) - - -(defun aput (alist-symbol key &optional value) - "Insert a key-value pair into an alist. -The alist is referenced by ALIST-SYMBOL. The key-value pair is made -from KEY and optionally, VALUE. Returns the altered alist. - -If the key-value pair referenced by KEY can be found in the alist, and -VALUE is supplied non-nil, then the value of KEY will be set to VALUE. -If VALUE is not supplied, or is nil, the key-value pair will not be -modified, but will be moved to the head of the alist. If the key-value -pair cannot be found in the alist, it will be inserted into the head -of the alist (with value nil if VALUE is nil or not supplied)." - (lexical-let ((elem (aelement key value)) - alist) - (asort alist-symbol key) - (setq alist (symbol-value alist-symbol)) - (cond ((null alist) (set alist-symbol elem)) - ((anot-head-p alist key) (set alist-symbol (nconc elem alist))) - (value (setcar alist (car elem)) alist) - (t alist)))) - - -(defun adelete (alist-symbol key) - "Delete a key-value pair from the alist. -Alist is referenced by ALIST-SYMBOL and the key-value pair to remove -is pair matching KEY. Returns the altered alist." - (asort alist-symbol key) - (lexical-let ((alist (symbol-value alist-symbol))) - (cond ((null alist) nil) - ((anot-head-p alist key) alist) - (t (set alist-symbol (cdr alist)))))) - - -(defun aget (alist key &optional keynil-p) - "Return the value in ALIST that is associated with KEY. -Optional KEYNIL-P describes what to do if the value associated with -KEY is nil. If KEYNIL-P is not supplied or is nil, and the value is -nil, then KEY is returned. If KEYNIL-P is non-nil, then nil would be -returned. - -If no key-value pair matching KEY could be found in ALIST, or ALIST is -nil then nil is returned. ALIST is not altered." - (let ((copy (copy-alist alist))) - (cond ((null alist) nil) - ((progn (asort 'copy key) - (anot-head-p copy key)) nil) - ((cdr (car copy))) - (keynil-p nil) - ((car (car copy))) - (t nil)))) - - -(defun amake (alist-symbol keylist &optional valuelist) - "Make an association list. -The association list is attached to the alist referenced by -ALIST-SYMBOL. Each element in the KEYLIST becomes a key and is -associated with the value in VALUELIST with the same index. If -VALUELIST is not supplied or is nil, then each key in KEYLIST is -associated with nil. - -KEYLIST and VALUELIST should have the same number of elements, but -this isn't enforced. If VALUELIST is smaller than KEYLIST, remaining -keys are associated with nil. If VALUELIST is larger than KEYLIST, -extra values are ignored. Returns the created alist." - (lexical-let ((keycar (car keylist)) - (keycdr (cdr keylist)) - (valcar (car valuelist)) - (valcdr (cdr valuelist))) - (cond ((null keycdr) - (aput alist-symbol keycar valcar)) - (t - (amake alist-symbol keycdr valcdr) - (aput alist-symbol keycar valcar)))) - (symbol-value alist-symbol)) - -(provide 'assoc) - -;;; assoc.el ends here diff --git a/lisp/emacs-lisp/authors.el b/lisp/emacs-lisp/authors.el index 6f2c6f73eca..a7f8dad54ed 100644 --- a/lisp/emacs-lisp/authors.el +++ b/lisp/emacs-lisp/authors.el @@ -1,4 +1,4 @@ -;;; authors.el --- utility for maintaining Emacs's AUTHORS file -*-coding: utf-8;-*- +;;; authors.el --- utility for maintaining Emacs's AUTHORS file -*-coding: utf-8 -*- ;; Copyright (C) 2000-2012 Free Software Foundation, Inc. @@ -829,7 +829,7 @@ with the file and the number of each action: (enable-local-eval nil) (existing-buffer (get-file-buffer log-file)) (buffer (find-file-noselect log-file)) - authors file pos) + authors pos) (with-current-buffer buffer (save-restriction (widen) @@ -943,8 +943,7 @@ and changed by AUTHOR." (file (car change)) (filestat (if (authors-public-domain-p file) (concat file " (public domain)") - file)) - slot) + file))) (cond ((assq :wrote actions) (setq wrote-list (cons filestat wrote-list))) ((assq :cowrote actions) diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 5af666b9ded..921b08b10a8 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -762,9 +762,6 @@ write its autoloads into the specified file instead." (define-obsolete-function-alias 'update-autoloads-from-directories 'update-directory-autoloads "22.1") -(defvar autoload-make-program (or (getenv "MAKE") "make") - "Name of the make program in use during the Emacs build process.") - ;;;###autoload (defun batch-update-autoloads () "Update loaddefs.el autoloads in batch mode. diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el index 9f348767478..1f00677cd00 100644 --- a/lisp/emacs-lisp/avl-tree.el +++ b/lisp/emacs-lisp/avl-tree.el @@ -260,7 +260,7 @@ Return t if the height of the tree has grown." (opp (avl-tree--switch-dir dir)) ;; direction 0,1 -> sign factor -1,+1 (sgn (avl-tree--dir-to-sign dir)) - p1 p2 b2 result) + p1 p2 b2) (cond ((< (* sgn (avl-tree--node-balance br)) 0) (setf (avl-tree--node-balance br) 0) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 78ac29d89df..3b324a09659 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1237,7 +1237,7 @@ string-to-multibyte tan truncate unibyte-char-to-multibyte upcase user-full-name - user-login-name user-original-login-name user-variable-p + user-login-name user-original-login-name custom-variable-p vconcat window-buffer window-dedicated-p window-edges window-height window-hscroll window-minibuffer-p window-width diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 93c6518d215..9cb0a376e36 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2267,19 +2267,7 @@ list that represents a doc string reference. (when (byte-compile-warning-enabled-p 'callargs) (byte-compile-nogroup-warn form)) (push (nth 1 (nth 1 form)) byte-compile-bound-variables) - ;; Don't compile the expression because it may be displayed to the user. - ;; (when (eq (car-safe (nth 2 form)) 'quote) - ;; ;; (nth 2 form) is meant to evaluate to an expression, so if we have the - ;; ;; final value already, we can byte-compile it. - ;; (setcar (cdr (nth 2 form)) - ;; (byte-compile-top-level (cadr (nth 2 form)) nil 'file))) - (let ((tail (nthcdr 4 form))) - (while tail - (unless (keywordp (car tail)) ;No point optimizing keywords. - ;; Compile the keyword arguments. - (setcar tail (byte-compile-top-level (car tail) nil 'file))) - (setq tail (cdr tail)))) - form) + (byte-compile-keep-pending form)) (put 'require 'byte-hunk-handler 'byte-compile-file-form-require) (defun byte-compile-file-form-require (form) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index b6b6a78a9bb..3ce0eadab55 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -639,7 +639,9 @@ and updates the data stored in ENV." (cconv-analyse-form (cadr forms) env) (setq forms (cddr forms)))) - (`((lambda . ,_) . ,_) ; first element is lambda expression + (`((lambda . ,_) . ,_) ; First element is lambda expression. + (byte-compile-log-warning + "Use of deprecated ((lambda ...) ...) form" t :warning) (dolist (exp `((function ,(car form)) . ,(cdr form))) (cconv-analyse-form exp env))) diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el index 19766feac5a..2e3abb2e9d3 100644 --- a/lisp/emacs-lisp/chart.el +++ b/lisp/emacs-lisp/chart.el @@ -82,7 +82,7 @@ Colors will be the background color.") Useful if new Emacs is used on B&W display.") (defcustom chart-face-use-pixmaps nil - "*Non-nil to use fancy pixmaps in the background of chart face colors." + "Non-nil to use fancy pixmaps in the background of chart face colors." :group 'eieio :type 'boolean) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 7a9a33fc2cc..ee8cbd2c3bc 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -916,7 +916,7 @@ is the starting location. If this is nil, `point-min' is used instead." (progn (goto-char wrong) (if (not take-notes) - (error "%s" (checkdoc-error-text msg))))) + (user-error "%s" (checkdoc-error-text msg))))) (checkdoc-show-diagnostics) (if (called-interactively-p 'interactive) (message "No style warnings.")))) @@ -949,7 +949,7 @@ if there is one." (e (checkdoc-file-comments-engine)) (checkdoc-generate-compile-warnings-flag (or take-notes checkdoc-generate-compile-warnings-flag))) - (if e (error "%s" (checkdoc-error-text e))) + (if e (user-error "%s" (checkdoc-error-text e))) (checkdoc-show-diagnostics) e)) @@ -987,7 +987,7 @@ Optional argument TAKE-NOTES causes all errors to be logged." (if (not (called-interactively-p 'interactive)) e (if e - (error "%s" (checkdoc-error-text e)) + (user-error "%s" (checkdoc-error-text e)) (checkdoc-show-diagnostics))) (goto-char p)) (if (called-interactively-p 'interactive) @@ -1027,19 +1027,14 @@ space at the end of each line." (car (memq checkdoc-spellcheck-documentation-flag '(defun t)))) (beg (save-excursion (beginning-of-defun) (point))) - (end (save-excursion (end-of-defun) (point))) - (msg (checkdoc-this-string-valid))) - (if msg (if no-error - (message "%s" (checkdoc-error-text msg)) - (error "%s" (checkdoc-error-text msg))) - (setq msg (checkdoc-message-text-search beg end)) - (if msg (if no-error - (message "%s" (checkdoc-error-text msg)) - (error "%s" (checkdoc-error-text msg))) - (setq msg (checkdoc-rogue-space-check-engine beg end)) - (if msg (if no-error - (message "%s" (checkdoc-error-text msg)) - (error "%s" (checkdoc-error-text msg)))))) + (end (save-excursion (end-of-defun) (point)))) + (dolist (fun (list #'checkdoc-this-string-valid + (lambda () (checkdoc-message-text-search beg end)) + (lambda () (checkdoc-rogue-space-check-engine beg end)))) + (let ((msg (funcall fun))) + (if msg (if no-error + (message "%s" (checkdoc-error-text msg)) + (user-error "%s" (checkdoc-error-text msg)))))) (if (called-interactively-p 'interactive) (message "Checkdoc: done.")))))) @@ -2644,12 +2639,6 @@ function called to create the messages." (custom-add-option 'emacs-lisp-mode-hook 'checkdoc-minor-mode) -(add-to-list 'debug-ignored-errors - "Argument `.*' should appear (as .*) in the doc string") -(add-to-list 'debug-ignored-errors - "Lisp symbol `.*' should appear in quotes") -(add-to-list 'debug-ignored-errors "Disambiguate .* by preceding .*") - (provide 'checkdoc) ;;; checkdoc.el ends here diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 9ac5ce7d2f0..9a3d8cf705b 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -1,6 +1,6 @@ ;;; cl-extra.el --- Common Lisp features, part 2 -;; Copyright (C) 1993, 2000-2012 Free Software Foundation, Inc. +;; Copyright (C) 1993, 2000-2012 Free Software Foundation, Inc. ;; Author: Dave Gillespie <daveg@synaptics.com> ;; Keywords: extensions @@ -430,7 +430,6 @@ With two arguments, return rounding and remainder of their quotient." ;; Random numbers. -(defvar *random-state*) ;;;###autoload (defun random* (lim &optional state) "Return a random nonnegative number less than LIM, an integer or float. diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 5bb86628bb8..48be2f72972 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -10,7 +10,7 @@ ;;;;;; ceiling* floor* isqrt lcm gcd cl-progv-before cl-set-frame-visible-p ;;;;;; cl-map-overlays cl-map-intervals cl-map-keymap-recursively ;;;;;; notevery notany every some mapcon mapcan mapl maplist map -;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "c172dda6770ce18b556561481bfefbb2") +;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "5a8a7f7ec2dc453113b8cbda577f2acb") ;;; Generated autoloads from cl-extra.el (autoload 'coerce "cl-extra" "\ @@ -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" "91b45885535a73dd8015973cb8c988e1") +;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "abb2e33c6f61539d69ddbe7c4046261b") ;;; Generated autoloads from cl-macs.el (autoload 'gensym "cl-macs" "\ diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 4fc71bbbc60..35cda8cfcf6 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -1483,18 +1483,24 @@ lexical closures as in Common Lisp. (cons 'progn body) (nconc (mapcar (function (lambda (x) (list (symbol-name (car x)) - (list 'symbol-value (caddr x)) + (list 'symbol-value (caddr x)) t))) vars) (list '(defun . cl-defun-expander)) cl-macro-environment)))) (if (not (get (car (last cl-closure-vars)) 'used)) - (list 'let (mapcar (function (lambda (x) - (list (caddr x) (cadr x)))) vars) - (sublis (mapcar (function (lambda (x) - (cons (caddr x) - (list 'quote (caddr x))))) - vars) - ebody)) + ;; Turn (let ((foo (gensym))) (set foo <val>) ...(symbol-value foo)...) + ;; into (let ((foo <val>)) ...(symbol-value 'foo)...). + ;; This is good because it's more efficient but it only works with + ;; dynamic scoping, since with lexical scoping we'd need + ;; (let ((foo <val>)) ...foo...). + `(progn + ,@(mapcar (lambda (x) `(defvar ,(caddr x))) vars) + (let ,(mapcar (lambda (x) (list (caddr x) (cadr x))) vars) + ,(sublis (mapcar (lambda (x) + (cons (caddr x) + (list 'quote (caddr x)))) + vars) + ebody))) (list 'let (mapcar (function (lambda (x) (list (caddr x) (list 'make-symbol diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el index 09b456b54ba..8e96d95c5dd 100644 --- a/lisp/emacs-lisp/copyright.el +++ b/lisp/emacs-lisp/copyright.el @@ -110,7 +110,7 @@ When this is `function', only ask when called non-interactively." ;; This is a defvar rather than a defconst, because the year can ;; change during the Emacs session. -(defvar copyright-current-year (substring (current-time-string) -4) +(defvar copyright-current-year (format-time-string "%Y") "String representing the current year.") (defsubst copyright-limit () ; re-search-forward BOUND @@ -181,8 +181,7 @@ skips to the end of all the years." ;; This uses the match-data from copyright-find-copyright/end. (goto-char (match-end 1)) (copyright-find-end) - ;; Note that `current-time-string' isn't locale-sensitive. - (setq copyright-current-year (substring (current-time-string) -4)) + (setq copyright-current-year (format-time-string "%Y")) (unless (string= (buffer-substring (- (match-end 3) 2) (match-end 3)) (substring copyright-current-year -2)) (if (or noquery @@ -347,7 +346,7 @@ independently replaces consecutive years with a range." "Insert a copyright by $ORGANIZATION notice at cursor." "Company: " comment-start - "Copyright (C) " `(substring (current-time-string) -4) " by " + "Copyright (C) " `(format-time-string "%Y") " by " (or (getenv "ORGANIZATION") str) '(if (copyright-offset-too-large-p) diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 0d6716a2e63..301947f0735 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -572,8 +572,6 @@ BODY is executed after moving to the destination location." (when was-narrowed (,narrowfun))))))) (unless name (setq name base-name)) `(progn - (add-to-list 'debug-ignored-errors - ,(concat "^No \\(previous\\|next\\) " (regexp-quote name))) (defun ,next-sym (&optional count) ,(format "Go to the next COUNT'th %s." name) (interactive "p") @@ -584,7 +582,7 @@ BODY is executed after moving to the destination location." `(if (not (re-search-forward ,re nil t count)) (if (looking-at ,re) (goto-char (or ,(if endfun `(,endfun)) (point-max))) - (error "No next %s" ,name)) + (user-error "No next %s" ,name)) (goto-char (match-beginning 0)) (when (and (eq (current-buffer) (window-buffer (selected-window))) (called-interactively-p 'interactive)) @@ -603,7 +601,7 @@ BODY is executed after moving to the destination location." (if (< count 0) (,next-sym (- count)) ,(funcall when-narrowed `(unless (re-search-backward ,re nil t count) - (error "No previous %s" ,name))) + (user-error "No previous %s" ,name))) ,@body)) (put ',prev-sym 'definition-name ',base)))) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 67ffd6d5d31..f47feebe5d2 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -3744,7 +3744,7 @@ This prints the value into current buffer." ;; FIXME eh? (defvar gud-inhibit-global-bindings - "*Non-nil means don't do global rebindings of C-x C-a subcommands.") + "Non-nil means don't do global rebindings of C-x C-a subcommands.") ;; Global GUD bindings for all emacs-lisp-mode buffers. (unless gud-inhibit-global-bindings diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el index 10816aaa43c..a899839f68a 100644 --- a/lisp/emacs-lisp/eieio-opt.el +++ b/lisp/emacs-lisp/eieio-opt.el @@ -72,8 +72,7 @@ Argument CH-PREFIX is another character prefix to display." ;;; CLASS COMPLETION / DOCUMENTATION -;;;###autoload -(defalias 'describe-class 'eieio-describe-class) +;;;###autoload(defalias 'describe-class 'eieio-describe-class) ;;;###autoload (defun eieio-describe-class (class &optional headerfcn) @@ -305,8 +304,7 @@ are not abstract." ;;; METHOD COMPLETION / DOC (defalias 'describe-method 'eieio-describe-generic) -;;;###autoload -(defalias 'describe-generic 'eieio-describe-generic) +;;;###autoload(defalias 'describe-generic 'eieio-describe-generic) (defalias 'eieio-describe-method 'eieio-describe-generic) ;;;###autoload diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index cdf7237b766..768eba58ee1 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -79,7 +79,7 @@ ;; (defvar eieio-hook nil - "*This hook is executed, then cleared each time `defclass' is called.") + "This hook is executed, then cleared each time `defclass' is called.") (defvar eieio-error-unsupported-class-tags nil "Non-nil to throw an error if an encountered tag is unsupported. @@ -87,7 +87,7 @@ This may prevent classes from CLOS applications from being used with EIEIO since EIEIO does not support all CLOS tags.") (defvar eieio-skip-typecheck nil - "*If non-nil, skip all slot typechecking. + "If non-nil, skip all slot typechecking. Set this to t permanently if a program is functioning well to get a small speed increase. This variable is also used internally to handle default setting for optimization purposes.") @@ -2044,7 +2044,7 @@ During executions, the list is first generated, then as each next method is called, the next method is popped off the stack.") (defvar eieio-pre-method-execution-hooks nil - "*Hooks run just before a method is executed. + "Hooks run just before a method is executed. The hook function must accept one argument, the list of forms about to be executed.") @@ -3051,7 +3051,7 @@ Optional argument GROUP is the sub-group of slots to display. ;;;### (autoloads (eieio-help-mode-augmentation-maybee eieio-describe-generic ;;;;;; eieio-describe-constructor eieio-describe-class eieio-browse) -;;;;;; "eieio-opt" "eieio-opt.el" "e2814881441ad23759409687502f0ee1") +;;;;;; "eieio-opt" "eieio-opt.el" "d808328f9c0156ecbd412d77ba8c569e") ;;; Generated autoloads from eieio-opt.el (autoload 'eieio-browse "eieio-opt" "\ @@ -3060,7 +3060,6 @@ If optional ROOT-CLASS, then start with that, otherwise start with variable `eieio-default-superclass'. \(fn &optional ROOT-CLASS)" t nil) - (defalias 'describe-class 'eieio-describe-class) (autoload 'eieio-describe-class "eieio-opt" "\ @@ -3075,7 +3074,6 @@ Describe the constructor function FCN. Uses `eieio-describe-class' to describe the class being constructed. \(fn FCN)" t nil) - (defalias 'describe-generic 'eieio-describe-generic) (autoload 'eieio-describe-generic "eieio-opt" "\ diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 257d0528cbc..a7916354c91 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2008, 2010-2012 Free Software Foundation, Inc. ;; Author: Lennart Borgman (lennart O borgman A gmail O com) -;; Author: Christian Ohler <ohler@gnu.org> +;; Christian Ohler <ohler@gnu.org> ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 9cbe29bf322..ad5e20cb8a4 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -1405,7 +1405,7 @@ RESULT must be an `ert-test-result-with-condition'." ;;; Running tests in batch mode. (defvar ert-batch-backtrace-right-margin 70 - "*The maximum line length for printing backtraces in `ert-run-tests-batch'.") + "The maximum line length for printing backtraces in `ert-run-tests-batch'.") ;;;###autoload (defun ert-run-tests-batch (&optional selector) diff --git a/lisp/emacs-lisp/ewoc.el b/lisp/emacs-lisp/ewoc.el index 4fd87209b38..9e214a9703c 100644 --- a/lisp/emacs-lisp/ewoc.el +++ b/lisp/emacs-lisp/ewoc.el @@ -1,4 +1,4 @@ -;;; ewoc.el --- utility to maintain a view of a list of objects in a buffer +;;; ewoc.el --- utility to maintain a view of a list of objects in a buffer -*- lexical-binding: t -*- ;; Copyright (C) 1991-2012 Free Software Foundation, Inc. @@ -216,10 +216,9 @@ NODE and leaving the new node's start there. Return the new node." (ewoc--adjust m (point) R dll))) (defun ewoc--wrap (func) - (lexical-let ((ewoc--user-pp func)) - (lambda (data) - (funcall ewoc--user-pp data) - (insert "\n")))) + (lambda (data) + (funcall func data) + (insert "\n"))) ;;; =========================================================================== diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 4efdc3240cd..bcb7fab026b 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -447,7 +447,21 @@ Optional ARG is ignored." ;; Try first in this order for the sake of languages with nested ;; functions where several can end at the same place as with ;; the offside rule, e.g. Python. - (beginning-of-defun) + + ;; Finding the start of the function is a bit problematic since + ;; `beginning-of-defun' when we are on the first character of + ;; the function might go to the previous function. + ;; + ;; Therefore we first move one character forward and then call + ;; `beginning-of-defun'. However now we must check that we did + ;; not move into the next function. + (let ((here (point))) + (unless (eolp) + (forward-char)) + (beginning-of-defun) + (when (< (point) here) + (goto-char here) + (beginning-of-defun))) (setq beg (point)) (end-of-defun) (setq end (point)) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 5b158eb994f..4b868f72899 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -524,7 +524,7 @@ Required package `%s-%s' is unavailable" (defun define-package (name-string version-string &optional docstring requirements - &rest extra-properties) + &rest _extra-properties) "Define a new package. NAME-STRING is the name of the package, as a string. VERSION-STRING is the version of the package, as a string. @@ -584,7 +584,7 @@ EXTRA-PROPERTIES is currently unused." (defun package-generate-autoloads (name pkg-dir) (require 'autoload) ;Load before we let-bind generated-autoload-file! (let* ((auto-name (concat name "-autoloads.el")) - (ignore-name (concat name "-pkg.el")) + ;;(ignore-name (concat name "-pkg.el")) (generated-autoload-file (expand-file-name auto-name pkg-dir)) (version-control 'never)) (unless (fboundp 'autoload-ensure-default-file) @@ -1389,7 +1389,7 @@ If REMEMBER-POS is non-nil, keep point on the same entry. PACKAGES should be t, which means to display all known packages, or a list of package names (symbols) to display." ;; Construct list of ((PACKAGE . VERSION) STATUS DESCRIPTION). - (let (info-list name builtin) + (let (info-list name) ;; Installed packages: (dolist (elt package-alist) (setq name (car elt)) @@ -1474,21 +1474,21 @@ If optional arg BUTTON is non-nil, describe its associated package." (describe-package package)))) ;; fixme numeric argument -(defun package-menu-mark-delete (&optional num) +(defun package-menu-mark-delete (&optional _num) "Mark a package for deletion and move to the next line." (interactive "p") (if (member (package-menu-get-status) '("installed" "obsolete")) (tabulated-list-put-tag "D" t) (forward-line))) -(defun package-menu-mark-install (&optional num) +(defun package-menu-mark-install (&optional _num) "Mark a package for installation and move to the next line." (interactive "p") (if (string-equal (package-menu-get-status) "available") (tabulated-list-put-tag "I" t) (forward-line))) -(defun package-menu-mark-unmark (&optional num) +(defun package-menu-mark-unmark (&optional _num) "Clear any marks on a package and move to the next line." (interactive "p") (tabulated-list-put-tag " " t)) @@ -1530,8 +1530,7 @@ If optional arg BUTTON is non-nil, describe its associated package." (dolist (entry tabulated-list-entries) ;; ENTRY is ((NAME . VERSION) [NAME VERSION STATUS DOC]) (let ((pkg (car entry)) - (status (aref (cadr entry) 2)) - old) + (status (aref (cadr entry) 2))) (cond ((equal status "installed") (push pkg installed)) ((equal status "available") diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index afbc5df85ce..0d115cc56f5 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -148,6 +148,7 @@ of the form (UPAT EXP)." `(let ,(nreverse bindings) (pcase-let* ,matches ,@body))))) (defmacro pcase-dolist (spec &rest body) + (declare (indent 1)) (if (pcase--trivial-upat-p (car spec)) `(dolist ,spec ,@body) (let ((tmpvar (make-symbol "x"))) @@ -217,10 +218,10 @@ of the form (UPAT EXP)." (cdr case)))) cases)))) (if (null defs) main - `(let ,defs ,main)))) + (pcase--let* defs main)))) (defun pcase-codegen (code vars) - `(let ,(mapcar (lambda (b) (list (car b) (cdr b))) vars) + `(let* ,(mapcar (lambda (b) (list (car b) (cdr b))) vars) ,@code)) (defun pcase--small-branch-p (code) @@ -255,6 +256,13 @@ of the form (UPAT EXP)." ((memq (car-safe then) '(if cond)) (pcase--if `(not ,test) else then)) (t `(if ,test ,then ,else)))) +;; Again, try and reduce nesting. +(defun pcase--let* (binders body) + (if (eq (car-safe body) 'let*) + `(let* ,(append binders (nth 1 body)) + ,@(nthcdr 2 body)) + `(let* ,binders ,body))) + (defun pcase--upat (qpattern) (cond ((eq (car-safe qpattern) '\,) (cadr qpattern)) @@ -433,26 +441,26 @@ MATCH is the pattern that needs to be matched, of the form: (defun pcase--split-pred (upat pat) ;; FIXME: For predicates like (pred (> a)), two such predicates may ;; actually refer to different variables `a'. - (cond - ((equal upat pat) (cons :pcase--succeed :pcase--fail)) - ((and (eq 'pred (car upat)) - (eq 'pred (car-safe pat)) - (or (member (cons (cadr upat) (cadr pat)) - pcase-mutually-exclusive-predicates) - (member (cons (cadr pat) (cadr upat)) - pcase-mutually-exclusive-predicates))) - (cons :pcase--fail nil)) - ;; ((and (eq 'pred (car upat)) - ;; (eq '\` (car-safe pat)) - ;; (symbolp (cadr upat)) - ;; (or (symbolp (cadr pat)) (stringp (cadr pat)) (numberp (cadr pat))) - ;; (get (cadr upat) 'side-effect-free) - ;; (progn (message "Trying predicate %S" (cadr upat)) - ;; (ignore-errors - ;; (funcall (cadr upat) (cadr pat))))) - ;; (message "Simplify pred %S against %S" upat pat) - ;; (cons nil :pcase--fail)) - )) + (let (test) + (cond + ((equal upat pat) (cons :pcase--succeed :pcase--fail)) + ((and (eq 'pred (car upat)) + (eq 'pred (car-safe pat)) + (or (member (cons (cadr upat) (cadr pat)) + pcase-mutually-exclusive-predicates) + (member (cons (cadr pat) (cadr upat)) + pcase-mutually-exclusive-predicates))) + (cons :pcase--fail nil)) + ((and (eq 'pred (car upat)) + (eq '\` (car-safe pat)) + (symbolp (cadr upat)) + (or (symbolp (cadr pat)) (stringp (cadr pat)) (numberp (cadr pat))) + (get (cadr upat) 'side-effect-free) + (ignore-errors + (setq test (list (funcall (cadr upat) (cadr pat)))))) + (if (car test) + (cons nil :pcase--fail) + (cons :pcase--fail nil)))))) (defun pcase--fgrep (vars sexp) "Check which of the symbols VARS appear in SEXP." @@ -673,16 +681,22 @@ Otherwise, it defers to REST which is a list of branches of the form ;; The byte-compiler could do that for us, but it would have to pay ;; attention to the `consp' test in order to figure out that car/cdr ;; can't signal errors and our byte-compiler is not that clever. - `(let (,@(if (get syma 'pcase-used) `((,syma (car ,sym)))) + ;; FIXME: Some of those let bindings occur too early (they are used in + ;; `then-body', but only within some sub-branch). + (pcase--let* + `(,@(if (get syma 'pcase-used) `((,syma (car ,sym)))) ,@(if (get symd 'pcase-used) `((,symd (cdr ,sym))))) - ,then-body) + then-body) (pcase--u else-rest)))) ((or (integerp qpat) (symbolp qpat) (stringp qpat)) (let* ((splitrest (pcase--split-rest sym (apply-partially 'pcase--split-equal qpat) rest)) (then-rest (car splitrest)) (else-rest (cdr splitrest))) - (pcase--if `(,(if (stringp qpat) #'equal #'eq) ,sym ',qpat) + (pcase--if (cond + ((stringp qpat) `(equal ,sym ,qpat)) + ((null qpat) `(null ,sym)) + (t `(eq ,sym ',qpat))) (pcase--u1 matches code vars then-rest) (pcase--u else-rest)))) (t (error "Unknown QPattern %s" qpat)))) diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el index 6d12fe19277..72e3c398dc0 100644 --- a/lisp/emacs-lisp/regexp-opt.el +++ b/lisp/emacs-lisp/regexp-opt.el @@ -136,9 +136,6 @@ This means the number of non-shy regexp grouping constructs ;;; Workhorse functions. -(eval-when-compile - (require 'cl)) - (defun regexp-opt-group (strings &optional paren lax) "Return a regexp to match a string in the sorted list STRINGS. If PAREN non-nil, output regexp parentheses around returned regexp. @@ -248,15 +245,15 @@ Merges keywords to avoid backtracking in Emacs's regexp matcher." ;; ;; Make a character map but extract character set meta characters. (dolist (char chars) - (case char - (?\] - (setq bracket "]")) - (?^ - (setq caret "^")) - (?- - (setq dash "-")) - (otherwise - (aset charmap char t)))) + (cond + ((eq char ?\]) + (setq bracket "]")) + ((eq char ?^) + (setq caret "^")) + ((eq char ?-) + (setq dash "-")) + (t + (aset charmap char t)))) ;; ;; Make a character set from the map using ranges where applicable. (map-char-table @@ -268,14 +265,14 @@ Merges keywords to avoid backtracking in Emacs's regexp matcher." (setq charset (format "%s%c-%c" charset start end)) (while (>= end start) (setq charset (format "%s%c" charset start)) - (incf start))) + (setq start (1+ start)))) (setq start (car c) end (cdr c))) (if (= (1- c) end) (setq end c) (if (> end (+ start 2)) (setq charset (format "%s%c-%c" charset start end)) (while (>= end start) (setq charset (format "%s%c" charset start)) - (incf start))) + (setq start (1+ start)))) (setq start c end c))))) charmap) (when (>= end start) @@ -283,7 +280,7 @@ Merges keywords to avoid backtracking in Emacs's regexp matcher." (setq charset (format "%s%c-%c" charset start end)) (while (>= end start) (setq charset (format "%s%c" charset start)) - (incf start)))) + (setq start (1+ start))))) ;; ;; Make sure a caret is not first and a dash is first or last. (if (and (string-equal charset "") (string-equal bracket "")) diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index 2a12f03e514..cafa1942a09 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -1602,6 +1602,36 @@ to which that point should be aligned, if we were to reindent it.") (save-excursion (indent-line-to indent)) (indent-line-to indent))))) +(defun smie-auto-fill () + (let ((fc (current-fill-column))) + (while (and fc (> (current-column) fc)) + (cond + ((not (or (nth 8 (save-excursion + (syntax-ppss (line-beginning-position)))) + (nth 8 (syntax-ppss)))) + (save-excursion + (beginning-of-line) + (smie-indent-forward-token) + (let ((bsf (point)) + (gain 0) + curcol) + (while (<= (setq curcol (current-column)) fc) + ;; FIXME? `smie-indent-calculate' can (and often will) + ;; return a result that actually depends on the presence/absence + ;; of a newline, so the gain computed here may not be accurate, + ;; but in practice it seems to works well enough. + (let* ((newcol (smie-indent-calculate)) + (newgain (- curcol newcol))) + (when (> newgain gain) + (setq gain newgain) + (setq bsf (point)))) + (smie-indent-forward-token)) + (when (> gain 0) + (goto-char bsf) + (newline-and-indent))))) + (t (do-auto-fill)))))) + + (defun smie-setup (grammar rules-function &rest keywords) "Setup SMIE navigation and indentation. GRAMMAR is a grammar table generated by `smie-prec2->grammar'. @@ -1612,6 +1642,7 @@ KEYWORDS are additional arguments, which can use the following keywords: (set (make-local-variable 'smie-rules-function) rules-function) (set (make-local-variable 'smie-grammar) grammar) (set (make-local-variable 'indent-line-function) 'smie-indent-line) + (set (make-local-variable 'normal-auto-fill-function) 'smie-auto-fill) (set (make-local-variable 'forward-sexp-function) 'smie-forward-sexp-command) (while keywords diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index 611a766922a..583d0b151c9 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -1,4 +1,4 @@ -;;; syntax.el --- helper functions to find syntactic context +;;; syntax.el --- helper functions to find syntactic context -*- lexical-binding: t -*- ;; Copyright (C) 2000-2012 Free Software Foundation, Inc. @@ -274,13 +274,12 @@ Note: back-references in REGEXPs do not work." "Propertize for syntax in START..END using font-lock syntax. KEYWORDS obeys the format used in `font-lock-syntactic-keywords'. The return value is a function suitable for `syntax-propertize-function'." - (lexical-let ((keywords keywords)) - (lambda (start end) - (with-no-warnings - (let ((font-lock-syntactic-keywords keywords)) - (font-lock-fontify-syntactic-keywords-region start end) - ;; In case it was eval'd/compiled. - (setq keywords font-lock-syntactic-keywords)))))) + (lambda (start end) + (with-no-warnings + (let ((font-lock-syntactic-keywords keywords)) + (font-lock-fontify-syntactic-keywords-region start end) + ;; In case it was eval'd/compiled. + (setq keywords font-lock-syntactic-keywords))))) (defun syntax-propertize (pos) "Ensure that syntax-table properties are set until POS." diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index b6b7c266263..11ec0f0614c 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -240,12 +240,14 @@ and idle timers such as are scheduled by `run-with-idle-timer'." (defvar timer-event-last-2 nil "Third-to-last timer that was run.") -(defvar timer-max-repeats 10 - "*Maximum number of times to repeat a timer, if many repeats are delayed. +(defcustom timer-max-repeats 10 + "Maximum number of times to repeat a timer, if many repeats are delayed. Timer invocations can be delayed because Emacs is suspended or busy, or because the system's time changes. If such an occurrence makes it appear that many invocations are overdue, this variable controls -how many will really happen.") +how many will really happen." + :type 'integer + :group 'internal) (defun timer-until (timer time) "Calculate number of seconds from when TIMER will run, until TIME. |