diff options
| author | Stephen Berman <stephen.berman@gmx.net> | 2013-06-21 20:37:42 +0200 |
|---|---|---|
| committer | Stephen Berman <stephen.berman@gmx.net> | 2013-06-21 20:37:42 +0200 |
| commit | 716b665eb3a134a5d1ccefd5d4c735e7e7ef62d5 (patch) | |
| tree | ede9da164267b968f3c05e0340ba12e06b8d3516 /lisp/emacs-lisp | |
| parent | ebc83885b750d46eb290192ae25f6b9a92bdd15f (diff) | |
| parent | cad5d1cb5af7210154814b60825576d14740158f (diff) | |
| download | emacs-716b665eb3a134a5d1ccefd5d4c735e7e7ef62d5.tar.gz emacs-716b665eb3a134a5d1ccefd5d4c735e7e7ef62d5.tar.bz2 emacs-716b665eb3a134a5d1ccefd5d4c735e7e7ef62d5.zip | |
Merge from trunk.
Diffstat (limited to 'lisp/emacs-lisp')
| -rw-r--r-- | lisp/emacs-lisp/autoload.el | 134 | ||||
| -rw-r--r-- | lisp/emacs-lisp/byte-opt.el | 1 | ||||
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 39 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cconv.el | 14 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-lib.el | 12 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-loaddefs.el | 1282 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 52 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-custom.el | 3 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio.el | 7 | ||||
| -rw-r--r-- | lisp/emacs-lisp/generic.el | 96 | ||||
| -rw-r--r-- | lisp/emacs-lisp/lisp-mode.el | 4 | ||||
| -rw-r--r-- | lisp/emacs-lisp/lisp.el | 6 | ||||
| -rw-r--r-- | lisp/emacs-lisp/map-ynp.el | 48 | ||||
| -rw-r--r-- | lisp/emacs-lisp/package-x.el | 68 | ||||
| -rw-r--r-- | lisp/emacs-lisp/package.el | 1088 | ||||
| -rw-r--r-- | lisp/emacs-lisp/tabulated-list.el | 28 |
16 files changed, 796 insertions, 2086 deletions
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index dbb4a239f02..22713c6589c 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -31,6 +31,7 @@ ;;; Code: (require 'lisp-mode) ;for `doc-string-elt' properties. +(require 'lisp-mnt) (require 'help-fns) ;for help-add-fundoc-usage. (eval-when-compile (require 'cl-lib)) @@ -435,6 +436,64 @@ Return non-nil in the case where no autoloads were added at point." (defvar print-readably) +(defun autoload--insert-text (output-start otherbuf outbuf absfile + load-name printfun) + ;; If not done yet, figure out where to insert this text. + (unless (marker-buffer output-start) + (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 + (move-marker output-start (point) outbuf)))) + (let ((standard-output (marker-buffer output-start))) + (funcall printfun))) + +(defun autoload--insert-cookie-text (output-start otherbuf outbuf absfile + load-name file) + (autoload--insert-text + output-start otherbuf outbuf absfile load-name + (lambda () + (search-forward generate-autoload-cookie) + (skip-chars-forward " \t") + (if (eolp) + (condition-case-unless-debug err + ;; Read the next form and make an autoload. + (let* ((form (prog1 (read (current-buffer)) + (or (bolp) (forward-line 1)))) + (autoload (make-autoload form load-name))) + (if autoload + nil + (setq autoload form)) + (let ((autoload-print-form-outbuf + standard-output)) + (autoload-print-form autoload))) + (error + (message "Autoload cookie error in %s:%s %S" + file (count-lines (point-min) (point)) err))) + + ;; Copy the rest of the line to the output. + (princ (buffer-substring + (progn + ;; Back up over whitespace, to preserve it. + (skip-chars-backward " \f\t") + (if (= (char-after (1+ (point))) ? ) + ;; Eat one space. + (forward-char 1)) + (point)) + (progn (forward-line 1) (point)))))))) + +(defvar autoload-builtin-package-versions nil) + ;; 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 @@ -456,8 +515,7 @@ different from OUTFILE, then OUTBUF is ignored. Return non-nil if and only if FILE adds no autoloads to OUTFILE \(or OUTBUF if OUTFILE is nil)." (catch 'done - (let ((autoloads-done '()) - load-name + (let (load-name (print-length nil) (print-level nil) (print-readably t) ; This does something in Lucid Emacs. @@ -466,7 +524,7 @@ Return non-nil if and only if FILE adds no autoloads to OUTFILE (otherbuf nil) (absfile (expand-file-name file)) ;; nil until we found a cookie. - output-start ostart) + output-start) (with-current-buffer (or visited ;; It is faster to avoid visiting the file. (autoload-find-file file)) @@ -487,58 +545,31 @@ Return non-nil if and only if FILE adds no autoloads to OUTFILE (save-excursion (save-restriction (widen) + (when autoload-builtin-package-versions + (let ((version (lm-header "version")) + package) + (and version + (setq version (ignore-errors (version-to-list version))) + (setq package (or (lm-header "package") + (file-name-sans-extension + (file-name-nondirectory file)))) + (setq output-start (make-marker)) + (autoload--insert-text + output-start otherbuf outbuf absfile load-name + (lambda () + (princ `(push (purecopy + ',(cons (intern package) version)) + package--builtin-versions)) + (newline)))))) + (goto-char (point-min)) (while (not (eobp)) (skip-chars-forward " \t\n\f") (cond ((looking-at (regexp-quote generate-autoload-cookie)) - ;; If not done yet, figure out where to insert this text. - (unless output-start - (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) - (condition-case-unless-debug err - ;; Read the next form and make an autoload. - (let* ((form (prog1 (read (current-buffer)) - (or (bolp) (forward-line 1)))) - (autoload (make-autoload form load-name))) - (if autoload - (push (nth 1 form) autoloads-done) - (setq autoload form)) - (let ((autoload-print-form-outbuf - (marker-buffer output-start))) - (autoload-print-form autoload))) - (error - (message "Autoload cookie error in %s:%s %S" - file (count-lines (point-min) (point)) err))) - - ;; Copy the rest of the line to the output. - (princ (buffer-substring - (progn - ;; Back up over whitespace, to preserve it. - (skip-chars-backward " \f\t") - (if (= (char-after (1+ (point))) ? ) - ;; Eat one space. - (forward-char 1)) - (point)) - (progn (forward-line 1) (point))) - (marker-buffer output-start)))) + (unless output-start (setq output-start (make-marker))) + (autoload--insert-cookie-text + output-start otherbuf outbuf absfile load-name file)) ((looking-at ";") ;; Don't read the comment. (forward-line 1)) @@ -553,12 +584,11 @@ Return non-nil if and only if FILE adds no autoloads to OUTFILE (save-excursion ;; Insert the section-header line which lists the file name ;; and which functions are in it, etc. - (cl-assert (= ostart output-start)) (goto-char output-start) (let ((relfile (file-relative-name absfile))) (autoload-insert-section-header (marker-buffer output-start) - autoloads-done load-name relfile + () 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 diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 7375c2176ba..7214501362d 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -287,6 +287,7 @@ (byte-compile--reify-function fn))))) (if (eq (car-safe newfn) 'function) (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form))) + ;; This can happen because of macroexp-warn-and-return &co. (byte-compile-log-warning (format "Inlining closure %S failed" name)) form)))) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index e603f76f41d..f4e79dc4886 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2174,6 +2174,8 @@ list that represents a doc string reference. byte-compile-maxdepth 0 byte-compile-output nil)))) +(defvar byte-compile-force-lexical-warnings nil) + (defun byte-compile-preprocess (form &optional _for-effect) (setq form (macroexpand-all form byte-compile-macro-environment)) ;; FIXME: We should run byte-optimize-form here, but it currently does not @@ -2182,9 +2184,10 @@ list that represents a doc string reference. ;; macroexpand-all. ;; (if (memq byte-optimize '(t source)) ;; (setq form (byte-optimize-form form for-effect))) - (if lexical-binding - (cconv-closure-convert form) - form)) + (cond + (lexical-binding (cconv-closure-convert form)) + (byte-compile-force-lexical-warnings (cconv-warnings-only form)) + (t form))) ;; byte-hunk-handlers cannot call this! (defun byte-compile-toplevel-file-form (form) @@ -2212,7 +2215,7 @@ list that represents a doc string reference. (and (let ((form form)) (while (if (setq form (cdr form)) (macroexp-const-p (car form)))) (null form)) ;Constants only - (eval (nth 5 form)) ;Macro + (memq (eval (nth 5 form)) '(t macro)) ;Macro (eval form)) ;Define the autoload. ;; Avoid undefined function warnings for the autoload. (when (and (consp (nth 1 form)) @@ -4184,7 +4187,7 @@ binding slots have been popped." (byte-compile-set-symbol-position 'autoload) (and (macroexp-const-p (nth 1 form)) (macroexp-const-p (nth 5 form)) - (eval (nth 5 form)) ; macro-p + (memq (eval (nth 5 form)) '(t macro)) ; macro-p (not (fboundp (eval (nth 1 form)))) (byte-compile-warn "The compiler ignores `autoload' except at top level. You should @@ -4240,6 +4243,12 @@ binding slots have been popped." lam)) (unless (byte-compile-file-form-defmumble name macro arglist body rest) + (when macro + (if (null fun) + (message "Macro %s unrecognized, won't work in file" name) + (message "Macro %s partly recognized, trying our luck" name) + (push (cons name (eval fun)) + byte-compile-macro-environment))) (byte-compile-keep-pending form)))) ;; We used to just do: (byte-compile-normal-call form) @@ -4268,26 +4277,6 @@ binding slots have been popped." 'byte-hunk-handler 'byte-compile-form-make-variable-buffer-local) (defun byte-compile-form-make-variable-buffer-local (form) (byte-compile-keep-pending form 'byte-compile-normal-call)) - -(byte-defop-compiler-1 add-to-list byte-compile-add-to-list) -(defun byte-compile-add-to-list (form) - ;; FIXME: This could be used for `set' as well, except that it's got - ;; its own opcode, so the final `byte-compile-normal-call' needs to - ;; be replaced with something else. - (pcase form - (`(,fun ',var . ,_) - (byte-compile-check-variable var 'assign) - (if (assq var byte-compile--lexical-environment) - (byte-compile-log-warning - (format "%s cannot use lexical var `%s'" fun var) - nil :error) - (unless (or (not (byte-compile-warning-enabled-p 'free-vars)) - (boundp var) - (memq var byte-compile-bound-variables) - (memq var byte-compile-free-references)) - (byte-compile-warn "assignment to free variable `%S'" var) - (push var byte-compile-free-references))))) - (byte-compile-normal-call form)) ;;; tags diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 761e33c059d..70fa71a0da4 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -143,7 +143,19 @@ Returns a form where all lambdas don't have any free variables." ;; Analyze form - fill these variables with new information. (cconv-analyse-form form '()) (setq cconv-freevars-alist (nreverse cconv-freevars-alist)) - (cconv-convert form nil nil))) ; Env initially empty. + (prog1 (cconv-convert form nil nil) ; Env initially empty. + (cl-assert (null cconv-freevars-alist))))) + +;;;###autoload +(defun cconv-warnings-only (form) + "Add the warnings that closure conversion would encounter." + (let ((cconv-freevars-alist '()) + (cconv-lambda-candidates '()) + (cconv-captured+mutated '())) + ;; Analyze form - fill these variables with new information. + (cconv-analyse-form form '()) + ;; But don't perform the closure conversion. + form)) (defconst cconv--dummy-var (make-symbol "ignored")) diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 52f123c83ec..2ab6b7ad089 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -36,13 +36,6 @@ ;; package which should always be present. -;;; Future notes: - -;; Once Emacs 19 becomes standard, many things in this package which are -;; messy for reasons of compatibility can be greatly simplified. For now, -;; I prefer to maintain one unified version. - - ;;; Change Log: ;; Version 2.02 (30 Jul 93): @@ -732,9 +725,10 @@ If ALIST is non-nil, the new pairs are prepended to it." (put 'cl-defsubst 'doc-string-elt 3) (put 'cl-defstruct 'doc-string-elt 2)) -(load "cl-loaddefs" nil 'quiet) - (provide 'cl-lib) +(or (load "cl-loaddefs" 'noerror 'quiet) + ;; When bootstrapping, cl-loaddefs hasn't been built yet! + (require 'cl-macs)) ;; Local variables: ;; byte-compile-dynamic: t diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el deleted file mode 100644 index 33ee7c0bbd2..00000000000 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ /dev/null @@ -1,1282 +0,0 @@ -;;; cl-loaddefs.el --- automatically extracted autoloads -;; -;;; Code: - - -;;;### (autoloads (cl-prettyexpand cl-remprop cl--do-remf cl--set-getf -;;;;;; cl-getf cl-get cl-tailp cl-list-length cl-nreconc cl-revappend -;;;;;; cl-concatenate cl-subseq cl-float-limits cl-random-state-p -;;;;;; cl-make-random-state cl-random cl-signum cl-rem cl-mod cl-round -;;;;;; cl-truncate cl-ceiling cl-floor cl-isqrt cl-lcm cl-gcd cl--set-frame-visible-p -;;;;;; cl--map-overlays cl--map-intervals cl--map-keymap-recursively -;;;;;; cl-notevery cl-notany cl-every cl-some cl-mapcon cl-mapcan -;;;;;; cl-mapl cl-mapc cl-maplist cl-map cl--mapcar-many cl-equalp -;;;;;; cl-coerce) "cl-extra" "cl-extra.el" "011111887a1f353218e59e14d0b09c68") -;;; Generated autoloads from cl-extra.el - -(autoload 'cl-coerce "cl-extra" "\ -Coerce OBJECT to type TYPE. -TYPE is a Common Lisp type specifier. - -\(fn OBJECT TYPE)" nil nil) - -(autoload 'cl-equalp "cl-extra" "\ -Return t if two Lisp objects have similar structures and contents. -This is like `equal', except that it accepts numerically equal -numbers of different types (float vs. integer), and also compares -strings case-insensitively. - -\(fn X Y)" nil nil) - -(autoload 'cl--mapcar-many "cl-extra" "\ - - -\(fn CL-FUNC CL-SEQS)" nil nil) - -(autoload 'cl-map "cl-extra" "\ -Map a FUNCTION across one or more SEQUENCEs, returning a sequence. -TYPE is the sequence type to return. - -\(fn TYPE FUNCTION SEQUENCE...)" nil nil) - -(autoload 'cl-maplist "cl-extra" "\ -Map FUNCTION to each sublist of LIST or LISTs. -Like `cl-mapcar', except applies to lists and their cdr's rather than to -the elements themselves. - -\(fn FUNCTION LIST...)" nil nil) - -(autoload 'cl-mapc "cl-extra" "\ -Like `cl-mapcar', but does not accumulate values returned by the function. - -\(fn FUNCTION SEQUENCE...)" nil nil) - -(autoload 'cl-mapl "cl-extra" "\ -Like `cl-maplist', but does not accumulate values returned by the function. - -\(fn FUNCTION LIST...)" nil nil) - -(autoload 'cl-mapcan "cl-extra" "\ -Like `cl-mapcar', but nconc's together the values returned by the function. - -\(fn FUNCTION SEQUENCE...)" nil nil) - -(autoload 'cl-mapcon "cl-extra" "\ -Like `cl-maplist', but nconc's together the values returned by the function. - -\(fn FUNCTION LIST...)" nil nil) - -(autoload 'cl-some "cl-extra" "\ -Return true if PREDICATE is true of any element of SEQ or SEQs. -If so, return the true (non-nil) value returned by PREDICATE. - -\(fn PREDICATE SEQ...)" nil nil) - -(autoload 'cl-every "cl-extra" "\ -Return true if PREDICATE is true of every element of SEQ or SEQs. - -\(fn PREDICATE SEQ...)" nil nil) - -(autoload 'cl-notany "cl-extra" "\ -Return true if PREDICATE is false of every element of SEQ or SEQs. - -\(fn PREDICATE SEQ...)" nil nil) - -(autoload 'cl-notevery "cl-extra" "\ -Return true if PREDICATE is false of some element of SEQ or SEQs. - -\(fn PREDICATE SEQ...)" nil nil) - -(autoload 'cl--map-keymap-recursively "cl-extra" "\ - - -\(fn CL-FUNC-REC CL-MAP &optional CL-BASE)" nil nil) - -(autoload 'cl--map-intervals "cl-extra" "\ - - -\(fn CL-FUNC &optional CL-WHAT CL-PROP CL-START CL-END)" nil nil) - -(autoload 'cl--map-overlays "cl-extra" "\ - - -\(fn CL-FUNC &optional CL-BUFFER CL-START CL-END CL-ARG)" nil nil) - -(autoload 'cl--set-frame-visible-p "cl-extra" "\ - - -\(fn FRAME VAL)" nil nil) - -(autoload 'cl-gcd "cl-extra" "\ -Return the greatest common divisor of the arguments. - -\(fn &rest ARGS)" nil nil) - -(autoload 'cl-lcm "cl-extra" "\ -Return the least common multiple of the arguments. - -\(fn &rest ARGS)" nil nil) - -(autoload 'cl-isqrt "cl-extra" "\ -Return the integer square root of the argument. - -\(fn X)" nil nil) - -(autoload 'cl-floor "cl-extra" "\ -Return a list of the floor of X and the fractional part of X. -With two arguments, return floor and remainder of their quotient. - -\(fn X &optional Y)" nil nil) - -(autoload 'cl-ceiling "cl-extra" "\ -Return a list of the ceiling of X and the fractional part of X. -With two arguments, return ceiling and remainder of their quotient. - -\(fn X &optional Y)" nil nil) - -(autoload 'cl-truncate "cl-extra" "\ -Return a list of the integer part of X and the fractional part of X. -With two arguments, return truncation and remainder of their quotient. - -\(fn X &optional Y)" nil nil) - -(autoload 'cl-round "cl-extra" "\ -Return a list of X rounded to the nearest integer and the remainder. -With two arguments, return rounding and remainder of their quotient. - -\(fn X &optional Y)" nil nil) - -(autoload 'cl-mod "cl-extra" "\ -The remainder of X divided by Y, with the same sign as Y. - -\(fn X Y)" nil nil) - -(autoload 'cl-rem "cl-extra" "\ -The remainder of X divided by Y, with the same sign as X. - -\(fn X Y)" nil nil) - -(autoload 'cl-signum "cl-extra" "\ -Return 1 if X is positive, -1 if negative, 0 if zero. - -\(fn X)" nil nil) - -(autoload 'cl-random "cl-extra" "\ -Return a random nonnegative number less than LIM, an integer or float. -Optional second arg STATE is a random-state object. - -\(fn LIM &optional STATE)" nil nil) - -(autoload 'cl-make-random-state "cl-extra" "\ -Return a copy of random-state STATE, or of the internal state if omitted. -If STATE is t, return a new state object seeded from the time of day. - -\(fn &optional STATE)" nil nil) - -(autoload 'cl-random-state-p "cl-extra" "\ -Return t if OBJECT is a random-state object. - -\(fn OBJECT)" nil nil) - -(autoload 'cl-float-limits "cl-extra" "\ -Initialize the Common Lisp floating-point parameters. -This sets the values of: `cl-most-positive-float', `cl-most-negative-float', -`cl-least-positive-float', `cl-least-negative-float', `cl-float-epsilon', -`cl-float-negative-epsilon', `cl-least-positive-normalized-float', and -`cl-least-negative-normalized-float'. - -\(fn)" nil nil) - -(autoload 'cl-subseq "cl-extra" "\ -Return the subsequence of SEQ from START to END. -If END is omitted, it defaults to the length of the sequence. -If START or END is negative, it counts from the end. - -\(fn SEQ START &optional END)" nil nil) - -(autoload 'cl-concatenate "cl-extra" "\ -Concatenate, into a sequence of type TYPE, the argument SEQUENCEs. - -\(fn TYPE SEQUENCE...)" nil nil) - -(autoload 'cl-revappend "cl-extra" "\ -Equivalent to (append (reverse X) Y). - -\(fn X Y)" nil nil) - -(autoload 'cl-nreconc "cl-extra" "\ -Equivalent to (nconc (nreverse X) Y). - -\(fn X Y)" nil nil) - -(autoload 'cl-list-length "cl-extra" "\ -Return the length of list X. Return nil if list is circular. - -\(fn X)" nil nil) - -(autoload 'cl-tailp "cl-extra" "\ -Return true if SUBLIST is a tail of LIST. - -\(fn SUBLIST LIST)" nil nil) - -(autoload 'cl-get "cl-extra" "\ -Return the value of SYMBOL's PROPNAME property, or DEFAULT if none. - -\(fn SYMBOL PROPNAME &optional DEFAULT)" nil nil) - -(eval-and-compile (put 'cl-get 'compiler-macro #'cl--compiler-macro-get)) - -(autoload 'cl-getf "cl-extra" "\ -Search PROPLIST for property PROPNAME; return its value or DEFAULT. -PROPLIST is a list of the sort returned by `symbol-plist'. - -\(fn PROPLIST PROPNAME &optional DEFAULT)" nil nil) - -(autoload 'cl--set-getf "cl-extra" "\ - - -\(fn PLIST TAG VAL)" nil nil) - -(autoload 'cl--do-remf "cl-extra" "\ - - -\(fn PLIST TAG)" nil nil) - -(autoload 'cl-remprop "cl-extra" "\ -Remove from SYMBOL's plist the property PROPNAME and its value. - -\(fn SYMBOL PROPNAME)" nil nil) - -(autoload 'cl-prettyexpand "cl-extra" "\ -Expand macros in FORM and insert the pretty-printed result. -Optional argument FULL non-nil means to expand all macros, -including `cl-block' and `cl-eval-when'. - -\(fn FORM &optional FULL)" nil nil) - -;;;*** - -;;;### (autoloads (cl--compiler-macro-adjoin cl-defsubst cl-compiler-macroexpand -;;;;;; cl-define-compiler-macro cl-assert cl-check-type cl-typep -;;;;;; cl-deftype cl-defstruct cl-callf2 cl-callf cl-letf* cl-letf -;;;;;; cl-rotatef cl-shiftf cl-remf cl-psetf cl-declare cl-the cl-locally -;;;;;; cl-multiple-value-setq cl-multiple-value-bind cl-symbol-macrolet -;;;;;; cl-macrolet cl-labels cl-flet* cl-flet cl-progv cl-psetq -;;;;;; cl-do-all-symbols cl-do-symbols cl-tagbody cl-dotimes cl-dolist -;;;;;; cl-do* cl-do cl-loop cl-return-from cl-return cl-block cl-etypecase -;;;;;; 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" "80cb53f97b21adb6069c43c38a2e094d") -;;; Generated autoloads from cl-macs.el - -(autoload 'cl--compiler-macro-list* "cl-macs" "\ - - -\(fn FORM ARG &rest OTHERS)" nil nil) - -(autoload 'cl--compiler-macro-cXXr "cl-macs" "\ - - -\(fn FORM X)" nil nil) - -(autoload 'cl-gensym "cl-macs" "\ -Generate a new uninterned symbol. -The name is made by appending a number to PREFIX, default \"G\". - -\(fn &optional PREFIX)" nil nil) - -(autoload 'cl-gentemp "cl-macs" "\ -Generate a new interned symbol with a unique name. -The name is made by appending a number to PREFIX, default \"G\". - -\(fn &optional PREFIX)" nil nil) - -(autoload 'cl-defun "cl-macs" "\ -Define NAME as a function. -Like normal `defun', except ARGLIST allows full Common Lisp conventions, -and BODY is implicitly surrounded by (cl-block NAME ...). - -\(fn NAME ARGLIST [DOCSTRING] BODY...)" nil t) - -(put 'cl-defun 'doc-string-elt '3) - -(put 'cl-defun 'lisp-indent-function '2) - -(autoload 'cl-defmacro "cl-macs" "\ -Define NAME as a macro. -Like normal `defmacro', except ARGLIST allows full Common Lisp conventions, -and BODY is implicitly surrounded by (cl-block NAME ...). - -\(fn NAME ARGLIST [DOCSTRING] BODY...)" nil t) - -(put 'cl-defmacro 'doc-string-elt '3) - -(put 'cl-defmacro 'lisp-indent-function '2) - -(autoload 'cl-function "cl-macs" "\ -Introduce a function. -Like normal `function', except that if argument is a lambda form, -its argument list allows full Common Lisp conventions. - -\(fn FUNC)" nil t) - -(autoload 'cl-destructuring-bind "cl-macs" "\ -Bind the variables in ARGS to the result of EXPR and execute BODY. - -\(fn ARGS EXPR &rest BODY)" nil t) - -(put 'cl-destructuring-bind 'lisp-indent-function '2) - -(autoload 'cl-eval-when "cl-macs" "\ -Control when BODY is evaluated. -If `compile' is in WHEN, BODY is evaluated when compiled at top-level. -If `load' is in WHEN, BODY is evaluated when loaded after top-level compile. -If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level. - -\(fn (WHEN...) BODY...)" nil t) - -(put 'cl-eval-when 'lisp-indent-function '1) - -(autoload 'cl-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. - -\(fn FORM &optional READ-ONLY)" nil t) - -(autoload 'cl-case "cl-macs" "\ -Eval EXPR and choose among clauses on that value. -Each clause looks like (KEYLIST BODY...). EXPR is evaluated and compared -against each key in each KEYLIST; the corresponding BODY is evaluated. -If no clause succeeds, cl-case returns nil. A single atom may be used in -place of a KEYLIST of one atom. A KEYLIST of t or `otherwise' is -allowed only in the final clause, and matches if no other keys match. -Key values are compared by `eql'. - -\(fn EXPR (KEYLIST BODY...)...)" nil t) - -(put 'cl-case 'lisp-indent-function '1) - -(autoload 'cl-ecase "cl-macs" "\ -Like `cl-case', but error if no case fits. -`otherwise'-clauses are not allowed. - -\(fn EXPR (KEYLIST BODY...)...)" nil t) - -(put 'cl-ecase 'lisp-indent-function '1) - -(autoload 'cl-typecase "cl-macs" "\ -Evals EXPR, chooses among clauses on that value. -Each clause looks like (TYPE BODY...). EXPR is evaluated and, if it -satisfies TYPE, the corresponding BODY is evaluated. If no clause succeeds, -cl-typecase returns nil. A TYPE of t or `otherwise' is allowed only in the -final clause, and matches if no other keys match. - -\(fn EXPR (TYPE BODY...)...)" nil t) - -(put 'cl-typecase 'lisp-indent-function '1) - -(autoload 'cl-etypecase "cl-macs" "\ -Like `cl-typecase', but error if no case fits. -`otherwise'-clauses are not allowed. - -\(fn EXPR (TYPE BODY...)...)" nil t) - -(put 'cl-etypecase 'lisp-indent-function '1) - -(autoload 'cl-block "cl-macs" "\ -Define a lexically-scoped block named NAME. -NAME may be any symbol. Code inside the BODY forms can call `cl-return-from' -to jump prematurely out of the block. This differs from `catch' and `throw' -in two respects: First, the NAME is an unevaluated symbol rather than a -quoted symbol or other form; and second, NAME is lexically rather than -dynamically scoped: Only references to it within BODY will work. These -references may appear inside macro expansions, but not inside functions -called from BODY. - -\(fn NAME &rest BODY)" nil t) - -(put 'cl-block 'lisp-indent-function '1) - -(autoload 'cl-return "cl-macs" "\ -Return from the block named nil. -This is equivalent to `(cl-return-from nil RESULT)'. - -\(fn &optional RESULT)" nil t) - -(autoload 'cl-return-from "cl-macs" "\ -Return from the block named NAME. -This jumps out to the innermost enclosing `(cl-block NAME ...)' form, -returning RESULT from that form (or nil if RESULT is omitted). -This is compatible with Common Lisp, but note that `defun' and -`defmacro' do not create implicit blocks as they do in Common Lisp. - -\(fn NAME &optional RESULT)" nil t) - -(put 'cl-return-from 'lisp-indent-function '1) - -(autoload 'cl-loop "cl-macs" "\ -The Common Lisp `loop' macro. -Valid clauses include: - For clauses: - for VAR from/upfrom/downfrom EXPR1 to/upto/downto/above/below EXPR2 by EXPR3 - for VAR = EXPR1 then EXPR2 - for VAR in/on/in-ref LIST by FUNC - for VAR across/across-ref ARRAY - for VAR being: - the elements of/of-ref SEQUENCE [using (index VAR2)] - the symbols [of OBARRAY] - the hash-keys/hash-values of HASH-TABLE [using (hash-values/hash-keys V2)] - the key-codes/key-bindings/key-seqs of KEYMAP [using (key-bindings VAR2)] - the overlays/intervals [of BUFFER] [from POS1] [to POS2] - the frames/buffers - the windows [of FRAME] - Iteration clauses: - repeat INTEGER - while/until/always/never/thereis CONDITION - Accumulation clauses: - collect/append/nconc/concat/vconcat/count/sum/maximize/minimize FORM - [into VAR] - Miscellaneous clauses: - with VAR = INIT - if/when/unless COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...] - named NAME - initially/finally [do] EXPRS... - do EXPRS... - [finally] return EXPR - -For more details, see Info node `(cl)Loop Facility'. - -\(fn CLAUSE...)" nil t) - -(autoload 'cl-do "cl-macs" "\ -The Common Lisp `do' loop. - -\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil t) - -(put 'cl-do 'lisp-indent-function '2) - -(autoload 'cl-do* "cl-macs" "\ -The Common Lisp `do*' loop. - -\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil t) - -(put 'cl-do* 'lisp-indent-function '2) - -(autoload 'cl-dolist "cl-macs" "\ -Loop over a list. -Evaluate BODY with VAR bound to each `car' from LIST, in turn. -Then evaluate RESULT to get return value, default nil. -An implicit nil block is established around the loop. - -\(fn (VAR LIST [RESULT]) BODY...)" nil t) - -(put 'cl-dolist 'lisp-indent-function '1) - -(autoload 'cl-dotimes "cl-macs" "\ -Loop a certain number of times. -Evaluate BODY with VAR bound to successive integers from 0, inclusive, -to COUNT, exclusive. Then evaluate RESULT to get return value, default -nil. - -\(fn (VAR COUNT [RESULT]) BODY...)" nil t) - -(put 'cl-dotimes 'lisp-indent-function '1) - -(autoload 'cl-tagbody "cl-macs" "\ -Execute statements while providing for control transfers to labels. -Each element of LABELS-OR-STMTS can be either a label (integer or symbol) -or a `cons' cell, in which case it's taken to be a statement. -This distinction is made before performing macroexpansion. -Statements are executed in sequence left to right, discarding any return value, -stopping only when reaching the end of LABELS-OR-STMTS. -Any statement can transfer control at any time to the statements that follow -one of the labels with the special form (go LABEL). -Labels have lexical scope and dynamic extent. - -\(fn &rest LABELS-OR-STMTS)" nil t) - -(autoload 'cl-do-symbols "cl-macs" "\ -Loop over all symbols. -Evaluate BODY with VAR bound to each interned symbol, or to each symbol -from OBARRAY. - -\(fn (VAR [OBARRAY [RESULT]]) BODY...)" nil t) - -(put 'cl-do-symbols 'lisp-indent-function '1) - -(autoload 'cl-do-all-symbols "cl-macs" "\ -Like `cl-do-symbols', but use the default obarray. - -\(fn (VAR [RESULT]) BODY...)" nil t) - -(put 'cl-do-all-symbols 'lisp-indent-function '1) - -(autoload 'cl-psetq "cl-macs" "\ -Set SYMs to the values VALs in parallel. -This is like `setq', except that all VAL forms are evaluated (in order) -before assigning any symbols SYM to the corresponding values. - -\(fn SYM VAL SYM VAL ...)" nil t) - -(autoload 'cl-progv "cl-macs" "\ -Bind SYMBOLS to VALUES dynamically in BODY. -The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists. -Each symbol in the first list is bound to the corresponding value in the -second list (or to nil if VALUES is shorter than SYMBOLS); then the -BODY forms are executed and their result is returned. This is much like -a `let' form, except that the list of symbols can be computed at run-time. - -\(fn SYMBOLS VALUES &rest BODY)" nil t) - -(put 'cl-progv 'lisp-indent-function '2) - -(autoload 'cl-flet "cl-macs" "\ -Make local function definitions. -Like `cl-labels' but the definitions are not recursive. - -\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t) - -(put 'cl-flet 'lisp-indent-function '1) - -(autoload 'cl-flet* "cl-macs" "\ -Make local function definitions. -Like `cl-flet' but the definitions can refer to previous ones. - -\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t) - -(put 'cl-flet* 'lisp-indent-function '1) - -(autoload 'cl-labels "cl-macs" "\ -Make temporary function bindings. -The bindings can be recursive and the scoping is lexical, but capturing them -in closures will only work if `lexical-binding' is in use. - -\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t) - -(put 'cl-labels 'lisp-indent-function '1) - -(autoload 'cl-macrolet "cl-macs" "\ -Make temporary macro definitions. -This is like `cl-flet', but for macros instead of functions. - -\(fn ((NAME ARGLIST BODY...) ...) FORM...)" nil t) - -(put 'cl-macrolet 'lisp-indent-function '1) - -(autoload 'cl-symbol-macrolet "cl-macs" "\ -Make symbol macro definitions. -Within the body FORMs, references to the variable NAME will be replaced -by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). - -\(fn ((NAME EXPANSION) ...) FORM...)" nil t) - -(put 'cl-symbol-macrolet 'lisp-indent-function '1) - -(autoload 'cl-multiple-value-bind "cl-macs" "\ -Collect multiple return values. -FORM must return a list; the BODY is then executed with the first N elements -of this list bound (`let'-style) to each of the symbols SYM in turn. This -is analogous to the Common Lisp `cl-multiple-value-bind' macro, using lists to -simulate true multiple return values. For compatibility, (cl-values A B C) is -a synonym for (list A B C). - -\(fn (SYM...) FORM BODY)" nil t) - -(put 'cl-multiple-value-bind 'lisp-indent-function '2) - -(autoload 'cl-multiple-value-setq "cl-macs" "\ -Collect multiple return values. -FORM must return a list; the first N elements of this list are stored in -each of the symbols SYM in turn. This is analogous to the Common Lisp -`cl-multiple-value-setq' macro, using lists to simulate true multiple return -values. For compatibility, (cl-values A B C) is a synonym for (list A B C). - -\(fn (SYM...) FORM)" nil t) - -(put 'cl-multiple-value-setq 'lisp-indent-function '1) - -(autoload 'cl-locally "cl-macs" "\ -Equivalent to `progn'. - -\(fn &rest BODY)" nil t) - -(autoload 'cl-the "cl-macs" "\ -At present this ignores _TYPE and is simply equivalent to FORM. - -\(fn TYPE FORM)" nil t) - -(put 'cl-the 'lisp-indent-function '1) - -(autoload 'cl-declare "cl-macs" "\ -Declare SPECS about the current function while compiling. -For instance - - (cl-declare (warn 0)) - -will turn off byte-compile warnings in the function. -See Info node `(cl)Declarations' for details. - -\(fn &rest SPECS)" nil t) - -(autoload 'cl-psetf "cl-macs" "\ -Set PLACEs to the values VALs in parallel. -This is like `setf', except that all VAL forms are evaluated (in order) -before assigning any PLACEs to the corresponding values. - -\(fn PLACE VAL PLACE VAL ...)" nil t) - -(autoload 'cl-remf "cl-macs" "\ -Remove TAG from property list PLACE. -PLACE may be a symbol, or any generalized variable allowed by `setf'. -The form returns true if TAG was found and removed, nil otherwise. - -\(fn PLACE TAG)" nil t) - -(autoload 'cl-shiftf "cl-macs" "\ -Shift left among PLACEs. -Example: (cl-shiftf A B C) sets A to B, B to C, and returns the old A. -Each PLACE may be a symbol, or any generalized variable allowed by `setf'. - -\(fn PLACE... VAL)" nil t) - -(autoload 'cl-rotatef "cl-macs" "\ -Rotate left among PLACEs. -Example: (cl-rotatef A B C) sets A to B, B to C, and C to A. It returns nil. -Each PLACE may be a symbol, or any generalized variable allowed by `setf'. - -\(fn PLACE...)" nil t) - -(autoload 'cl-letf "cl-macs" "\ -Temporarily bind to PLACEs. -This is the analogue of `let', but with generalized variables (in the -sense of `setf') for the PLACEs. Each PLACE is set to the corresponding -VALUE, then the BODY forms are executed. On exit, either normally or -because of a `throw' or error, the PLACEs are set back to their original -values. Note that this macro is *not* available in Common Lisp. -As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)', -the PLACE is not modified before executing BODY. - -\(fn ((PLACE VALUE) ...) BODY...)" nil t) - -(put 'cl-letf 'lisp-indent-function '1) - -(autoload 'cl-letf* "cl-macs" "\ -Temporarily bind to PLACEs. -Like `cl-letf' but where the bindings are performed one at a time, -rather than all at the end (i.e. like `let*' rather than like `let'). - -\(fn BINDINGS &rest BODY)" nil t) - -(put 'cl-letf* 'lisp-indent-function '1) - -(autoload 'cl-callf "cl-macs" "\ -Set PLACE to (FUNC PLACE ARGS...). -FUNC should be an unquoted function name. PLACE may be a symbol, -or any generalized variable allowed by `setf'. - -\(fn FUNC PLACE &rest ARGS)" nil t) - -(put 'cl-callf 'lisp-indent-function '2) - -(autoload 'cl-callf2 "cl-macs" "\ -Set PLACE to (FUNC ARG1 PLACE ARGS...). -Like `cl-callf', but PLACE is the second argument of FUNC, not the first. - -\(fn FUNC ARG1 PLACE ARGS...)" nil t) - -(put 'cl-callf2 'lisp-indent-function '3) - -(autoload 'cl-defstruct "cl-macs" "\ -Define a struct type. -This macro defines a new data type called NAME that stores data -in SLOTs. It defines a `make-NAME' constructor, a `copy-NAME' -copier, a `NAME-p' predicate, and slot accessors named `NAME-SLOT'. -You can use the accessors to set the corresponding slots, via `setf'. - -NAME may instead take the form (NAME OPTIONS...), where each -OPTION is either a single keyword or (KEYWORD VALUE) where -KEYWORD can be one of :conc-name, :constructor, :copier, :predicate, -:type, :named, :initial-offset, :print-function, or :include. - -Each SLOT may instead take the form (SLOT SLOT-OPTS...), where -SLOT-OPTS are keyword-value pairs for that slot. Currently, only -one keyword is supported, `:read-only'. If this has a non-nil -value, that slot cannot be set via `setf'. - -\(fn NAME SLOTS...)" nil t) - -(put 'cl-defstruct 'doc-string-elt '2) - -(put 'cl-defstruct 'lisp-indent-function '1) - -(autoload 'cl-deftype "cl-macs" "\ -Define NAME as a new data type. -The type name can then be used in `cl-typecase', `cl-check-type', etc. - -\(fn NAME ARGLIST &rest BODY)" nil t) - -(put 'cl-deftype 'doc-string-elt '3) - -(autoload 'cl-typep "cl-macs" "\ -Check that OBJECT is of type TYPE. -TYPE is a Common Lisp-style type specifier. - -\(fn OBJECT TYPE)" nil nil) - -(autoload 'cl-check-type "cl-macs" "\ -Verify that FORM is of type TYPE; signal an error if not. -STRING is an optional description of the desired type. - -\(fn FORM TYPE &optional STRING)" nil t) - -(autoload 'cl-assert "cl-macs" "\ -Verify that FORM returns non-nil; signal an error if not. -Second arg SHOW-ARGS means to include arguments of FORM in message. -Other args STRING and ARGS... are arguments to be passed to `error'. -They are not evaluated unless the assertion fails. If STRING is -omitted, a default message listing FORM itself is used. - -\(fn FORM &optional SHOW-ARGS STRING &rest ARGS)" nil t) - -(autoload 'cl-define-compiler-macro "cl-macs" "\ -Define a compiler-only macro. -This is like `defmacro', but macro expansion occurs only if the call to -FUNC is compiled (i.e., not interpreted). Compiler macros should be used -for optimizing the way calls to FUNC are compiled; the form returned by -BODY should do the same thing as a call to the normal function called -FUNC, though possibly more efficiently. Note that, like regular macros, -compiler macros are expanded repeatedly until no further expansions are -possible. Unlike regular macros, BODY can decide to \"punt\" and leave the -original function call alone by declaring an initial `&whole foo' parameter -and then returning foo. - -\(fn FUNC ARGS &rest BODY)" nil t) - -(autoload 'cl-compiler-macroexpand "cl-macs" "\ -Like `macroexpand', but for compiler macros. -Expands FORM repeatedly until no further expansion is possible. -Returns FORM unchanged if it has no compiler macro, or if it has a -macro that returns its `&whole' argument. - -\(fn FORM)" nil nil) - -(autoload 'cl-defsubst "cl-macs" "\ -Define NAME as a function. -Like `defun', except the function is automatically declared `inline', -ARGLIST allows full Common Lisp conventions, and BODY is implicitly -surrounded by (cl-block NAME ...). - -\(fn NAME ARGLIST [DOCSTRING] BODY...)" nil t) - -(put 'cl-defsubst 'lisp-indent-function '2) - -(autoload 'cl--compiler-macro-adjoin "cl-macs" "\ - - -\(fn FORM A LIST &rest KEYS)" nil nil) - -;;;*** - -;;;### (autoloads (cl-tree-equal cl-nsublis cl-sublis cl-nsubst-if-not -;;;;;; cl-nsubst-if cl-nsubst cl-subst-if-not cl-subst-if cl-subsetp -;;;;;; cl-nset-exclusive-or cl-set-exclusive-or cl-nset-difference -;;;;;; cl-set-difference cl-nintersection cl-intersection cl-nunion -;;;;;; cl-union cl-rassoc-if-not cl-rassoc-if cl-rassoc cl-assoc-if-not -;;;;;; cl-assoc-if cl-assoc cl--adjoin cl-member-if-not cl-member-if -;;;;;; cl-member cl-merge cl-stable-sort cl-sort cl-search cl-mismatch -;;;;;; cl-count-if-not cl-count-if cl-count cl-position-if-not cl-position-if -;;;;;; cl-position cl-find-if-not cl-find-if cl-find cl-nsubstitute-if-not -;;;;;; cl-nsubstitute-if cl-nsubstitute cl-substitute-if-not cl-substitute-if -;;;;;; cl-substitute cl-delete-duplicates cl-remove-duplicates cl-delete-if-not -;;;;;; cl-delete-if cl-delete cl-remove-if-not cl-remove-if cl-remove -;;;;;; cl-replace cl-fill cl-reduce) "cl-seq" "cl-seq.el" "51a70dea9cbc225165a50135956609aa") -;;; Generated autoloads from cl-seq.el - -(autoload 'cl-reduce "cl-seq" "\ -Reduce two-argument FUNCTION across SEQ. - -Keywords supported: :start :end :from-end :initial-value :key - -\(fn FUNCTION SEQ [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-fill "cl-seq" "\ -Fill the elements of SEQ with ITEM. - -Keywords supported: :start :end - -\(fn SEQ ITEM [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-replace "cl-seq" "\ -Replace the elements of SEQ1 with the elements of SEQ2. -SEQ1 is destructively modified, then returned. - -Keywords supported: :start1 :end1 :start2 :end2 - -\(fn SEQ1 SEQ2 [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-remove "cl-seq" "\ -Remove all occurrences of ITEM in SEQ. -This is a non-destructive function; it makes a copy of SEQ if necessary -to avoid corrupting the original SEQ. - -Keywords supported: :test :test-not :key :count :start :end :from-end - -\(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-remove-if "cl-seq" "\ -Remove all items satisfying PREDICATE in SEQ. -This is a non-destructive function; it makes a copy of SEQ if necessary -to avoid corrupting the original SEQ. - -Keywords supported: :key :count :start :end :from-end - -\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-remove-if-not "cl-seq" "\ -Remove all items not satisfying PREDICATE in SEQ. -This is a non-destructive function; it makes a copy of SEQ if necessary -to avoid corrupting the original SEQ. - -Keywords supported: :key :count :start :end :from-end - -\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-delete "cl-seq" "\ -Remove all occurrences of ITEM in SEQ. -This is a destructive function; it reuses the storage of SEQ whenever possible. - -Keywords supported: :test :test-not :key :count :start :end :from-end - -\(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-delete-if "cl-seq" "\ -Remove all items satisfying PREDICATE in SEQ. -This is a destructive function; it reuses the storage of SEQ whenever possible. - -Keywords supported: :key :count :start :end :from-end - -\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-delete-if-not "cl-seq" "\ -Remove all items not satisfying PREDICATE in SEQ. -This is a destructive function; it reuses the storage of SEQ whenever possible. - -Keywords supported: :key :count :start :end :from-end - -\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-remove-duplicates "cl-seq" "\ -Return a copy of SEQ with all duplicate elements removed. - -Keywords supported: :test :test-not :key :start :end :from-end - -\(fn SEQ [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-delete-duplicates "cl-seq" "\ -Remove all duplicate elements from SEQ (destructively). - -Keywords supported: :test :test-not :key :start :end :from-end - -\(fn SEQ [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-substitute "cl-seq" "\ -Substitute NEW for OLD in SEQ. -This is a non-destructive function; it makes a copy of SEQ if necessary -to avoid corrupting the original SEQ. - -Keywords supported: :test :test-not :key :count :start :end :from-end - -\(fn NEW OLD SEQ [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-substitute-if "cl-seq" "\ -Substitute NEW for all items satisfying PREDICATE in SEQ. -This is a non-destructive function; it makes a copy of SEQ if necessary -to avoid corrupting the original SEQ. - -Keywords supported: :key :count :start :end :from-end - -\(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-substitute-if-not "cl-seq" "\ -Substitute NEW for all items not satisfying PREDICATE in SEQ. -This is a non-destructive function; it makes a copy of SEQ if necessary -to avoid corrupting the original SEQ. - -Keywords supported: :key :count :start :end :from-end - -\(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-nsubstitute "cl-seq" "\ -Substitute NEW for OLD in SEQ. -This is a destructive function; it reuses the storage of SEQ whenever possible. - -Keywords supported: :test :test-not :key :count :start :end :from-end - -\(fn NEW OLD SEQ [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-nsubstitute-if "cl-seq" "\ -Substitute NEW for all items satisfying PREDICATE in SEQ. -This is a destructive function; it reuses the storage of SEQ whenever possible. - -Keywords supported: :key :count :start :end :from-end - -\(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-nsubstitute-if-not "cl-seq" "\ -Substitute NEW for all items not satisfying PREDICATE in SEQ. -This is a destructive function; it reuses the storage of SEQ whenever possible. - -Keywords supported: :key :count :start :end :from-end - -\(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-find "cl-seq" "\ -Find the first occurrence of ITEM in SEQ. -Return the matching ITEM, or nil if not found. - -Keywords supported: :test :test-not :key :start :end :from-end - -\(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-find-if "cl-seq" "\ -Find the first item satisfying PREDICATE in SEQ. -Return the matching item, or nil if not found. - -Keywords supported: :key :start :end :from-end - -\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-find-if-not "cl-seq" "\ -Find the first item not satisfying PREDICATE in SEQ. -Return the matching item, or nil if not found. - -Keywords supported: :key :start :end :from-end - -\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-position "cl-seq" "\ -Find the first occurrence of ITEM in SEQ. -Return the index of the matching item, or nil if not found. - -Keywords supported: :test :test-not :key :start :end :from-end - -\(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-position-if "cl-seq" "\ -Find the first item satisfying PREDICATE in SEQ. -Return the index of the matching item, or nil if not found. - -Keywords supported: :key :start :end :from-end - -\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-position-if-not "cl-seq" "\ -Find the first item not satisfying PREDICATE in SEQ. -Return the index of the matching item, or nil if not found. - -Keywords supported: :key :start :end :from-end - -\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-count "cl-seq" "\ -Count the number of occurrences of ITEM in SEQ. - -Keywords supported: :test :test-not :key :start :end - -\(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-count-if "cl-seq" "\ -Count the number of items satisfying PREDICATE in SEQ. - -Keywords supported: :key :start :end - -\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-count-if-not "cl-seq" "\ -Count the number of items not satisfying PREDICATE in SEQ. - -Keywords supported: :key :start :end - -\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-mismatch "cl-seq" "\ -Compare SEQ1 with SEQ2, return index of first mismatching element. -Return nil if the sequences match. If one sequence is a prefix of the -other, the return value indicates the end of the shorter sequence. - -Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end - -\(fn SEQ1 SEQ2 [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-search "cl-seq" "\ -Search for SEQ1 as a subsequence of SEQ2. -Return the index of the leftmost element of the first match found; -return nil if there are no matches. - -Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end - -\(fn SEQ1 SEQ2 [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-sort "cl-seq" "\ -Sort the argument SEQ according to PREDICATE. -This is a destructive function; it reuses the storage of SEQ if possible. - -Keywords supported: :key - -\(fn SEQ PREDICATE [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-stable-sort "cl-seq" "\ -Sort the argument SEQ stably according to PREDICATE. -This is a destructive function; it reuses the storage of SEQ if possible. - -Keywords supported: :key - -\(fn SEQ PREDICATE [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-merge "cl-seq" "\ -Destructively merge the two sequences to produce a new sequence. -TYPE is the sequence type to return, SEQ1 and SEQ2 are the two argument -sequences, and PREDICATE is a `less-than' predicate on the elements. - -Keywords supported: :key - -\(fn TYPE SEQ1 SEQ2 PREDICATE [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-member "cl-seq" "\ -Find the first occurrence of ITEM in LIST. -Return the sublist of LIST whose car is ITEM. - -Keywords supported: :test :test-not :key - -\(fn ITEM LIST [KEYWORD VALUE]...)" nil nil) - -(eval-and-compile (put 'cl-member 'compiler-macro #'cl--compiler-macro-member)) - -(autoload 'cl-member-if "cl-seq" "\ -Find the first item satisfying PREDICATE in LIST. -Return the sublist of LIST whose car matches. - -Keywords supported: :key - -\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-member-if-not "cl-seq" "\ -Find the first item not satisfying PREDICATE in LIST. -Return the sublist of LIST whose car matches. - -Keywords supported: :key - -\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl--adjoin "cl-seq" "\ - - -\(fn CL-ITEM CL-LIST &rest CL-KEYS)" nil nil) - -(autoload 'cl-assoc "cl-seq" "\ -Find the first item whose car matches ITEM in LIST. - -Keywords supported: :test :test-not :key - -\(fn ITEM LIST [KEYWORD VALUE]...)" nil nil) - -(eval-and-compile (put 'cl-assoc 'compiler-macro #'cl--compiler-macro-assoc)) - -(autoload 'cl-assoc-if "cl-seq" "\ -Find the first item whose car satisfies PREDICATE in LIST. - -Keywords supported: :key - -\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-assoc-if-not "cl-seq" "\ -Find the first item whose car does not satisfy PREDICATE in LIST. - -Keywords supported: :key - -\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-rassoc "cl-seq" "\ -Find the first item whose cdr matches ITEM in LIST. - -Keywords supported: :test :test-not :key - -\(fn ITEM LIST [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-rassoc-if "cl-seq" "\ -Find the first item whose cdr satisfies PREDICATE in LIST. - -Keywords supported: :key - -\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-rassoc-if-not "cl-seq" "\ -Find the first item whose cdr does not satisfy PREDICATE in LIST. - -Keywords supported: :key - -\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-union "cl-seq" "\ -Combine LIST1 and LIST2 using a set-union operation. -The resulting list contains all items that appear in either LIST1 or LIST2. -This is a non-destructive function; it makes a copy of the data if necessary -to avoid corrupting the original LIST1 and LIST2. - -Keywords supported: :test :test-not :key - -\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-nunion "cl-seq" "\ -Combine LIST1 and LIST2 using a set-union operation. -The resulting list contains all items that appear in either LIST1 or LIST2. -This is a destructive function; it reuses the storage of LIST1 and LIST2 -whenever possible. - -Keywords supported: :test :test-not :key - -\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-intersection "cl-seq" "\ -Combine LIST1 and LIST2 using a set-intersection operation. -The resulting list contains all items that appear in both LIST1 and LIST2. -This is a non-destructive function; it makes a copy of the data if necessary -to avoid corrupting the original LIST1 and LIST2. - -Keywords supported: :test :test-not :key - -\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-nintersection "cl-seq" "\ -Combine LIST1 and LIST2 using a set-intersection operation. -The resulting list contains all items that appear in both LIST1 and LIST2. -This is a destructive function; it reuses the storage of LIST1 and LIST2 -whenever possible. - -Keywords supported: :test :test-not :key - -\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-set-difference "cl-seq" "\ -Combine LIST1 and LIST2 using a set-difference operation. -The resulting list contains all items that appear in LIST1 but not LIST2. -This is a non-destructive function; it makes a copy of the data if necessary -to avoid corrupting the original LIST1 and LIST2. - -Keywords supported: :test :test-not :key - -\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-nset-difference "cl-seq" "\ -Combine LIST1 and LIST2 using a set-difference operation. -The resulting list contains all items that appear in LIST1 but not LIST2. -This is a destructive function; it reuses the storage of LIST1 and LIST2 -whenever possible. - -Keywords supported: :test :test-not :key - -\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-set-exclusive-or "cl-seq" "\ -Combine LIST1 and LIST2 using a set-exclusive-or operation. -The resulting list contains all items appearing in exactly one of LIST1, LIST2. -This is a non-destructive function; it makes a copy of the data if necessary -to avoid corrupting the original LIST1 and LIST2. - -Keywords supported: :test :test-not :key - -\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-nset-exclusive-or "cl-seq" "\ -Combine LIST1 and LIST2 using a set-exclusive-or operation. -The resulting list contains all items appearing in exactly one of LIST1, LIST2. -This is a destructive function; it reuses the storage of LIST1 and LIST2 -whenever possible. - -Keywords supported: :test :test-not :key - -\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-subsetp "cl-seq" "\ -Return true if LIST1 is a subset of LIST2. -I.e., if every element of LIST1 also appears in LIST2. - -Keywords supported: :test :test-not :key - -\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-subst-if "cl-seq" "\ -Substitute NEW for elements matching PREDICATE in TREE (non-destructively). -Return a copy of TREE with all matching elements replaced by NEW. - -Keywords supported: :key - -\(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-subst-if-not "cl-seq" "\ -Substitute NEW for elts not matching PREDICATE in TREE (non-destructively). -Return a copy of TREE with all non-matching elements replaced by NEW. - -Keywords supported: :key - -\(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-nsubst "cl-seq" "\ -Substitute NEW for OLD everywhere in TREE (destructively). -Any element of TREE which is `eql' to OLD is changed to NEW (via a call -to `setcar'). - -Keywords supported: :test :test-not :key - -\(fn NEW OLD TREE [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-nsubst-if "cl-seq" "\ -Substitute NEW for elements matching PREDICATE in TREE (destructively). -Any element of TREE which matches is changed to NEW (via a call to `setcar'). - -Keywords supported: :key - -\(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-nsubst-if-not "cl-seq" "\ -Substitute NEW for elements not matching PREDICATE in TREE (destructively). -Any element of TREE which matches is changed to NEW (via a call to `setcar'). - -Keywords supported: :key - -\(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-sublis "cl-seq" "\ -Perform substitutions indicated by ALIST in TREE (non-destructively). -Return a copy of TREE with all matching elements replaced. - -Keywords supported: :test :test-not :key - -\(fn ALIST TREE [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-nsublis "cl-seq" "\ -Perform substitutions indicated by ALIST in TREE (destructively). -Any matching element of TREE is changed via a call to `setcar'. - -Keywords supported: :test :test-not :key - -\(fn ALIST TREE [KEYWORD VALUE]...)" nil nil) - -(autoload 'cl-tree-equal "cl-seq" "\ -Return t if trees TREE1 and TREE2 have `eql' leaves. -Atoms are compared by `eql'; cons cells are compared recursively. - -Keywords supported: :test :test-not :key - -\(fn TREE1 TREE2 [KEYWORD VALUE]...)" nil nil) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; cl-loaddefs.el ends here diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 66ad8e769b5..384aa18e153 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -584,7 +584,7 @@ If `load' is in WHEN, BODY is evaluated when loaded after top-level compile. If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level. \(fn (WHEN...) BODY...)" - (declare (indent 1) (debug ((&rest &or "compile" "load" "eval") body))) + (declare (indent 1) (debug (sexp body))) (if (and (fboundp 'cl--compiling-file) (cl--compiling-file) (not cl--not-toplevel) (not (boundp 'for-effect))) ;Horrible kludge. (let ((comp (or (memq 'compile when) (memq :compile-toplevel when))) @@ -2276,9 +2276,10 @@ OPTION is either a single keyword or (KEYWORD VALUE) where KEYWORD can be one of :conc-name, :constructor, :copier, :predicate, :type, :named, :initial-offset, :print-function, or :include. -Each SLOT may instead take the form (SLOT SLOT-OPTS...), where -SLOT-OPTS are keyword-value pairs for that slot. Currently, only -one keyword is supported, `:read-only'. If this has a non-nil +Each SLOT may instead take the form (SNAME SDEFAULT SOPTIONS...), where +SDEFAULT is the default value of that slot and SOPTIONS are keyword-value +pairs for that slot. +Currently, only one keyword is supported, `:read-only'. If this has a non-nil value, that slot cannot be set via `setf'. \(fn NAME SLOTS...)" @@ -2574,9 +2575,16 @@ The type name can then be used in `cl-typecase', `cl-check-type', etc." (defun cl-typep (object type) ; See compiler macro below. "Check that OBJECT is of type TYPE. TYPE is a Common Lisp-style type specifier." + (declare (compiler-macro cl--compiler-macro-typep)) (let ((cl--object object)) ;; Yuck!! (eval (cl--make-type-test 'cl--object type)))) +(defun cl--compiler-macro-typep (form val type) + (if (macroexp-const-p type) + (macroexp-let2 macroexp-copyable-p temp val + (cl--make-type-test temp (cl--const-expr-val type))) + form)) + ;;;###autoload (defmacro cl-check-type (form type &optional string) "Verify that FORM is of type TYPE; signal an error if not. @@ -2635,19 +2643,13 @@ and then returning foo." (let ((p args) (res nil)) (while (consp p) (push (pop p) res)) (setq args (nconc (nreverse res) (and p (list '&rest p))))) - `(cl-eval-when (compile load eval) - (put ',func 'compiler-macro - (cl-function (lambda ,(if (memq '&whole args) (delq '&whole args) - (cons '_cl-whole-arg args)) - ,@body))) - ;; This is so that describe-function can locate - ;; the macro definition. - (let ((file ,(or buffer-file-name - (and (boundp 'byte-compile-current-file) - (stringp byte-compile-current-file) - byte-compile-current-file)))) - (if file (put ',func 'compiler-macro-file - (purecopy (file-name-nondirectory file))))))) + (let ((fname (make-symbol (concat (symbol-name func) "--cmacro")))) + `(eval-and-compile + ;; Name the compiler-macro function, so that `symbol-file' can find it. + (cl-defun ,fname ,(if (memq '&whole args) (delq '&whole args) + (cons '_cl-whole-arg args)) + ,@body) + (put ',func 'compiler-macro #',fname)))) ;;;###autoload (defun cl-compiler-macroexpand (form) @@ -2737,9 +2739,17 @@ surrounded by (cl-block NAME ...). (setq body (cond ((null substs) body) ((null (cdr substs)) (cl-subst (cdar substs) (caar substs) body)) - (t (cl-sublis substs body)))) + (t (cl--sublis substs body)))) (if lets `(let ,lets ,body) body)))) +(defun cl--sublis (alist tree) + "Perform substitutions indicated by ALIST in TREE (non-destructively)." + (let ((x (assq tree alist))) + (cond + (x (cdr x)) + ((consp tree) + (cons (cl--sublis alist (car tree)) (cl--sublis alist (cdr tree)))) + (t tree)))) ;; Compile-time optimizations for some functions defined in this package. @@ -2773,12 +2783,6 @@ surrounded by (cl-block NAME ...). `(cl-getf (symbol-plist ,sym) ,prop ,def) `(get ,sym ,prop))) -(cl-define-compiler-macro cl-typep (&whole form val type) - (if (macroexp-const-p type) - (macroexp-let2 macroexp-copyable-p temp val - (cl--make-type-test temp (cl--const-expr-val type))) - form)) - (dolist (y '(cl-first cl-second cl-third cl-fourth cl-fifth cl-sixth cl-seventh cl-eighth cl-ninth cl-tenth diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el index f9917bddd42..aff07b29edf 100644 --- a/lisp/emacs-lisp/eieio-custom.el +++ b/lisp/emacs-lisp/eieio-custom.el @@ -4,7 +4,8 @@ ;; Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> -;; Version: 0.2 +;; Old-Version: 0.2 (using "Version:" made Emacs think this is package +;; eieio-0.2). ;; Keywords: OO, lisp ;; Package: eieio diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 3cdf1f078bd..fc5da3198f9 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -115,7 +115,12 @@ Options in CLOS not supported in EIEIO: Due to the way class options are set up, you can add any tags you wish, and reference them using the function `class-option'." - `(eieio-defclass ',name ',superclass ',slots ',options-and-doc)) + ;; This is eval-and-compile only to silence spurious compiler warnings + ;; about functions and variables not known to be defined. + ;; When eieio-defclass code is merged here and this becomes + ;; transparent to the compiler, the eval-and-compile can be removed. + `(eval-and-compile + (eieio-defclass ',name ',superclass ',slots ',options-and-doc))) ;;; CLOS style implementation of object creators. diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el index dd5ff0ec694..3eb64f9f7f0 100644 --- a/lisp/emacs-lisp/generic.el +++ b/lisp/emacs-lisp/generic.el @@ -44,11 +44,8 @@ ;; end at the end of the line.) Emacs does not support comment ;; strings of more than two characters in length. ;; -;; * List of keywords to font-lock. Each keyword should be a string. -;; If you have additional keywords which should be highlighted in a -;; face different from `font-lock-keyword-face', you can use the -;; convenience function `generic-make-keywords-list' (which see), -;; and add the result to the following list: +;; * List of keywords to font-lock in `font-lock-keyword-face'. +;; Each keyword should be a string. ;; ;; * Additional expressions to font-lock. This should be a list of ;; expressions, each of which should be of the same form as those in @@ -93,6 +90,8 @@ ;;; Code: +(eval-when-compile (require 'pcase)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Internal Variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -224,18 +223,11 @@ Some generic modes are defined in `generic-x.el'." (funcall (intern mode))) ;;; Comment Functionality -(defun generic-mode-set-comments (comment-list) - "Set up comment functionality for generic mode." - (let ((st (make-syntax-table)) - (chars nil) - (comstyles)) - (make-local-variable 'comment-start) - (make-local-variable 'comment-start-skip) - (make-local-variable 'comment-end) - ;; Go through all the comments +(defun generic--normalise-comments (comment-list) + (let ((normalized '())) (dolist (start comment-list) - (let (end (comstyle "")) + (let (end) ;; Normalize (when (consp start) (setq end (cdr start)) @@ -244,58 +236,79 @@ Some generic modes are defined in `generic-x.el'." (cond ((characterp end) (setq end (char-to-string end))) ((zerop (length end)) (setq end "\n"))) + (push (cons start end) normalized))) + (nreverse normalized))) - ;; Setup the vars for `comment-region' - (if comment-start - ;; We have already setup a comment-style, so use style b - (progn - (setq comstyle "b") - (setq comment-start-skip - (concat comment-start-skip "\\|" (regexp-quote start) "+\\s-*"))) - ;; First comment-style - (setq comment-start start) - (setq comment-end (if (string-equal end "\n") "" end)) - (setq comment-start-skip (concat (regexp-quote start) "+\\s-*"))) - - ;; Reuse comstyles if necessary - (setq comstyle +(defun generic-set-comment-syntax (st comment-list) + "Set up comment functionality for generic mode." + (let ((chars nil) + (comstyles) + (comstyle "") + (comment-start nil)) + + ;; Go through all the comments. + (pcase-dolist (`(,start . ,end) comment-list) + (let ((comstyle + ;; Reuse comstyles if necessary. (or (cdr (assoc start comstyles)) (cdr (assoc end comstyles)) - comstyle)) + ;; Otherwise, use a style not yet in use. + (if (not (rassoc "" comstyles)) "") + (if (not (rassoc "b" comstyles)) "b") + "c"))) (push (cons start comstyle) comstyles) (push (cons end comstyle) comstyles) - ;; Setup the syntax table + ;; Setup the syntax table. (if (= (length start) 1) - (modify-syntax-entry (string-to-char start) + (modify-syntax-entry (aref start 0) (concat "< " comstyle) st) - (let ((c0 (elt start 0)) (c1 (elt start 1))) - ;; Store the relevant info but don't update yet + (let ((c0 (aref start 0)) (c1 (aref start 1))) + ;; Store the relevant info but don't update yet. (push (cons c0 (concat (cdr (assoc c0 chars)) "1")) chars) (push (cons c1 (concat (cdr (assoc c1 chars)) (concat "2" comstyle))) chars))) (if (= (length end) 1) - (modify-syntax-entry (string-to-char end) + (modify-syntax-entry (aref end 0) (concat ">" comstyle) st) - (let ((c0 (elt end 0)) (c1 (elt end 1))) - ;; Store the relevant info but don't update yet + (let ((c0 (aref end 0)) (c1 (aref end 1))) + ;; Store the relevant info but don't update yet. (push (cons c0 (concat (cdr (assoc c0 chars)) (concat "3" comstyle))) chars) (push (cons c1 (concat (cdr (assoc c1 chars)) "4")) chars))))) ;; Process the chars that were part of a 2-char comment marker + (with-syntax-table st ;For `char-syntax'. (dolist (cs (nreverse chars)) (modify-syntax-entry (car cs) (concat (char-to-string (char-syntax (car cs))) " " (cdr cs)) - st)) + st))))) + +(defun generic-set-comment-vars (comment-list) + (when comment-list + (setq-local comment-start (caar comment-list)) + (setq-local comment-end + (let ((end (cdar comment-list))) + (if (string-equal end "\n") "" end))) + (setq-local comment-start-skip + (concat (regexp-opt (mapcar #'car comment-list)) + "+[ \t]*")) + (setq-local comment-end-skip + (concat "[ \t]*" (regexp-opt (mapcar #'cdr comment-list)))))) + +(defun generic-mode-set-comments (comment-list) + "Set up comment functionality for generic mode." + (let ((st (make-syntax-table)) + (comment-list (generic--normalise-comments comment-list))) + (generic-set-comment-syntax st comment-list) + (generic-set-comment-vars comment-list) (set-syntax-table st))) (defun generic-bracket-support () "Imenu support for [KEYWORD] constructs found in INF, INI and Samba files." - (setq imenu-generic-expression - '((nil "^\\[\\(.*\\)\\]" 1)) - imenu-case-fold-search t)) + (setq-local imenu-generic-expression '((nil "^\\[\\(.*\\)\\]" 1))) + (setq-local imenu-case-fold-search t)) ;;;###autoload (defun generic-make-keywords-list (keyword-list face &optional prefix suffix) @@ -306,6 +319,7 @@ expression that matches these keywords and concatenates it with PREFIX and SUFFIX. Then it returns a construct based on this regular expression that can be used as an element of `font-lock-keywords'." + (declare (obsolete regexp-opt "24.4")) (unless (listp keyword-list) (error "Keywords argument must be a list of strings")) (list (concat prefix "\\_<" diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index cbd8854e7d6..af30deca4cc 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -1,4 +1,4 @@ -;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands +;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands -*- coding: utf-8 -*- ;; Copyright (C) 1985-1986, 1999-2013 Free Software Foundation, Inc. @@ -231,7 +231,7 @@ font-lock keywords will not be case sensitive." (font-lock-mark-block-function . mark-defun) (font-lock-syntactic-face-function . lisp-font-lock-syntactic-face-function))) - (prog-prettify-install lisp--prettify-symbols-alist)) + (setq-local prettify-symbols-alist lisp--prettify-symbols-alist)) (defun lisp-outline-level () "Lisp mode `outline-level' function." diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index a31bef2391d..b37a811b8d5 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -59,7 +59,8 @@ Should take the same arguments and behave similarly to `forward-sexp'.") "Move forward across one balanced expression (sexp). With ARG, do it that many times. Negative arg -N means move backward across N balanced expressions. -This command assumes point is not in a string or comment." +This command assumes point is not in a string or comment. +Calls `forward-sexp-function' to do the work, if that is non-nil." (interactive "^p") (or arg (setq arg 1)) (if forward-sexp-function @@ -71,7 +72,8 @@ This command assumes point is not in a string or comment." "Move backward across one balanced expression (sexp). With ARG, do it that many times. Negative arg -N means move forward across N balanced expressions. -This command assumes point is not in a string or comment." +This command assumes point is not in a string or comment. +Uses `forward-sexp' to do the work." (interactive "^p") (or arg (setq arg 1)) (forward-sexp (- arg))) diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el index 13202a9ce4d..1919d47687b 100644 --- a/lisp/emacs-lisp/map-ynp.el +++ b/lisp/emacs-lisp/map-ynp.el @@ -1,4 +1,4 @@ -;;; map-ynp.el --- general-purpose boolean question-asker +;;; map-ynp.el --- general-purpose boolean question-asker -*- lexical-binding:t -*- ;; Copyright (C) 1991-1995, 2000-2013 Free Software Foundation, Inc. @@ -79,7 +79,7 @@ are meaningful here. Returns the number of actions taken." (let* ((actions 0) - user-keys mouse-event map prompt char elt tail def + user-keys mouse-event map prompt char elt def ;; Non-nil means we should use mouse menus to ask. use-menus delayed-switch-frame @@ -89,13 +89,15 @@ Returns the number of actions taken." (next (if (functionp list) (lambda () (setq elt (funcall list))) (lambda () (when list - (setq elt (pop list)) - t))))) + (setq elt (pop list)) + t)))) + (try-again (lambda () + (let ((x next)) + (setq next (lambda () (setq next x) elt)))))) (if (and (listp last-nonmenu-event) use-dialog-box) ;; Make a list describing a dialog box. - (let ((object (if help (capitalize (nth 0 help)))) - (objects (if help (capitalize (nth 1 help)))) + (let ((objects (if help (capitalize (nth 1 help)))) (action (if help (capitalize (nth 2 help))))) (setq map `(("Yes" . act) ("No" . skip) ,@(mapcar (lambda (elt) @@ -129,8 +131,8 @@ Returns the number of actions taken." (unwind-protect (progn (if (stringp prompter) - (setq prompter `(lambda (object) - (format ,prompter object)))) + (setq prompter (lambda (object) + (format prompter object)))) (while (funcall next) (setq prompt (funcall prompter elt)) (cond ((stringp prompt) @@ -176,9 +178,7 @@ Returns the number of actions taken." next (lambda () nil))) ((eq def 'quit) (setq quit-flag t) - (setq next `(lambda () - (setq next ',next) - ',elt))) + (funcall try-again)) ((eq def 'automatic) ;; Act on this and all following objects. (if (funcall prompter elt) @@ -219,40 +219,30 @@ the current %s and exit." (with-current-buffer standard-output (help-mode))) - (setq next `(lambda () - (setq next ',next) - ',elt))) - ((and (symbolp def) (commandp def)) - (call-interactively def) - ;; Regurgitated; try again. - (setq next `(lambda () - (setq next ',next) - ',elt))) + (funcall try-again)) + ((and (symbolp def) (commandp def)) + (call-interactively def) + ;; Regurgitated; try again. + (funcall try-again)) ((vectorp def) ;; A user-defined key. (if (funcall (aref def 0) elt) ;Call its function. ;; The function has eaten this object. (setq actions (1+ actions)) ;; Regurgitated; try again. - (setq next `(lambda () - (setq next ',next) - ',elt)))) + (funcall try-again))) ((and (consp char) (eq (car char) 'switch-frame)) ;; switch-frame event. Put it off until we're done. (setq delayed-switch-frame char) - (setq next `(lambda () - (setq next ',next) - ',elt))) + (funcall try-again)) (t ;; Random char. (message "Type %s for help." (key-description (vector help-char))) (beep) (sit-for 1) - (setq next `(lambda () - (setq next ',next) - ',elt))))) + (funcall try-again)))) (prompt (funcall actor elt) (setq actions (1+ actions)))))) diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el index a3ce1672a63..7d0d75f7cee 100644 --- a/lisp/emacs-lisp/package-x.el +++ b/lisp/emacs-lisp/package-x.el @@ -162,9 +162,11 @@ DESCRIPTION is the text of the news item." description archive-url)) -(defun package-upload-buffer-internal (pkg-info extension &optional archive-url) +(declare-function lm-commentary "lisp-mnt" (&optional file)) + +(defun package-upload-buffer-internal (pkg-desc extension &optional archive-url) "Upload a package whose contents are in the current buffer. -PKG-INFO is the package info, see `package-buffer-info'. +PKG-DESC is the `package-desc'. EXTENSION is the file extension, a string. It can be either \"el\" or \"tar\". @@ -196,18 +198,18 @@ if it exists." (error "Aborted"))) (save-excursion (save-restriction - (let* ((file-type (cond - ((equal extension "el") 'single) - ((equal extension "tar") 'tar) - (t (error "Unknown extension `%s'" extension)))) - (file-name (aref pkg-info 0)) - (pkg-name (intern file-name)) - (requires (aref pkg-info 1)) - (desc (if (string= (aref pkg-info 2) "") + (let* ((file-type (package-desc-kind pkg-desc)) + (pkg-name (package-desc-name pkg-desc)) + (requires (package-desc-reqs pkg-desc)) + (desc (if (eq (package-desc-summary pkg-desc) + package--default-summary) (read-string "Description of package: ") - (aref pkg-info 2))) - (pkg-version (aref pkg-info 3)) - (commentary (aref pkg-info 4)) + (package-desc-summary pkg-desc))) + (pkg-version (package-desc-version pkg-desc)) + (commentary + (pcase file-type + (`single (lm-commentary)) + (`tar nil))) ;; FIXME: Get it from the README file. (split-version (version-to-list pkg-version)) (pkg-buffer (current-buffer))) @@ -215,13 +217,14 @@ if it exists." ;; from `package-archive-upload-base' otherwise. (let ((contents (or (package--archive-contents-from-url archive-url) (package--archive-contents-from-file))) - (new-desc (vector split-version requires desc file-type))) + (new-desc (package-make-ac-desc + split-version requires desc file-type))) (if (> (car contents) package-archive-version) (error "Unrecognized archive version %d" (car contents))) (let ((elt (assq pkg-name (cdr contents)))) (if elt (if (version-list-<= split-version - (package-desc-vers (cdr elt))) + (package-desc-version (cdr elt))) (error "New package has smaller version: %s" pkg-version) (setcdr elt new-desc)) (setq contents (cons (car contents) @@ -232,6 +235,7 @@ if it exists." ;; this and the package itself. For now we assume ELPA is ;; writable via file primitives. (let ((print-level nil) + (print-quoted t) (print-length nil)) (write-region (concat (pp-to-string contents) "\n") nil @@ -241,29 +245,29 @@ if it exists." ;; If there is a commentary section, write it. (when commentary (write-region commentary nil - (expand-file-name - (concat (symbol-name pkg-name) "-readme.txt") - package-archive-upload-base))) + (expand-file-name + (concat (symbol-name pkg-name) "-readme.txt") + package-archive-upload-base))) (set-buffer pkg-buffer) (write-region (point-min) (point-max) (expand-file-name - (concat file-name "-" pkg-version "." extension) + (format "%s-%s.%s" pkg-name pkg-version extension) package-archive-upload-base) nil nil nil 'excl) ;; Write a news entry. (and package-update-news-on-upload archive-url - (package--update-news (concat file-name "." extension) + (package--update-news (format "%s.%s" pkg-name extension) pkg-version desc archive-url)) ;; special-case "package": write a second copy so that the ;; installer can easily find the latest version. - (if (string= file-name "package") + (if (eq pkg-name 'package) (write-region (point-min) (point-max) (expand-file-name - (concat file-name "." extension) + (format "%s.%s" pkg-name extension) package-archive-upload-base) nil nil nil 'ask)))))))) @@ -275,8 +279,8 @@ destination, prompt for one." (save-excursion (save-restriction ;; Find the package in this buffer. - (let ((pkg-info (package-buffer-info))) - (package-upload-buffer-internal pkg-info "el"))))) + (let ((pkg-desc (package-buffer-info))) + (package-upload-buffer-internal pkg-desc "el"))))) (defun package-upload-file (file) "Upload the Emacs Lisp package FILE to the package archive. @@ -287,13 +291,15 @@ If `package-archive-upload-base' does not specify a valid upload destination, prompt for one." (interactive "fPackage file name: ") (with-temp-buffer - (insert-file-contents-literally file) - (let ((info (cond - ((string-match "\\.tar$" file) (package-tar-file-info file)) - ((string-match "\\.el$" file) (package-buffer-info)) - (t (error "Unrecognized extension `%s'" - (file-name-extension file)))))) - (package-upload-buffer-internal info (file-name-extension file))))) + (insert-file-contents file) + (let ((pkg-desc + (cond + ((string-match "\\.tar\\'" file) + (tar-mode) (package-tar-file-info)) + ((string-match "\\.el\\'" file) (package-buffer-info)) + (t (error "Unrecognized extension `%s'" + (file-name-extension file)))))) + (package-upload-buffer-internal pkg-desc (file-name-extension file))))) (defun package-gnus-summary-upload () "Upload a package contained in the current *Article* buffer. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 41b635bbe30..e5833703ad5 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -140,7 +140,6 @@ ;; installing it ;; - Interface with desktop.el so that restarting after an install ;; works properly -;; - Implement M-x package-upgrade, to upgrade any/all existing packages ;; - Use hierarchical layout. PKG/etc PKG/lisp PKG/info ;; ... except maybe lisp? ;; - It may be nice to have a macro that expands to the package's @@ -159,17 +158,12 @@ ;; - Allow optional package dependencies ;; then if we require 'bbdb', bbdb-specific lisp in lisp/bbdb ;; and just don't compile to add to load path ...? -;; - Have a list of archive URLs? [ maybe there's no point ] -;; - David Kastrup pointed out on the xemacs list that for GPL it -;; is friendlier to ship the source tree. We could "support" that -;; by just having a "src" subdir in the package. This isn't ideal -;; but it probably is not worth trying to support random source -;; tree layouts, build schemes, etc. ;; - Our treatment of the info path is somewhat bogus -;; - perhaps have an "unstable" tree in ELPA as well as a stable one ;;; Code: +(eval-when-compile (require 'cl-lib)) + (require 'tabulated-list) (defgroup package nil @@ -198,8 +192,7 @@ versions of all packages not specified by other elements. For an element (NAME VERSION), NAME is a package name (a symbol). VERSION should be t, a string, or nil. -If VERSION is t, all versions are loaded, though obsolete ones - will be put in `package-obsolete-alist' and not activated. +If VERSION is t, the most recent version is activated. If VERSION is a string, only that version is ever loaded. Any other version, even if newer, is silently ignored. Hence, the package is \"held\" at that version. @@ -262,11 +255,8 @@ Lower version numbers than this will probably be understood as well.") ;; We don't prime the cache since it tends to get out of date. (defvar package-archive-contents nil "Cache of the contents of the Emacs Lisp Package Archive. -This is an alist mapping package names (symbols) to package -descriptor vectors. These are like the vectors for `package-alist' -but have extra entries: one which is 'tar for tar packages and -'single for single-file packages, and one which is the name of -the archive from which it came.") +This is an alist mapping package names (symbols) to +`package-desc' structures.") (put 'package-archive-contents 'risky-local-variable t) (defcustom package-user-dir (locate-user-emacs-file "elpa") @@ -297,35 +287,92 @@ contrast, `package-user-dir' contains packages for personal use." :group 'package :version "24.1") -;; The value is precomputed in finder-inf.el, but don't load that -;; until it's needed (i.e. when `package-initialize' is called). +(defvar package--default-summary "No description available.") + +(cl-defstruct (package-desc + ;; Rename the default constructor from `make-package-desc'. + (:constructor package-desc-create) + ;; Has the same interface as the old `define-package', + ;; which is still used in the "foo-pkg.el" files. Extra + ;; options can be supported by adding additional keys. + (:constructor + package-desc-from-define + (name-string version-string &optional summary requirements + &key kind archive + &aux + (name (intern name-string)) + (version (version-to-list version-string)) + (reqs (mapcar #'(lambda (elt) + (list (car elt) + (version-to-list (cadr elt)))) + (if (eq 'quote (car requirements)) + (nth 1 requirements) + requirements)))))) + "Structure containing information about an individual package. + +Slots: + +`name' Name of the package, as a symbol. + +`version' Version of the package, as a version list. + +`summary' Short description of the package, typically taken from +the first line of the file. + +`reqs' Requirements of the package. A list of (PACKAGE +VERSION-LIST) naming the dependent package and the minimum +required version. + +`kind' The distribution format of the package. Currently, it is +either `single' or `tar'. + +`archive' The name of the archive (as a string) whence this +package came. + +`dir' The directory where the package is installed (if installed)." + name + version + (summary package--default-summary) + reqs + kind + archive + dir) + +;; Pseudo fields. +(defun package-desc-full-name (pkg-desc) + (format "%s-%s" + (package-desc-name pkg-desc) + (package-version-join (package-desc-version pkg-desc)))) + +(defun package-desc-suffix (pkg-desc) + (pcase (package-desc-kind pkg-desc) + (`single ".el") + (`tar ".tar") + (kind (error "Unknown package kind: %s" kind)))) + +;; Package descriptor format used in finder-inf.el and package--builtins. +(cl-defstruct (package--bi-desc + (:constructor package-make-builtin (version summary)) + (:type vector)) + version + reqs + summary) + (defvar package--builtins nil "Alist of built-in packages. The actual value is initialized by loading the library `finder-inf'; this is not done until it is needed, e.g. by the function `package-built-in-p'. -Each element has the form (PKG . DESC), where PKG is a package -name (a symbol) and DESC is a vector that describes the package. -The vector DESC has the form [VERSION-LIST REQS DOCSTRING]. - VERSION-LIST is a version list. - REQS is a list of packages required by the package, each - requirement having the form (NAME VL), where NAME is a string - and VL is a version list. - DOCSTRING is a brief description of the package.") +Each element has the form (PKG . PACKAGE-BI-DESC), where PKG is a package +name (a symbol) and DESC is a `package--bi-desc' structure.") (put 'package--builtins 'risky-local-variable t) (defvar package-alist nil "Alist of all packages available for activation. -Each element has the form (PKG . DESC), where PKG is a package -name (a symbol) and DESC is a vector that describes the package. - -The vector DESC has the form [VERSION-LIST REQS DOCSTRING]. - VERSION-LIST is a version list. - REQS is a list of packages required by the package, each - requirement having the form (NAME VL) where NAME is a string - and VL is a version list. - DOCSTRING is a brief description of the package. +Each element has the form (PKG . DESCS), where PKG is a package +name (a symbol) and DESCS is a non-empty list of `package-desc' structure, +sorted by decreasing versions. This variable is set automatically by `package-load-descriptor', called via `package-initialize'. To change which packages are @@ -333,15 +380,10 @@ loaded and/or activated, customize `package-load-list'.") (put 'package-alist 'risky-local-variable t) (defvar package-activated-list nil + ;; FIXME: This should implicitly include all builtin packages. "List of the names of currently activated packages.") (put 'package-activated-list 'risky-local-variable t) -(defvar package-obsolete-alist nil - "Representation of obsolete packages. -Like `package-alist', but maps package name to a second alist. -The inner alist is keyed by version.") -(put 'package-obsolete-alist 'risky-local-variable t) - (defun package-version-join (vlist) "Return the version string corresponding to the list VLIST. This is, approximately, the inverse of `version-to-list'. @@ -371,23 +413,18 @@ This is, approximately, the inverse of `version-to-list'. (pop str-list)) (apply 'concat (nreverse str-list))))) -(defun package-strip-version (dirname) - "Strip the version from a combined package name and version. -E.g., if given \"quux-23.0\", will return \"quux\"" - (if (string-match (concat "\\`" package-subdirectory-regexp "\\'") dirname) - (match-string 1 dirname))) - -(defun package-load-descriptor (dir package) - "Load the description file in directory DIR for package PACKAGE. -Here, PACKAGE is a string of the form NAME-VERSION, where NAME is -the package name and VERSION is its version." - (let* ((pkg-dir (expand-file-name package dir)) - (pkg-file (expand-file-name - (concat (package-strip-version package) "-pkg") - pkg-dir))) - (when (and (file-directory-p pkg-dir) - (file-exists-p (concat pkg-file ".el"))) - (load pkg-file nil t)))) +(defun package-load-descriptor (pkg-dir) + "Load the description file in directory PKG-DIR." + (let ((pkg-file (expand-file-name (package--description-file pkg-dir) + pkg-dir))) + (when (file-exists-p pkg-file) + (with-temp-buffer + (insert-file-contents pkg-file) + (goto-char (point-min)) + (let ((pkg-desc (package-process-define-package + (read (current-buffer)) pkg-file))) + (setf (package-desc-dir pkg-desc) pkg-dir) + pkg-desc))))) (defun package-load-all-descriptors () "Load descriptors for installed Emacs Lisp packages. @@ -397,76 +434,35 @@ controls which package subdirectories may be loaded. In each valid package subdirectory, this function loads the description file containing a call to `define-package', which -updates `package-alist' and `package-obsolete-alist'." - (let ((regexp (concat "\\`" package-subdirectory-regexp "\\'"))) - (dolist (dir (cons package-user-dir package-directory-list)) - (when (file-directory-p dir) - (dolist (subdir (directory-files dir)) - (when (string-match regexp subdir) - (package-maybe-load-descriptor (match-string 1 subdir) - (match-string 2 subdir) - dir))))))) - -(defun package-maybe-load-descriptor (name version dir) - "Maybe load a specific package from directory DIR. -NAME and VERSION are the package's name and version strings. -This function checks `package-load-list', before actually loading -the package by calling `package-load-descriptor'." - (let ((force (assq (intern name) package-load-list)) - (subdir (concat name "-" version))) - (and (file-directory-p (expand-file-name subdir dir)) - ;; Check `package-load-list': - (cond ((null force) - (memq 'all package-load-list)) - ((null (setq force (cadr force))) - nil) ; disabled - ((eq force t) - t) - ((stringp force) ; held - (version-list-= (version-to-list version) - (version-to-list force))) - (t - (error "Invalid element in `package-load-list'"))) - ;; Actually load the descriptor: - (package-load-descriptor dir subdir)))) - -(defsubst package-desc-vers (desc) - "Extract version from a package description vector." - (aref desc 0)) - -(defsubst package-desc-reqs (desc) - "Extract requirements from a package description vector." - (aref desc 1)) - -(defsubst package-desc-doc (desc) - "Extract doc string from a package description vector." - (aref desc 2)) - -(defsubst package-desc-kind (desc) - "Extract the kind of download from an archive package description vector." - (aref desc 3)) - -(defun package--dir (name version) - "Return the directory where a package is installed, or nil if none. -NAME and VERSION are both strings." - (let* ((subdir (concat name "-" version)) - (dir-list (cons package-user-dir package-directory-list)) - pkg-dir) - (while dir-list - (let ((subdir-full (expand-file-name subdir (car dir-list)))) - (if (file-directory-p subdir-full) - (setq pkg-dir subdir-full - dir-list nil) - (setq dir-list (cdr dir-list))))) - pkg-dir)) - -(defun package-activate-1 (package pkg-vec) - (let* ((name (symbol-name package)) - (version-str (package-version-join (package-desc-vers pkg-vec))) - (pkg-dir (package--dir name version-str))) +updates `package-alist'." + (dolist (dir (cons package-user-dir package-directory-list)) + (when (file-directory-p dir) + (dolist (subdir (directory-files dir)) + (let ((pkg-dir (expand-file-name subdir dir))) + (when (file-directory-p pkg-dir) + (package-load-descriptor pkg-dir))))))) + +(defun package-disabled-p (pkg-name version) + "Return whether PKG-NAME at VERSION can be activated. +The decision is made according to `package-load-list'. +Return nil if the package can be activated. +Return t if the package is completely disabled. +Return the max version (as a string) if the package is held at a lower version." + (let ((force (assq pkg-name package-load-list))) + (cond ((null force) (not (memq 'all package-load-list))) + ((null (setq force (cadr force))) t) ; disabled + ((eq force t) nil) + ((stringp force) ; held + (unless (version-list-= version (version-to-list force)) + force)) + (t (error "Invalid element in `package-load-list'"))))) + +(defun package-activate-1 (pkg-desc) + (let* ((name (package-desc-name pkg-desc)) + (pkg-dir (package-desc-dir pkg-desc))) (unless pkg-dir - (error "Internal error: unable to find directory for `%s-%s'" - name version-str)) + (error "Internal error: unable to find directory for `%s'" + (package-desc-full-name pkg-desc))) ;; Add info node. (when (file-exists-p (expand-file-name "dir" pkg-dir)) ;; FIXME: not the friendliest, but simple. @@ -475,8 +471,8 @@ NAME and VERSION are both strings." (push pkg-dir Info-directory-list)) ;; Add to load path, add autoloads, and activate the package. (push pkg-dir load-path) - (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t) - (push package package-activated-list) + (load (expand-file-name (format "%s-autoloads" name) pkg-dir) nil t) + (push name package-activated-list) ;; Don't return nil. t)) @@ -484,66 +480,60 @@ NAME and VERSION are both strings." "Return true if PACKAGE is built-in to Emacs. Optional arg MIN-VERSION, if non-nil, should be a version list specifying the minimum acceptable version." - (require 'finder-inf nil t) ; For `package--builtins'. - (if (eq package 'emacs) - (version-list-<= min-version (version-to-list emacs-version)) - (let ((elt (assq package package--builtins))) - (and elt (version-list-<= min-version - (package-desc-vers (cdr elt))))))) + (let ((bi (assq package package--builtin-versions))) + (cond + (bi (version-list-<= min-version (cdr bi))) + (min-version nil) + (t + (require 'finder-inf nil t) ; For `package--builtins'. + (assq package package--builtins))))) + +(defun package--from-builtin (bi-desc) + (package-desc-create :name (pop bi-desc) + :version (package--bi-desc-version bi-desc) + :summary (package--bi-desc-summary bi-desc))) ;; This function goes ahead and activates a newer version of a package ;; if an older one was already activated. This is not ideal; we'd at ;; least need to check to see if the package has actually been loaded, ;; and not merely activated. -(defun package-activate (package min-version) - "Activate package PACKAGE, of version MIN-VERSION or newer. -MIN-VERSION should be a version list. -If PACKAGE has any dependencies, recursively activate them. -Return nil if the package could not be activated." - (let ((pkg-vec (cdr (assq package package-alist))) - available-version found) +(defun package-activate (package &optional force) + "Activate package PACKAGE. +If FORCE is true, (re-)activate it if it's already activated." + (let ((pkg-descs (cdr (assq package package-alist)))) ;; Check if PACKAGE is available in `package-alist'. - (when pkg-vec - (setq available-version (package-desc-vers pkg-vec) - found (version-list-<= min-version available-version))) + (while + (when pkg-descs + (let ((available-version (package-desc-version (car pkg-descs)))) + (or (package-disabled-p package available-version) + ;; Prefer a builtin package. + (package-built-in-p package available-version)))) + (setq pkg-descs (cdr pkg-descs))) (cond ;; If no such package is found, maybe it's built-in. - ((null found) - (package-built-in-p package min-version)) + ((null pkg-descs) + (package-built-in-p package)) ;; If the package is already activated, just return t. - ((memq package package-activated-list) + ((and (memq package package-activated-list) (not force)) t) ;; Otherwise, proceed with activation. (t - (let ((fail (catch 'dep-failure - ;; Activate its dependencies recursively. - (dolist (req (package-desc-reqs pkg-vec)) - (unless (package-activate (car req) (cadr req)) - (throw 'dep-failure req)))))) + (let* ((pkg-vec (car pkg-descs)) + (fail (catch 'dep-failure + ;; Activate its dependencies recursively. + (dolist (req (package-desc-reqs pkg-vec)) + (unless (package-activate (car req) (cadr req)) + (throw 'dep-failure req)))))) (if fail (warn "Unable to activate package `%s'. Required package `%s-%s' is unavailable" package (car fail) (package-version-join (cadr fail))) ;; If all goes well, activate the package itself. - (package-activate-1 package pkg-vec))))))) - -(defun package-mark-obsolete (package pkg-vec) - "Put package on the obsolete list, if not already there." - (let ((elt (assq package package-obsolete-alist))) - (if elt - ;; If this obsolete version does not exist in the list, update - ;; it the list. - (unless (assoc (package-desc-vers pkg-vec) (cdr elt)) - (setcdr elt (cons (cons (package-desc-vers pkg-vec) pkg-vec) - (cdr elt)))) - ;; Make a new association. - (push (cons package (list (cons (package-desc-vers pkg-vec) - pkg-vec))) - package-obsolete-alist)))) - -(defun define-package (name-string version-string - &optional docstring requirements - &rest _extra-properties) + (package-activate-1 pkg-vec))))))) + +(defun define-package (_name-string _version-string + &optional _docstring _requirements + &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. @@ -553,35 +543,30 @@ REQUIREMENTS is a list of dependencies on other packages. where OTHER-VERSION is a string. EXTRA-PROPERTIES is currently unused." - (let* ((name (intern name-string)) - (version (version-to-list version-string)) - (new-pkg-desc - (cons name - (vector version - (mapcar - (lambda (elt) - (list (car elt) - (version-to-list (car (cdr elt))))) - requirements) - docstring))) - (old-pkg (assq name package-alist))) - (cond - ;; If there's no old package, just add this to `package-alist'. - ((null old-pkg) - (push new-pkg-desc package-alist)) - ((version-list-< (package-desc-vers (cdr old-pkg)) version) - ;; Remove the old package and declare it obsolete. - (package-mark-obsolete name (cdr old-pkg)) - (setq package-alist (cons new-pkg-desc - (delq old-pkg package-alist)))) - ;; You can have two packages with the same version, e.g. one in - ;; the system package directory and one in your private - ;; directory. We just let the first one win. - ((not (version-list-= (package-desc-vers (cdr old-pkg)) version)) - ;; The package is born obsolete. - (package-mark-obsolete name (cdr new-pkg-desc)))))) - -;; From Emacs 22. + ;; FIXME: Placeholder! Should we keep it? + (error "Don't call me!")) + +(defun package-process-define-package (exp origin) + (unless (eq (car-safe exp) 'define-package) + (error "Can't find define-package in %s" origin)) + (let* ((new-pkg-desc (apply #'package-desc-from-define (cdr exp))) + (name (package-desc-name new-pkg-desc)) + (version (package-desc-version new-pkg-desc)) + (old-pkgs (assq name package-alist))) + (if (null old-pkgs) + ;; If there's no old package, just add this to `package-alist'. + (push (list name new-pkg-desc) package-alist) + ;; If there is, insert the new package at the right place in the list. + (while old-pkgs + (cond + ((null (cdr old-pkgs)) (push new-pkg-desc (cdr old-pkgs))) + ((version-list-< (package-desc-version (cadr old-pkgs)) version) + (push new-pkg-desc (cdr old-pkgs)) + (setq old-pkgs nil))) + (setq old-pkgs (cdr old-pkgs)))) + new-pkg-desc)) + +;; From Emacs 22, but changed so it adds to load-path. (defun package-autoload-ensure-default-file (file) "Make sure that the autoload file FILE exists and if not create it." (unless (file-exists-p file) @@ -603,14 +588,15 @@ 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")) + (let* ((auto-name (format "%s-autoloads.el" name)) ;;(ignore-name (concat name "-pkg.el")) (generated-autoload-file (expand-file-name auto-name pkg-dir)) (version-control 'never)) (package-autoload-ensure-default-file generated-autoload-file) (update-directory-autoloads pkg-dir) (let ((buf (find-buffer-visiting generated-autoload-file))) - (when buf (kill-buffer buf))))) + (when buf (kill-buffer buf))) + auto-name)) (defvar tar-parse-info) (declare-function tar-untar-buffer "tar-mode" ()) @@ -636,66 +622,79 @@ untar into a directory named DIR; otherwise, signal an error." (error "Package does not untar cleanly into directory %s/" dir))))) (tar-untar-buffer)) -(defun package-unpack (package version) - (let* ((name (symbol-name package)) - (dirname (concat name "-" version)) +(defun package-generate-description-file (pkg-desc pkg-dir) + "Create the foo-pkg.el file for single-file packages." + (let* ((name (package-desc-name pkg-desc)) + (pkg-file (expand-file-name (package--description-file pkg-dir) + pkg-dir))) + (let ((print-level nil) + (print-quoted t) + (print-length nil)) + (write-region + (concat + (prin1-to-string + (list 'define-package + (symbol-name name) + (package-version-join (package-desc-version pkg-desc)) + (package-desc-summary pkg-desc) + (let ((requires (package-desc-reqs pkg-desc))) + (list 'quote + ;; Turn version lists into string form. + (mapcar + (lambda (elt) + (list (car elt) + (package-version-join (cadr elt)))) + requires))))) + "\n") + nil + pkg-file)))) + +(defun package-unpack (pkg-desc) + "Install the contents of the current buffer as a package." + (let* ((name (package-desc-name pkg-desc)) + (dirname (package-desc-full-name pkg-desc)) (pkg-dir (expand-file-name dirname package-user-dir))) - (make-directory package-user-dir t) - ;; FIXME: should we delete PKG-DIR if it exists? - (let* ((default-directory (file-name-as-directory package-user-dir))) - (package-untar-buffer dirname) - (package--make-autoloads-and-compile name pkg-dir)))) - -(defun package--make-autoloads-and-compile (name pkg-dir) - "Generate autoloads and do byte-compilation for package named NAME. -PKG-DIR is the name of the package directory." - (package-generate-autoloads name pkg-dir) - (let ((load-path (cons pkg-dir load-path))) - ;; We must load the autoloads file before byte compiling, in - ;; case there are magic cookies to set up non-trivial paths. - (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t) - (byte-recompile-directory pkg-dir 0 t))) + (pcase (package-desc-kind pkg-desc) + (`tar + (make-directory package-user-dir t) + ;; FIXME: should we delete PKG-DIR if it exists? + (let* ((default-directory (file-name-as-directory package-user-dir))) + (package-untar-buffer dirname))) + (`single + (let ((el-file (expand-file-name (format "%s.el" name) pkg-dir))) + (make-directory pkg-dir t) + (package--write-file-no-coding el-file))) + (kind (error "Unknown package kind: %S" kind))) + (package--make-autoloads-and-stuff pkg-desc pkg-dir) + ;; Update package-alist. + (let ((new-desc (package-load-descriptor pkg-dir))) + ;; FIXME: Check that `new-desc' matches `desc'! + ;; FIXME: Compilation should be done as a separate, optional, step. + ;; E.g. for multi-package installs, we should first install all packages + ;; and then compile them. + (package--compile new-desc)) + ;; Try to activate it. + (package-activate name 'force) + pkg-dir)) + +(defun package--make-autoloads-and-stuff (pkg-desc pkg-dir) + "Generate autoloads, description file, etc.. for PKG-DESC installed at PKG-DIR." + (package-generate-autoloads (package-desc-name pkg-desc) pkg-dir) + (let ((desc-file (package--description-file pkg-dir))) + (unless (file-exists-p desc-file) + (package-generate-description-file pkg-desc pkg-dir))) + ;; FIXME: Create foo.info and dir file from foo.texi? + ) + +(defun package--compile (pkg-desc) + "Byte-compile installed package PKG-DESC." + (package-activate-1 pkg-desc) + (byte-recompile-directory (package-desc-dir pkg-desc) 0 t)) (defun package--write-file-no-coding (file-name) (let ((buffer-file-coding-system 'no-conversion)) (write-region (point-min) (point-max) file-name))) -(defun package-unpack-single (file-name version desc requires) - "Install the contents of the current buffer as a package." - ;; Special case "package". - (if (string= file-name "package") - (package--write-file-no-coding - (expand-file-name (concat file-name ".el") package-user-dir)) - (let* ((pkg-dir (expand-file-name (concat file-name "-" - (package-version-join - (version-to-list version))) - package-user-dir)) - (el-file (expand-file-name (concat file-name ".el") pkg-dir)) - (pkg-file (expand-file-name (concat file-name "-pkg.el") pkg-dir))) - (make-directory pkg-dir t) - (package--write-file-no-coding el-file) - (let ((print-level nil) - (print-length nil)) - (write-region - (concat - (prin1-to-string - (list 'define-package - file-name - version - desc - (list 'quote - ;; Turn version lists into string form. - (mapcar - (lambda (elt) - (list (car elt) - (package-version-join (cadr elt)))) - requires)))) - "\n") - nil - pkg-file - nil nil nil 'excl)) - (package--make-autoloads-and-compile file-name pkg-dir)))) - (defmacro package--with-work-buffer (location file &rest body) "Run BODY in a buffer containing the contents of FILE at LOCATION. LOCATION is the base location of a package archive, and should be @@ -705,6 +704,7 @@ FILE is the name of a file relative to that base location. This macro retrieves FILE from LOCATION into a temporary buffer, and evaluates BODY while that buffer is current. This work buffer is killed afterwards. Return the last value in BODY." + (declare (indent 2) (debug t)) `(let* ((http (string-match "\\`https?:" ,location)) (buffer (if http @@ -735,23 +735,15 @@ It will move point to somewhere in the headers." (let ((response (url-http-parse-response))) (when (or (< response 200) (>= response 300)) (error "Error during download request:%s" - (buffer-substring-no-properties (point) (progn - (end-of-line) - (point))))))) - -(defun package-download-single (name version desc requires) - "Download and install a single-file package." - (let ((location (package-archive-base name)) - (file (concat (symbol-name name) "-" version ".el"))) - (package--with-work-buffer location file - (package-unpack-single (symbol-name name) version desc requires)))) + (buffer-substring-no-properties (point) (line-end-position)))))) -(defun package-download-tar (name version) +(defun package-install-from-archive (pkg-desc) "Download and install a tar package." - (let ((location (package-archive-base name)) - (file (concat (symbol-name name) "-" version ".tar"))) + (let ((location (package-archive-base pkg-desc)) + (file (concat (package-desc-full-name pkg-desc) + (package-desc-suffix pkg-desc)))) (package--with-work-buffer location file - (package-unpack name version)))) + (package-unpack pkg-desc)))) (defvar package--initialized nil) @@ -759,12 +751,13 @@ It will move point to somewhere in the headers." "Return true if PACKAGE, of MIN-VERSION or newer, is installed. MIN-VERSION should be a version list." (unless package--initialized (error "package.el is not yet initialized!")) - (let ((pkg-desc (assq package package-alist))) - (if pkg-desc - (version-list-<= min-version - (package-desc-vers (cdr pkg-desc))) - ;; Also check built-in packages. - (package-built-in-p package min-version)))) + (or + (let ((pkg-descs (cdr (assq package package-alist)))) + (and pkg-descs + (version-list-<= min-version + (package-desc-version (car pkg-descs))))) + ;; Also check built-in packages. + (package-built-in-p package min-version))) (defun package-compute-transaction (package-list requirements) "Return a list of packages to be installed, including PACKAGE-LIST. @@ -785,37 +778,33 @@ not included in this list." (unless (package-installed-p next-pkg next-version) ;; A package is required, but not installed. It might also be ;; blocked via `package-load-list'. - (let ((pkg-desc (assq next-pkg package-archive-contents)) - hold) - (when (setq hold (assq next-pkg package-load-list)) - (setq hold (cadr hold)) - (cond ((eq hold t)) - ((eq hold nil) - (error "Required package '%s' is disabled" - (symbol-name next-pkg))) - ((null (stringp hold)) - (error "Invalid element in `package-load-list'")) - ((version-list-< (version-to-list hold) next-version) - (error "Package `%s' held at version %s, \ + (let ((pkg-desc (cdr (assq next-pkg package-archive-contents))) + ;; FIXME: package-disabled-p needs to use a <= test! + (disabled (package-disabled-p next-pkg next-version))) + (when disabled + (if (stringp disabled) + (error "Package `%s' held at version %s, \ but version %s required" - (symbol-name next-pkg) hold - (package-version-join next-version))))) + (symbol-name next-pkg) disabled + (package-version-join next-version)) + (error "Required package '%s' is disabled" + (symbol-name next-pkg)))) (unless pkg-desc (error "Package `%s-%s' is unavailable" (symbol-name next-pkg) (package-version-join next-version))) (unless (version-list-<= next-version - (package-desc-vers (cdr pkg-desc))) + (package-desc-version pkg-desc)) (error "Need package `%s-%s', but only %s is available" (symbol-name next-pkg) (package-version-join next-version) - (package-version-join (package-desc-vers (cdr pkg-desc))))) + (package-version-join (package-desc-version pkg-desc)))) ;; Move to front, so it gets installed early enough (bug#14082). (setq package-list (cons next-pkg (delq next-pkg package-list))) (setq package-list (package-compute-transaction package-list (package-desc-reqs - (cdr pkg-desc)))))))) + pkg-desc))))))) package-list) (defun package-read-from-string (str) @@ -860,35 +849,58 @@ If successful, set the variable `package-archive-contents'. If the archive version is too new, signal an error." ;; Version 1 of 'archive-contents' is identical to our internal ;; representation. - (let* ((dir (concat "archives/" archive)) - (contents-file (concat dir "/archive-contents")) - contents) - (when (setq contents (package--read-archive-file contents-file)) + (let* ((contents-file (format "archives/%s/archive-contents" archive)) + (contents (package--read-archive-file contents-file))) + (when contents (dolist (package contents) (package--add-to-archive-contents package archive))))) +;; Package descriptor objects used inside the "archive-contents" file. +;; Changing this defstruct implies changing the format of the +;; "archive-contents" files. +(cl-defstruct (package--ac-desc + (:constructor package-make-ac-desc (version reqs summary kind)) + (:copier nil) + (:type vector)) + version reqs summary kind) + (defun package--add-to-archive-contents (package archive) "Add the PACKAGE from the given ARCHIVE if necessary. -Also, add the originating archive to the end of the package vector." - (let* ((name (car package)) - (version (package-desc-vers (cdr package))) - (entry (cons name - (vconcat (cdr package) (vector archive)))) +PACKAGE should have the form (NAME . PACKAGE--AC-DESC). +Also, add the originating archive to the `package-desc' structure." + (let* ((name (car package)) + (version (package--ac-desc-version (cdr package))) + (pkg-desc + (package-desc-create + :name name + :version version + :reqs (package--ac-desc-reqs (cdr package)) + :summary (package--ac-desc-summary (cdr package)) + :kind (package--ac-desc-kind (cdr package)) + :archive archive)) + (entry (cons name pkg-desc)) (existing-package (assq name package-archive-contents)) (pinned-to-archive (assoc name package-pinned-packages))) - (cond ((and pinned-to-archive - ;; If pinned to another archive, skip entirely. - (not (equal (cdr pinned-to-archive) archive))) - nil) - ((not existing-package) - (add-to-list 'package-archive-contents entry)) - ((version-list-< (package-desc-vers (cdr existing-package)) - version) - ;; Replace the entry with this one. - (setq package-archive-contents - (cons entry - (delq existing-package - package-archive-contents))))))) + (cond + ;; Skip entirely if pinned to another archive or if no more recent + ;; than what we already have installed. + ((or (and pinned-to-archive + (not (equal (cdr pinned-to-archive) archive))) + (let ((bi (assq name package--builtin-versions))) + (and bi (version-list-<= version (cdr bi)))) + (let ((ins (cdr (assq name package-alist)))) + (and ins (version-list-<= version + (package-desc-version (car ins)))))) + nil) + ((not existing-package) + (push entry package-archive-contents)) + ((version-list-< (package-desc-version (cdr existing-package)) + version) + ;; Replace the entry with this one. + (setq package-archive-contents + (cons entry + (delq existing-package + package-archive-contents))))))) (defun package-download-transaction (package-list) "Download and install all the packages in PACKAGE-LIST. @@ -896,35 +908,16 @@ PACKAGE-LIST should be a list of package names (symbols). This function assumes that all package requirements in PACKAGE-LIST are satisfied, i.e. that PACKAGE-LIST is computed using `package-compute-transaction'." + ;; FIXME: make package-list a list of pkg-desc. (dolist (elt package-list) - (let* ((desc (cdr (assq elt package-archive-contents))) - ;; As an exception, if package is "held" in - ;; `package-load-list', download the held version. - (hold (cadr (assq elt package-load-list))) - (v-string (or (and (stringp hold) hold) - (package-version-join (package-desc-vers desc)))) - (kind (package-desc-kind desc))) - (cond - ((eq kind 'tar) - (package-download-tar elt v-string)) - ((eq kind 'single) - (package-download-single elt v-string - (package-desc-doc desc) - (package-desc-reqs desc))) - (t - (error "Unknown package kind: %s" (symbol-name kind)))) - ;; If package A depends on package B, then A may `require' B - ;; during byte compilation. So we need to activate B before - ;; unpacking A. - (package-maybe-load-descriptor (symbol-name elt) v-string - package-user-dir) - (package-activate elt (version-to-list v-string))))) + (let ((desc (cdr (assq elt package-archive-contents)))) + (package-install-from-archive desc)))) ;;;###autoload -(defun package-install (name) - "Install the package named NAME. -NAME should be the name of one of the available packages in an -archive in `package-archives'. Interactively, prompt for NAME." +(defun package-install (pkg-desc) + "Install the package PKG-DESC. +PKG-DESC should be one of the available packages in an +archive in `package-archives'. Interactively, prompt for its name." (interactive (progn ;; Initialize the package system to get the list of package @@ -933,20 +926,22 @@ archive in `package-archives'. Interactively, prompt for NAME." (package-initialize t)) (unless package-archive-contents (package-refresh-contents)) - (list (intern (completing-read - "Install package: " - (mapcar (lambda (elt) - (cons (symbol-name (car elt)) - nil)) - package-archive-contents) - nil t))))) - (let ((pkg-desc (assq name package-archive-contents))) - (unless pkg-desc - (error "Package `%s' is not available for installation" - (symbol-name name))) - (package-download-transaction - (package-compute-transaction (list name) - (package-desc-reqs (cdr pkg-desc)))))) + (let* ((name (intern (completing-read + "Install package: " + (mapcar (lambda (elt) + (cons (symbol-name (car elt)) + nil)) + package-archive-contents) + nil t))) + (pkg-desc (cdr (assq name package-archive-contents)))) + (unless pkg-desc + (error "Package `%s' is not available for installation" + name)) + (list pkg-desc)))) + (package-download-transaction + ;; FIXME: Use (list pkg-desc) instead of just the name. + (package-compute-transaction (list (package-desc-name pkg-desc)) + (package-desc-reqs pkg-desc)))) (defun package-strip-rcs-id (str) "Strip RCS version ID from the version string STR. @@ -961,17 +956,7 @@ Otherwise return nil." (error nil)))) (defun package-buffer-info () - "Return a vector describing the package in the current buffer. -The vector has the form - - [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY] - -FILENAME is the file name, a string, sans the \".el\" extension. -REQUIRES is a list of requirements, each requirement having the - form (NAME VER); NAME is a string and VER is a version list. -DESCRIPTION is the package description, a string. -VERSION is the version, a string. -COMMENTARY is the commentary section, a string, or nil if none. + "Return a `package-desc' describing the package in the current buffer. If the buffer does not contain a conforming package, signal an error. If there is a package, narrow the buffer to the file's @@ -990,104 +975,64 @@ boundaries." (require 'lisp-mnt) ;; Use some headers we've invented to drive the process. (let* ((requires-str (lm-header "package-requires")) - (requires (if requires-str - (package-read-from-string requires-str))) ;; Prefer Package-Version; if defined, the package author ;; probably wants us to use it. Otherwise try Version. (pkg-version (or (package-strip-rcs-id (lm-header "package-version")) - (package-strip-rcs-id (lm-header "version")))) - (commentary (lm-commentary))) + (package-strip-rcs-id (lm-header "version"))))) (unless pkg-version (error "Package lacks a \"Version\" or \"Package-Version\" header")) - ;; Turn string version numbers into list form. - (setq requires - (mapcar - (lambda (elt) - (list (car elt) - (version-to-list (car (cdr elt))))) - requires)) - (vector file-name requires desc pkg-version commentary)))) - -(defun package-tar-file-info (file) + (package-desc-from-define + file-name pkg-version desc + (if requires-str (package-read-from-string requires-str)) + :kind 'single)))) + +(declare-function tar-get-file-descriptor "tar-mode" (file)) +(declare-function tar--extract "tar-mode" (descriptor)) + +(defun package-tar-file-info () "Find package information for a tar file. -FILE is the name of the tar file to examine. -The return result is a vector like `package-buffer-info'." - (let ((default-directory (file-name-directory file)) - (file (file-name-nondirectory file))) - (unless (string-match (concat "\\`" package-subdirectory-regexp "\\.tar\\'") - file) - (error "Invalid package name `%s'" file)) - (let* ((pkg-name (match-string-no-properties 1 file)) - (pkg-version (match-string-no-properties 2 file)) - ;; Extract the package descriptor. - (pkg-def-contents (shell-command-to-string - ;; Requires GNU tar. - (concat "tar -xOf " file " " - - pkg-name "-" pkg-version "/" - pkg-name "-pkg.el"))) - (pkg-def-parsed (package-read-from-string pkg-def-contents))) - (unless (eq (car pkg-def-parsed) 'define-package) - (error "No `define-package' sexp is present in `%s-pkg.el'" pkg-name)) - (let ((name-str (nth 1 pkg-def-parsed)) - (version-string (nth 2 pkg-def-parsed)) - (docstring (nth 3 pkg-def-parsed)) - (requires (nth 4 pkg-def-parsed)) - (readme (shell-command-to-string - ;; Requires GNU tar. - (concat "tar -xOf " file " " - pkg-name "-" pkg-version "/README")))) - (unless (equal pkg-version version-string) - (error "Package has inconsistent versions")) - (unless (equal pkg-name name-str) - (error "Package has inconsistent names")) - ;; Kind of a hack. - (if (string-match ": Not found in archive" readme) - (setq readme nil)) - ;; Turn string version numbers into list form. - (if (eq (car requires) 'quote) - (setq requires (car (cdr requires)))) - (setq requires - (mapcar (lambda (elt) - (list (car elt) - (version-to-list (cadr elt)))) - requires)) - (vector pkg-name requires docstring version-string readme))))) +The return result is a `package-desc'." + (cl-assert (derived-mode-p 'tar-mode)) + (let* ((dir-name (file-name-directory + (tar-header-name (car tar-parse-info)))) + (desc-file (package--description-file dir-name)) + (tar-desc (tar-get-file-descriptor (concat dir-name desc-file)))) + (unless tar-desc + (error "No package descriptor file found")) + (with-current-buffer (tar--extract tar-desc) + (goto-char (point-min)) + (unwind-protect + (let* ((pkg-def-parsed (read (current-buffer))) + (pkg-desc + (if (not (eq (car pkg-def-parsed) 'define-package)) + (error "Can't find define-package in %s" + (tar-header-name tar-desc)) + (apply #'package-desc-from-define + (append (cdr pkg-def-parsed)))))) + (setf (package-desc-kind pkg-desc) 'tar) + pkg-desc) + (kill-buffer (current-buffer)))))) + ;;;###autoload -(defun package-install-from-buffer (pkg-info type) +(defun package-install-from-buffer () "Install a package from the current buffer. -When called interactively, the current buffer is assumed to be a -single .el file that follows the packaging guidelines; see info -node `(elisp)Packaging'. - -When called from Lisp, PKG-INFO is a vector describing the -information, of the type returned by `package-buffer-info'; and -TYPE is the package type (either `single' or `tar')." - (interactive (list (package-buffer-info) 'single)) - (save-excursion - (save-restriction - (let* ((file-name (aref pkg-info 0)) - (requires (aref pkg-info 1)) - (desc (if (string= (aref pkg-info 2) "") - "No description available." - (aref pkg-info 2))) - (pkg-version (aref pkg-info 3))) - ;; Download and install the dependencies. - (let ((transaction (package-compute-transaction nil requires))) - (package-download-transaction transaction)) - ;; Install the package itself. - (cond - ((eq type 'single) - (package-unpack-single file-name pkg-version desc requires)) - ((eq type 'tar) - (package-unpack (intern file-name) pkg-version)) - (t - (error "Unknown type: %s" (symbol-name type)))) - ;; Try to activate it. - (package-initialize))))) +The current buffer is assumed to be a single .el or .tar file that follows the +packaging guidelines; see info node `(elisp)Packaging'. +Downloads and installs required packages as needed." + (interactive) + (let ((pkg-desc (if (derived-mode-p 'tar-mode) + (package-tar-file-info) + (package-buffer-info)))) + ;; Download and install the dependencies. + (let* ((requires (package-desc-reqs pkg-desc)) + (transaction (package-compute-transaction nil requires))) + (package-download-transaction transaction)) + ;; Install the package itself. + (package-unpack pkg-desc) + pkg-desc)) ;;;###autoload (defun package-install-file (file) @@ -1096,37 +1041,32 @@ The file can either be a tar file or an Emacs Lisp file." (interactive "fPackage file name: ") (with-temp-buffer (insert-file-contents-literally file) - (cond - ((string-match "\\.el$" file) - (package-install-from-buffer (package-buffer-info) 'single)) - ((string-match "\\.tar$" file) - (package-install-from-buffer (package-tar-file-info file) 'tar)) - (t (error "Unrecognized extension `%s'" (file-name-extension file)))))) - -(defun package-delete (name version) - (let ((dir (package--dir name version))) + (when (string-match "\\.tar\\'" file) (tar-mode)) + (package-install-from-buffer))) + +(defun package-delete (pkg-desc) + (let ((dir (package-desc-dir pkg-desc))) (if (string-equal (file-name-directory dir) (file-name-as-directory (expand-file-name package-user-dir))) (progn (delete-directory dir t t) - (message "Package `%s-%s' deleted." name version)) + (message "Package `%s' deleted." (package-desc-full-name pkg-desc))) ;; Don't delete "system" packages - (error "Package `%s-%s' is a system package, not deleting" - name version)))) + (error "Package `%s' is a system package, not deleting" + (package-desc-full-name pkg-desc))))) -(defun package-archive-base (name) +(defun package-archive-base (desc) "Return the archive containing the package NAME." - (let ((desc (cdr (assq (intern-soft name) package-archive-contents)))) - (cdr (assoc (aref desc (- (length desc) 1)) package-archives)))) + (cdr (assoc (package-desc-archive desc) package-archives))) (defun package--download-one-archive (archive file) "Retrieve an archive file FILE from ARCHIVE, and cache it. ARCHIVE should be a cons cell of the form (NAME . LOCATION), similar to an entry in `package-alist'. Save the cached copy to \"archives/NAME/archive-contents\" in `package-user-dir'." - (let* ((dir (expand-file-name "archives" package-user-dir)) - (dir (expand-file-name (car archive) dir))) + (let* ((dir (expand-file-name (format "archives/%s" (car archive)) + package-user-dir))) (package--with-work-buffer (cdr archive) file ;; Read the retrieved buffer to make sure it is valid (e.g. it ;; may fetch a URL redirect page). @@ -1157,13 +1097,12 @@ makes them available for download." The variable `package-load-list' controls which packages to load. If optional arg NO-ACTIVATE is non-nil, don't activate packages." (interactive) - (setq package-alist nil - package-obsolete-alist nil) + (setq package-alist nil) (package-load-all-descriptors) (package-read-all-archive-contents) (unless no-activate (dolist (elt package-alist) - (package-activate (car elt) (package-desc-vers (cdr elt))))) + (package-activate (car elt)))) (setq package--initialized t)) @@ -1192,7 +1131,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." "Describe package: ") packages nil t nil nil guess)) (list (if (equal val "") guess (intern val))))) - (if (or (null package) (not (symbolp package))) + (if (not (and package (symbolp package))) (message "No package specified") (help-setup-xref (list #'describe-package package) (called-interactively-p 'interactive)) @@ -1209,23 +1148,23 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (princ " is ") (cond ;; Loaded packages are in `package-alist'. - ((setq desc (cdr (assq package package-alist))) - (setq version (package-version-join (package-desc-vers desc))) - (if (setq pkg-dir (package--dir package-name version)) + ((setq desc (cadr (assq package package-alist))) + (setq version (package-version-join (package-desc-version desc))) + (if (setq pkg-dir (package-desc-dir desc)) (insert "an installed package.\n\n") ;; This normally does not happen. (insert "a deleted package.\n\n"))) ;; Available packages are in `package-archive-contents'. ((setq desc (cdr (assq package package-archive-contents))) - (setq version (package-version-join (package-desc-vers desc)) - archive (aref desc (- (length desc) 1)) + (setq version (package-version-join (package-desc-version desc)) + archive (package-desc-archive desc) installable t) (if built-in (insert "a built-in package.\n\n") (insert "an uninstalled package.\n\n"))) (built-in - (setq desc (cdr built-in) - version (package-version-join (package-desc-vers desc))) + (setq desc (package--from-builtin built-in) + version (package-version-join (package-desc-version desc))) (insert "a built-in package.\n\n")) (t (insert "an orphan package.\n\n"))) @@ -1246,7 +1185,8 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (insert "'."))) (installable (if built-in - (insert (propertize "Built-in." 'font-lock-face 'font-lock-builtin-face) + (insert (propertize "Built-in." + 'font-lock-face 'font-lock-builtin-face) " Alternate version available") (insert "Available")) (insert " from " archive) @@ -1258,10 +1198,11 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." :foreground "black") 'link))) (insert-text-button button-text 'face button-face 'follow-link t - 'package-symbol package + 'package-desc desc 'action 'package-install-button-action))) (built-in - (insert (propertize "Built-in." 'font-lock-face 'font-lock-builtin-face))) + (insert (propertize "Built-in." + 'font-lock-face 'font-lock-builtin-face))) (t (insert "Deleted."))) (insert "\n") (and version (> (length version) 0) @@ -1286,7 +1227,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (help-insert-xref-button text 'help-package name)) (insert "\n"))) (insert " " (propertize "Summary" 'font-lock-face 'bold) - ": " (if desc (package-desc-doc desc)) "\n\n") + ": " (if desc (package-desc-summary desc)) "\n\n") (if built-in ;; For built-in packages, insert the commentary. @@ -1306,7 +1247,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." ;; For elpa packages, try downloading the commentary. If that ;; fails, try an existing readme file in `package-user-dir'. (cond ((condition-case nil - (package--with-work-buffer (package-archive-base package) + (package--with-work-buffer (package-archive-base desc) (concat package-name "-readme.txt") (setq buffer-file-name (expand-file-name readme package-user-dir)) @@ -1321,9 +1262,10 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (goto-char (point-max)))))))) (defun package-install-button-action (button) - (let ((package (button-get button 'package-symbol))) - (when (y-or-n-p (format "Install package `%s'? " package)) - (package-install package) + (let ((pkg-desc (button-get button 'package-desc))) + (when (y-or-n-p (format "Install package `%s'? " + (package-desc-full-name pkg-desc))) + (package-install pkg-desc) (revert-buffer nil t) (goto-char (point-min))))) @@ -1412,89 +1354,97 @@ Letters do not insert themselves; instead, they are commands. (setq tabulated-list-sort-key (cons "Status" nil)) (tabulated-list-init-header)) -(defmacro package--push (package desc status listname) +(defmacro package--push (pkg-desc status listname) "Convenience macro for `package-menu--generate'. If the alist stored in the symbol LISTNAME lacks an entry for a -package PACKAGE with descriptor DESC, add one. The alist is -keyed with cons cells (PACKAGE . VERSION-LIST), where PACKAGE is -a symbol and VERSION-LIST is a version list." - `(let* ((version (package-desc-vers ,desc)) - (key (cons ,package version))) - (unless (assoc key ,listname) - (push (list key ,status (package-desc-doc ,desc)) ,listname)))) +package PKG-DESC, add one. The alist is keyed with PKG-DESC." + `(unless (assoc ,pkg-desc ,listname) + ;; FIXME: Should we move status into pkg-desc? + (push (cons ,pkg-desc ,status) ,listname))) + +(defvar package-list-unversioned nil + "If non-nil include packages that don't have a version in `list-package'.") (defun package-menu--generate (remember-pos packages) "Populate the Package Menu. 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). + ;; Construct list of (PKG-DESC . STATUS). (let (info-list name) ;; Installed packages: (dolist (elt package-alist) (setq name (car elt)) (when (or (eq packages t) (memq name packages)) - (package--push name (cdr elt) - (if (stringp (cadr (assq name package-load-list))) - "held" "installed") - info-list))) + (let* ((lle (assq name package-load-list)) + (held (cadr lle)) + (hv (if (stringp held) (version-to-list held)))) + (dolist (pkg (cdr elt)) + (let ((version (package-desc-version pkg))) + (package--push pkg + (cond + ((and lle (null held)) "disabled") + (hv + (cond + ((version-list-= version hv) "held") + ((version-list-< version hv) "obsolete") + (t "disabled"))) + ((package-built-in-p name version) "obsolete") + ((eq pkg (cadr elt)) "installed") + (t "obsolete")) + info-list)))))) ;; Built-in packages: (dolist (elt package--builtins) (setq name (car elt)) (when (and (not (eq name 'emacs)) ; Hide the `emacs' package. + (or package-list-unversioned + (package--bi-desc-version (cdr elt))) (or (eq packages t) (memq name packages))) - (package--push name (cdr elt) "built-in" info-list))) + (package--push (package--from-builtin elt) "built-in" info-list))) ;; Available and disabled packages: (dolist (elt package-archive-contents) (setq name (car elt)) (when (or (eq packages t) (memq name packages)) (let ((hold (assq name package-load-list))) - (package--push name (cdr elt) + (package--push (cdr elt) (cond ((and hold (null (cadr hold))) "disabled") ((memq name package-menu--new-package-list) "new") (t "available")) info-list)))) - ;; Obsolete packages: - (dolist (elt package-obsolete-alist) - (dolist (inner-elt (cdr elt)) - (when (or (eq packages t) (memq (car elt) packages)) - (package--push (car elt) (cdr inner-elt) "obsolete" info-list)))) - ;; Print the result. (setq tabulated-list-entries (mapcar 'package-menu--print-info info-list)) (tabulated-list-print remember-pos))) (defun package-menu--print-info (pkg) "Return a package entry suitable for `tabulated-list-entries'. -PKG has the form ((PACKAGE . VERSION) STATUS DOC). -Return (KEY [NAME VERSION STATUS DOC]), where KEY is the -identifier (NAME . VERSION-LIST)." - (let* ((package (caar pkg)) - (version (cdr (car pkg))) - (status (nth 1 pkg)) - (doc (or (nth 2 pkg) "")) - (face (cond - ((string= status "built-in") 'font-lock-builtin-face) - ((string= status "available") 'default) - ((string= status "new") 'bold) - ((string= status "held") 'font-lock-constant-face) - ((string= status "disabled") 'font-lock-warning-face) - ((string= status "installed") 'font-lock-comment-face) - (t 'font-lock-warning-face)))) ; obsolete. - (list (cons package version) - (vector (list (symbol-name package) +PKG has the form (PKG-DESC . STATUS). +Return (PKG-DESC [NAME VERSION STATUS DOC])." + (let* ((pkg-desc (car pkg)) + (status (cdr pkg)) + (face (pcase status + (`"built-in" 'font-lock-builtin-face) + (`"available" 'default) + (`"new" 'bold) + (`"held" 'font-lock-constant-face) + (`"disabled" 'font-lock-warning-face) + (`"installed" 'font-lock-comment-face) + (_ 'font-lock-warning-face)))) ; obsolete. + (list pkg-desc + (vector (list (symbol-name (package-desc-name pkg-desc)) 'face 'link 'follow-link t - 'package-symbol package + 'package-desc pkg-desc 'action 'package-menu-describe-package) - (propertize (package-version-join version) + (propertize (package-version-join + (package-desc-version pkg-desc)) 'font-lock-face face) (propertize status 'font-lock-face face) - (propertize doc 'font-lock-face face))))) + (propertize (package-desc-summary pkg-desc) + 'font-lock-face face))))) (defun package-menu-refresh () "Download the Emacs Lisp package archive. @@ -1510,10 +1460,11 @@ This fetches the contents of each archive specified in "Describe the current package. If optional arg BUTTON is non-nil, describe its associated package." (interactive) - (let ((package (if button (button-get button 'package-symbol) - (car (tabulated-list-get-id))))) - (if package - (describe-package package)))) + (let ((pkg-desc (if button (button-get button 'package-desc) + (tabulated-list-get-id)))) + (if pkg-desc + ;; FIXME: We could actually describe this particular pkg-desc. + (describe-package (package-desc-name pkg-desc))))) ;; fixme numeric argument (defun package-menu-mark-delete (&optional _num) @@ -1560,8 +1511,8 @@ If optional arg BUTTON is non-nil, describe its associated package." 'package-menu-view-commentary 'package-menu-describe-package "24.1") (defun package-menu-get-status () - (let* ((pkg (tabulated-list-get-id)) - (entry (and pkg (assq pkg tabulated-list-entries)))) + (let* ((id (tabulated-list-get-id)) + (entry (and id (assq id tabulated-list-entries)))) (if entry (aref (cadr entry) 2) ""))) @@ -1570,18 +1521,20 @@ If optional arg BUTTON is non-nil, describe its associated package." (let (installed available upgrades) ;; Build list of installed/available packages in this buffer. (dolist (entry tabulated-list-entries) - ;; ENTRY is ((NAME . VERSION) [NAME VERSION STATUS DOC]) - (let ((pkg (car entry)) + ;; ENTRY is (PKG-DESC [NAME VERSION STATUS DOC]) + (let ((pkg-desc (car entry)) (status (aref (cadr entry) 2))) (cond ((equal status "installed") - (push pkg installed)) + (push pkg-desc installed)) ((member status '("available" "new")) - (push pkg available))))) - ;; Loop through list of installed packages, finding upgrades - (dolist (pkg installed) - (let ((avail-pkg (assq (car pkg) available))) + (push (cons (package-desc-name pkg-desc) pkg-desc) + available))))) + ;; Loop through list of installed packages, finding upgrades. + (dolist (pkg-desc installed) + (let ((avail-pkg (assq (package-desc-name pkg-desc) available))) (and avail-pkg - (version-list-< (cdr pkg) (cdr avail-pkg)) + (version-list-< (package-desc-version pkg-desc) + (package-desc-version (cdr avail-pkg))) (push avail-pkg upgrades)))) upgrades)) @@ -1601,11 +1554,11 @@ call will upgrade the package." (save-excursion (goto-char (point-min)) (while (not (eobp)) - (let* ((pkg (tabulated-list-get-id)) - (upgrade (assq (car pkg) upgrades))) + (let* ((pkg-desc (tabulated-list-get-id)) + (upgrade (cdr (assq (package-desc-name pkg-desc) upgrades)))) (cond ((null upgrade) (forward-line 1)) - ((equal pkg upgrade) + ((equal pkg-desc upgrade) (package-menu-mark-install)) (t (package-menu-mark-delete)))))) @@ -1621,30 +1574,30 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm." (interactive) (unless (derived-mode-p 'package-menu-mode) (error "The current buffer is not in Package Menu mode")) - (let (install-list delete-list cmd id) + (let (install-list delete-list cmd pkg-desc) (save-excursion (goto-char (point-min)) (while (not (eobp)) (setq cmd (char-after)) (unless (eq cmd ?\s) - ;; This is the key (PACKAGE . VERSION-LIST). - (setq id (tabulated-list-get-id)) + ;; This is the key PKG-DESC. + (setq pkg-desc (tabulated-list-get-id)) (cond ((eq cmd ?D) - (push (cons (symbol-name (car id)) - (package-version-join (cdr id))) - delete-list)) + (push pkg-desc delete-list)) ((eq cmd ?I) - (push (car id) install-list)))) + (push pkg-desc install-list)))) (forward-line))) (when install-list (if (or noquery (yes-or-no-p - (if (= (length install-list) 1) - (format "Install package `%s'? " (car install-list)) - (format "Install these %d packages (%s)? " - (length install-list) - (mapconcat 'symbol-name install-list ", "))))) + (if (= (length install-list) 1) + (format "Install package `%s'? " + (package-desc-full-name (car install-list))) + (format "Install these %d packages (%s)? " + (length install-list) + (mapconcat #'package-desc-full-name + install-list ", "))))) (mapc 'package-install install-list))) ;; Delete packages, prompting if necessary. (when delete-list @@ -1652,18 +1605,15 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm." noquery (yes-or-no-p (if (= (length delete-list) 1) - (format "Delete package `%s-%s'? " - (caar delete-list) - (cdr (car delete-list))) + (format "Delete package `%s'? " + (package-desc-full-name (car delete-list))) (format "Delete these %d packages (%s)? " (length delete-list) - (mapconcat (lambda (elt) - (concat (car elt) "-" (cdr elt))) - delete-list - ", "))))) + (mapconcat #'package-desc-full-name + delete-list ", "))))) (dolist (elt delete-list) (condition-case-unless-debug err - (package-delete (car elt) (cdr elt)) + (package-delete elt) (error (message (cadr err))))) (error "Aborted"))) ;; If we deleted anything, regenerate `package-alist'. This is done @@ -1708,8 +1658,8 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm." (string< dA dB)))) (defun package-menu--name-predicate (A B) - (string< (symbol-name (caar A)) - (symbol-name (caar B)))) + (string< (symbol-name (package-desc-name (car A))) + (symbol-name (package-desc-name (car B))))) ;;;###autoload (defun list-packages (&optional no-fetch) diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 5660ac8c4cc..6119cc80835 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -41,7 +41,7 @@ ;; major mode, switch back, and have the original Tabulated List data ;; still valid. See, for example, ebuff-menu.el. -(defvar tabulated-list-format nil +(defvar-local tabulated-list-format nil "The format of the current Tabulated List mode buffer. This should be a vector of elements (NAME WIDTH SORT . PROPS), where: @@ -58,17 +58,15 @@ where: of `tabulated-list-entries'. - PROPS is a plist of additional column properties. Currently supported properties are: - - `:right-align': if non-nil, the column should be right-aligned. + - `:right-align': If non-nil, the column should be right-aligned. - `:pad-right': Number of additional padding spaces to the right of the column (defaults to 1 if omitted).") -(make-variable-buffer-local 'tabulated-list-format) (put 'tabulated-list-format 'permanent-local t) -(defvar tabulated-list-use-header-line t +(defvar-local tabulated-list-use-header-line t "Whether the Tabulated List buffer should use a header line.") -(make-variable-buffer-local 'tabulated-list-use-header-line) -(defvar tabulated-list-entries nil +(defvar-local tabulated-list-entries nil "Entries displayed in the current Tabulated List buffer. This should be either a function, or a list. If a list, each element has the form (ID [DESC1 ... DESCN]), @@ -86,28 +84,25 @@ where: If `tabulated-list-entries' is a function, it is called with no arguments and must return a list of the above form.") -(make-variable-buffer-local 'tabulated-list-entries) (put 'tabulated-list-entries 'permanent-local t) -(defvar tabulated-list-padding 0 +(defvar-local tabulated-list-padding 0 "Number of characters preceding each Tabulated List mode entry. By default, lines are padded with spaces, but you can use the function `tabulated-list-put-tag' to change this.") -(make-variable-buffer-local 'tabulated-list-padding) (put 'tabulated-list-padding 'permanent-local t) (defvar tabulated-list-revert-hook nil "Hook run before reverting a Tabulated List buffer. This is commonly used to recompute `tabulated-list-entries'.") -(defvar tabulated-list-printer 'tabulated-list-print-entry +(defvar-local tabulated-list-printer 'tabulated-list-print-entry "Function for inserting a Tabulated List entry at point. It is called with two arguments, ID and COLS. ID is a Lisp object identifying the entry, and COLS is a vector of column descriptors, as documented in `tabulated-list-entries'.") -(make-variable-buffer-local 'tabulated-list-printer) -(defvar tabulated-list-sort-key nil +(defvar-local tabulated-list-sort-key nil "Sort key for the current Tabulated List mode buffer. If nil, no additional sorting is performed. Otherwise, this should be a cons cell (NAME . FLIP). @@ -115,7 +110,6 @@ NAME is a string matching one of the column names in `tabulated-list-format' (the corresponding SORT entry in `tabulated-list-format' then specifies how to sort). FLIP, if non-nil, means to invert the resulting sort.") -(make-variable-buffer-local 'tabulated-list-sort-key) (put 'tabulated-list-sort-key 'permanent-local t) (defsubst tabulated-list-get-id (&optional pos) @@ -246,7 +240,7 @@ If ADVANCE is non-nil, move forward by one line afterwards." (if tabulated-list-use-header-line (setq header-line-format cols) (setq header-line-format nil) - (set (make-local-variable 'tabulated-list--header-string) cols)))) + (setq-local tabulated-list--header-string cols)))) (defun tabulated-list-print-fake-header () "Insert a fake Tabulated List \"header line\" at the start of the buffer." @@ -255,8 +249,8 @@ If ADVANCE is non-nil, move forward by one line afterwards." (insert tabulated-list--header-string "\n") (if tabulated-list--header-overlay (move-overlay tabulated-list--header-overlay (point-min) (point)) - (set (make-local-variable 'tabulated-list--header-overlay) - (make-overlay (point-min) (point)))) + (setq-local tabulated-list--header-overlay + (make-overlay (point-min) (point)))) (overlay-put tabulated-list--header-overlay 'face 'underline))) (defun tabulated-list-revert (&rest ignored) @@ -351,7 +345,7 @@ of column descriptors." (defun tabulated-list-print-col (n col-desc x) "Insert a specified Tabulated List entry at point. -N is the column number, COL-DESC is a column descriptor \(see +N is the column number, COL-DESC is a column descriptor (see `tabulated-list-entries'), and X is the column number at point. Return the column number after insertion." ;; TODO: don't truncate to `width' if the next column is align-right |