From e7f2c91bd112306c96643cd9e57b53527742a8db Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 14 Nov 2015 15:44:44 +0000 Subject: Backport: * lisp/emacs-lisp/package.el: Refactor -with-work-buffer-async. (package--with-work-buffer-async): Reimplement as `package--with-response-buffer'. (package--with-work-buffer): Mark obsolete. (package--with-response-buffer): New macro. This is a more self contained and less contrived version of `package--with-work-buffer-async'. It uses keyword arguments, doesn't have async on the name, doesn't fallback on `package--with-work-buffer', and has _much_ simpler error handling. On master, this macro will soon be part of another library (either standalone or inside url.el), which is why this commit is not to be merged back. (package--check-signature, package--download-one-archive) (package-install-from-archive, describe-package-1): Use it. (package--download-and-read-archives): Let `package--download-one-archive' take care of calling `package--update-downloads-in-progress'. --- lisp/emacs-lisp/package.el | 158 ++++++++++++++++++++++----------------------- 1 file changed, 76 insertions(+), 82 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 2962da5a917..fba07a6801e 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1124,7 +1124,8 @@ 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)) + (declare (indent 2) (debug t) + (obsolete package--with-response-buffer "25.1")) `(with-temp-buffer (if (string-match-p "\\`https?:" ,location) (url-insert-file-contents (concat ,location ,file)) @@ -1134,47 +1135,52 @@ buffer is killed afterwards. Return the last value in BODY." (insert-file-contents (expand-file-name ,file ,location))) ,@body)) -(defmacro package--with-work-buffer-async (location file async &rest body) - "Run BODY in a buffer containing the contents of FILE at LOCATION. -If ASYNC is non-nil, and if it is possible, run BODY -asynchronously. If an error is encountered and ASYNC is a -function, call it with no arguments (instead of executing BODY). -If it returns non-nil, or if it wasn't a function, propagate the -error. - -For a description of the other arguments see -`package--with-work-buffer'." - (declare (indent 3) (debug t)) - (macroexp-let2* macroexp-copyable-p - ((async-1 async) - (file-1 file) - (location-1 location)) - `(if (or (not ,async-1) - (not (string-match-p "\\`https?:" ,location-1))) - (package--with-work-buffer ,location-1 ,file-1 ,@body) - ;; This `condition-case' is to catch connection errors. - (condition-case error-signal - (url-retrieve (concat ,location-1 ,file-1) - ;; This is to catch execution errors. - (lambda (status) - (condition-case error-signal - (progn - (when-let ((er (plist-get status :error))) - (error "Error retrieving: %s %S" (concat ,location-1 ,file-1) er)) - (goto-char (point-min)) - (unless (search-forward "\n\n" nil 'noerror) - (error "Invalid url response in buffer %s" - (current-buffer))) - (delete-region (point-min) (point)) - ,@body - (kill-buffer (current-buffer))) - (error (when (if (functionp ,async-1) (funcall ,async-1) t) - (signal (car error-signal) (cdr error-signal)))))) - nil - 'silent) - (error (when (if (functionp ,async-1) (funcall ,async-1) t) - (message "Error contacting: %s" (concat ,location-1 ,file-1)) - (signal (car error-signal) (cdr error-signal)))))))) +(cl-defmacro package--with-response-buffer (url &rest body &key async file error-form noerror &allow-other-keys) + "Access URL and run BODY in a buffer containing the response. +Point is after the headers when BODY runs. +FILE, if provided, is added to URL. +URL can be a local file name, which must be absolute. +ASYNC, if non-nil, runs the request asynchronously. +ERROR-FORM is run only if an error occurs. If NOERROR is +non-nil, don't propagate errors caused by the connection or by +BODY (does not apply to errors signaled by ERROR-FORM). + +\(fn URL &key ASYNC FILE ERROR-FORM NOERROR &rest BODY)" + (declare (indent defun) (debug t)) + (while (keywordp (car body)) + (setq body (cdr (cdr body)))) + (macroexp-let2* nil ((url-1 url)) + `(cl-macrolet ((wrap-errors (&rest bodyforms) + (let ((err (make-symbol "err"))) + `(condition-case ,err + ,(macroexp-progn bodyforms) + ,(list 'error ',error-form + (list 'unless ',noerror + `(signal (car ,err) (cdr ,err)))))))) + (if (string-match-p "\\`https?:" ,url-1) + (let* ((url (concat ,url-1 ,file)) + (callback (lambda (status) + (let ((b (current-buffer))) + (unwind-protect (wrap-errors + (when-let ((er (plist-get status :error))) + (error "Error retrieving: %s %S" url er)) + (unless (search-forward-regexp "^\r?\n\r?" nil 'noerror) + (rest-error 'rest-unintelligible-result)) + (delete-region (point-min) (point)) + ,@body) + (when (buffer-live-p b) + (kill-buffer b))))))) + (if ,async + (wrap-errors (url-retrieve url callback nil 'silent)) + (let ((buffer (wrap-errors (url-retrieve-synchronously url 'silent)))) + (with-current-buffer buffer + (funcall callback nil))))) + (wrap-errors (with-temp-buffer + (let ((url (expand-file-name ,file ,url-1))) + (unless (file-name-absolute-p url) + (error "Location %s is not a url nor an absolute file name" url)) + (insert-file-contents url)) + ,@body)))))) (defun package--check-signature-content (content string &optional sig-file) "Check signature CONTENT against STRING. @@ -1220,15 +1226,12 @@ list can be empty). If the signatures file is not found, CALLBACK is called with no arguments." (let ((sig-file (concat file ".sig")) (string (or string (buffer-string)))) - (condition-case nil - (package--with-work-buffer-async - location sig-file (when async (or callback t)) - (let ((sig (package--check-signature-content - (buffer-string) string sig-file))) - (when callback (funcall callback sig)) - sig)) - (file-error (funcall callback))))) - + (package--with-response-buffer location :file sig-file + :async async :noerror t + :error-form (when callback (funcall callback nil)) + (let ((sig (package--check-signature-content (buffer-substring (point) (point-max)) string sig-file))) + (when callback (funcall callback sig)) + sig)))) ;;; Packages on Archives ;; The following variables store information about packages available @@ -1470,7 +1473,9 @@ Once it's empty, run `package--post-download-archives-hook'." 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/FILE\" in `package-user-dir'." - (package--with-work-buffer-async (cdr archive) file async + (package--with-response-buffer (cdr archive) :file file + :async async + :error-form (package--update-downloads-in-progress archive) (let* ((location (cdr archive)) (name (car archive)) (content (buffer-string)) @@ -1494,17 +1499,14 @@ similar to an entry in `package-alist'. Save the cached copy to ;; remove it from the in-progress list. (package--update-downloads-in-progress archive) (error "Unsigned archive `%s'" name)) + ;; Either everything worked or we don't mind not signing. ;; Write out the archives file. (write-region content nil local-file nil 'silent) ;; Write out good signatures into archive-contents.signed file. (when good-sigs (write-region (mapconcat #'epg-signature-to-string good-sigs "\n") nil (concat local-file ".signed") nil 'silent)) - (package--update-downloads-in-progress archive) - ;; If we got this far, either everything worked or we don't mind - ;; not signing, so tell `package--with-work-buffer-async' to not - ;; propagate errors. - nil))))))) + (package--update-downloads-in-progress archive)))))))) (defun package--download-and-read-archives (&optional async) "Download descriptions of all `package-archives' and read them. @@ -1517,12 +1519,7 @@ perform the downloads asynchronously." :test #'equal)) (dolist (archive package-archives) (condition-case-unless-debug nil - (package--download-one-archive - archive "archive-contents" - ;; Called if the async download fails - (when async - ;; The t at the end means to propagate connection errors. - (lambda () (package--update-downloads-in-progress archive) t))) + (package--download-one-archive archive "archive-contents" async) (error (message "Failed to download `%s' archive." (car archive)))))) @@ -1777,7 +1774,7 @@ if all the in-between dependencies are also in PACKAGE-LIST." (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--with-response-buffer location :file file (if (or (not package-check-signature) (member (package-desc-archive pkg-desc) package-unsigned-archives)) @@ -2368,26 +2365,23 @@ Otherwise no newline is inserted." (replace-match "")) (while (re-search-forward "^\\(;+ ?\\)" nil t) (replace-match "")))) - (let ((readme (expand-file-name (format "%s-readme.txt" name) - package-user-dir)) - readme-string) + (let* ((basename (format "%s-readme.txt" name)) + (readme (expand-file-name basename package-user-dir)) + readme-string) ;; For elpa packages, try downloading the commentary. If that ;; fails, try an existing readme file in `package-user-dir'. - (cond ((condition-case nil - (save-excursion - (package--with-work-buffer - (package-archive-base desc) - (format "%s-readme.txt" name) - (save-excursion - (goto-char (point-max)) - (unless (bolp) - (insert ?\n))) - (write-region nil nil - (expand-file-name readme package-user-dir) - nil 'silent) - (setq readme-string (buffer-string)) - t)) - (error nil)) + (cond ((and (package-desc-archive desc) + (package--with-response-buffer (package-archive-base desc) + :file basename :noerror t + (save-excursion + (goto-char (point-max)) + (unless (bolp) + (insert ?\n))) + (write-region nil nil + (expand-file-name readme package-user-dir) + nil 'silent) + (setq readme-string (buffer-string)) + t)) (insert readme-string)) ((file-readable-p readme) (insert-file-contents readme) -- cgit v1.2.1 From d99ccd6dd171a12cf528c03a4a956ad1751173c5 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 15 Nov 2015 21:28:37 +0000 Subject: Backport: * lisp/emacs-lisp/package.el: Fix a decoding issue. * lisp/url/url-handlers.el (url-insert-file-contents): Move some code to `url-insert-buffer-contents'. (url-insert-buffer-contents): New function (package--with-response-buffer): Use `url-insert-buffer-contents'. The previous code had some issues with decoding. Refactoring that function allows us to use the decoding from url-handlers while still treating both sync and async requests the same. --- lisp/emacs-lisp/package.el | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index fba07a6801e..d811db9579f 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1165,16 +1165,16 @@ BODY (does not apply to errors signaled by ERROR-FORM). (when-let ((er (plist-get status :error))) (error "Error retrieving: %s %S" url er)) (unless (search-forward-regexp "^\r?\n\r?" nil 'noerror) - (rest-error 'rest-unintelligible-result)) - (delete-region (point-min) (point)) - ,@body) - (when (buffer-live-p b) - (kill-buffer b))))))) + (error "Error retrieving: %s %S" url "incomprehensible buffer")) + (with-temp-buffer + (url-insert-buffer-contents b url) + (kill-buffer b) + (goto-char (point-min)) + ,@body))))))) (if ,async (wrap-errors (url-retrieve url callback nil 'silent)) - (let ((buffer (wrap-errors (url-retrieve-synchronously url 'silent)))) - (with-current-buffer buffer - (funcall callback nil))))) + (with-current-buffer (wrap-errors (url-retrieve-synchronously url 'silent)) + (funcall callback nil)))) (wrap-errors (with-temp-buffer (let ((url (expand-file-name ,file ,url-1))) (unless (file-name-absolute-p url) -- cgit v1.2.1 From 63acb2e8688db09f24b3a4a2dcb37eb597e12ef8 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 16 Nov 2015 09:49:00 +0000 Subject: * lisp/emacs-lisp/nadvice.el (add-function): Escape quote --- lisp/emacs-lisp/nadvice.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 2cd34e12810..1882eb194f6 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -279,7 +279,7 @@ a special meaning: whereas a depth of -100 means that the advice should be outermost. If PLACE is a symbol, its `default-value' will be affected. -Use (local 'SYMBOL) if you want to apply FUNCTION to SYMBOL buffer-locally. +Use (local \\='SYMBOL) if you want to apply FUNCTION to SYMBOL buffer-locally. Use (var VAR) if you want to apply FUNCTION to the (lexical) VAR. If one of FUNCTION or OLDFUN is interactive, then the resulting function -- cgit v1.2.1 From 31fc0567916751d37cc85233015f08d566e0ecf0 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 16 Nov 2015 13:53:45 +0000 Subject: * lisp/emacs-lisp/package.el (package--with-response-buffer): Missing require --- lisp/emacs-lisp/package.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index d811db9579f..2aea9d11d1f 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1161,6 +1161,7 @@ BODY (does not apply to errors signaled by ERROR-FORM). (let* ((url (concat ,url-1 ,file)) (callback (lambda (status) (let ((b (current-buffer))) + (require 'url-handlers) (unwind-protect (wrap-errors (when-let ((er (plist-get status :error))) (error "Error retrieving: %s %S" url er)) -- cgit v1.2.1 From c4b20fc936736053a0a07e060a1b8ff46c48e432 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Johan=20Bockg=C3=A5rd?= Date: Mon, 16 Nov 2015 00:07:06 +0100 Subject: pcase.el: Fix edebugging of backquoted cons patterns * lisp/emacs-lisp/pcase.el (pcase-QPAT): Fix edebugging of backquoted cons patterns. (Bug#21920) --- lisp/emacs-lisp/pcase.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index bf6550dfa3d..c87c2314be3 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -865,8 +865,10 @@ Otherwise, it defers to REST which is a list of branches of the form (def-edebug-spec pcase-QPAT + ;; Cf. edebug spec for `backquote-form' in edebug.el. (&or ("," pcase-PAT) - (pcase-QPAT . pcase-QPAT) + (pcase-QPAT [&rest [¬ ","] pcase-QPAT] + . [&or nil pcase-QPAT]) (vector &rest pcase-QPAT) sexp)) -- cgit v1.2.1 From ac16149ba470ae8a625d42a61adbb6e84254c675 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 17 Nov 2015 15:28:50 -0800 Subject: =?UTF-8?q?Fix=20docstring=20quoting=20problems=20with=20=E2=80=98?= =?UTF-8?q?=20'=E2=80=99?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Problem reported by Artur Malabarba in: http://lists.gnu.org/archive/html/emacs-devel/2015-11/msg01513.html Most of these fixes are to documentation; many involve fixing longstanding quoting glitches that are independent of the recent substitute-command-keys changes. The changes to code are: * lisp/cedet/mode-local.el (mode-local-augment-function-help) (describe-mode-local-overload): Substitute docstrings before displaying them. * lisp/emacs-lisp/cl-macs.el (cl--transform-lambda): Quote the generated docstring for later substitution. --- lisp/emacs-lisp/advice.el | 4 ++-- lisp/emacs-lisp/avl-tree.el | 2 +- lisp/emacs-lisp/backquote.el | 4 ++-- lisp/emacs-lisp/bytecomp.el | 6 +++--- lisp/emacs-lisp/chart.el | 4 ++-- lisp/emacs-lisp/cl-macs.el | 11 ++++++----- lisp/emacs-lisp/easy-mmode.el | 4 ++-- lisp/emacs-lisp/ert.el | 2 +- lisp/emacs-lisp/gv.el | 2 +- lisp/emacs-lisp/let-alist.el | 8 ++++---- 10 files changed, 24 insertions(+), 23 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 4ee830023fc..d13bc2ff4ff 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -1629,7 +1629,7 @@ COMPILE argument of `ad-activate' was supplied as nil." Only proper subtrees are considered, for example, if TREE is (1 (2 (3)) 4) then the subtrees will be 1 (2 (3)) 2 (3) 3 4, dotted structures are allowed too. Once a qualifying subtree has been found its subtrees will -not be considered anymore. (ad-substitute-tree 'atom 'identity tree) +not be considered anymore. (ad-substitute-tree \\='atom \\='identity tree) generates a copy of TREE." (cond ((consp tReE) (cons (if (funcall sUbTrEe-TeSt (car tReE)) @@ -2419,7 +2419,7 @@ as if they had been supplied to a function with TARGET-ARGLIST directly. Excess source arguments will be neglected, missing source arguments will be supplied as nil. Returns a `funcall' or `apply' form with the second element being `function' which has to be replaced by an actual function argument. -Example: (ad-map-arglists '(a &rest args) '(w x y z)) will return +Example: (ad-map-arglists \\='(a &rest args) \\='(w x y z)) will return (funcall ad--addoit-function a (car args) (car (cdr args)) (nth 2 args))." (let* ((parsed-source-arglist (ad-parse-arglist source-arglist)) (source-reqopt-args (append (nth 0 parsed-source-arglist) diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el index 99a329b021e..9dcebb2bf42 100644 --- a/lisp/emacs-lisp/avl-tree.el +++ b/lisp/emacs-lisp/avl-tree.el @@ -561,7 +561,7 @@ Note that if you don't care about the order in which FUNCTION is applied, just that the resulting list is in the correct order, then - (avl-tree-mapf function 'cons tree (not reverse)) + (avl-tree-mapf function \\='cons tree (not reverse)) is more efficient." (nreverse (avl-tree-mapf fun 'cons tree reverse))) diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el index dc61e156130..12bd8dae08c 100644 --- a/lisp/emacs-lisp/backquote.el +++ b/lisp/emacs-lisp/backquote.el @@ -43,7 +43,7 @@ (defun backquote-list*-function (first &rest list) "Like `list' but the last argument is the tail of the new list. -For example (backquote-list* 'a 'b 'c) => (a b . c)" +For example (backquote-list* \\='a \\='b \\='c) => (a b . c)" ;; The recursive solution is much nicer: ;; (if list (cons first (apply 'backquote-list*-function list)) first)) ;; but Emacs is not very good at efficiently processing recursion. @@ -60,7 +60,7 @@ For example (backquote-list* 'a 'b 'c) => (a b . c)" (defmacro backquote-list*-macro (first &rest list) "Like `list' but the last argument is the tail of the new list. -For example (backquote-list* 'a 'b 'c) => (a b . c)" +For example (backquote-list* \\='a \\='b \\='c) => (a b . c)" ;; The recursive solution is much nicer: ;; (if list (list 'cons first (cons 'backquote-list*-macro list)) first)) ;; but Emacs is not very good at efficiently processing such things. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index db200f3c504..024719168af 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -265,8 +265,8 @@ This option is enabled by default because it reduces Emacs memory usage." (defcustom byte-optimize-log nil "If non-nil, the byte-compiler will log its optimizations. -If this is 'source, then only source-level optimizations will be logged. -If it is 'byte, then only byte-level optimizations will be logged. +If this is `source', then only source-level optimizations will be logged. +If it is `byte', then only byte-level optimizations will be logged. The information is logged to `byte-compile-log-buffer'." :group 'bytecomp :type '(choice (const :tag "none" nil) @@ -1691,7 +1691,7 @@ Any other non-nil value of ARG means to ask the user. If optional argument LOAD is non-nil, loads the file after compiling. If compilation is needed, this functions returns the result of -`byte-compile-file'; otherwise it returns 'no-byte-compile." +`byte-compile-file'; otherwise it returns `no-byte-compile'." (interactive (let ((file buffer-file-name) (file-name nil) diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el index 06601252a4c..c0a42038e94 100644 --- a/lisp/emacs-lisp/chart.el +++ b/lisp/emacs-lisp/chart.el @@ -479,7 +479,7 @@ See `chart-sort-matchlist' for more details." (defun chart-sort-matchlist (namelst numlst pred) "Sort NAMELST and NUMLST (both sequence objects) based on predicate PRED. -PRED should be the equivalent of '<, except it must expect two +PRED should be the equivalent of `<', except it must expect two cons cells of the form (NAME . NUM). See `sort' for more details." ;; 1 - create 1 list of cons cells (let ((newlist nil) @@ -571,7 +571,7 @@ R1 and R2 are dotted pairs. Colorize it with FACE." (defun chart-bar-quickie (dir title namelst nametitle numlst numtitle &optional max sort-pred) "Wash over the complex EIEIO stuff and create a nice bar chart. -Create it going in direction DIR ['horizontal 'vertical] with TITLE +Create it going in direction DIR [`horizontal' `vertical'] with TITLE using a name sequence NAMELST labeled NAMETITLE with values NUMLST labeled NUMTITLE. Optional arguments: diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 80f0cd73cee..09d2d3f9a5e 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -298,9 +298,10 @@ FORM is of the form (ARGS . BODY)." (if (stringp (car header)) (pop header)) ;; Be careful with make-symbol and (back)quote, ;; see bug#12884. - (let ((print-gensym nil) (print-quoted t)) - (format "%S" (cons 'fn (cl--make-usage-args - orig-args))))) + (help--docstring-quote + (let ((print-gensym nil) (print-quoted t)) + (format "%S" (cons 'fn (cl--make-usage-args + orig-args)))))) header))) ;; FIXME: we'd want to choose an arg name for the &rest param ;; and pass that as `expr' to cl--do-arglist, but that ends up @@ -2829,8 +2830,8 @@ is a shorthand for (NAME NAME)." (defun cl-struct-sequence-type (struct-type) "Return the sequence used to build STRUCT-TYPE. -STRUCT-TYPE is a symbol naming a struct type. Return 'vector or -'list, or nil if STRUCT-TYPE is not a struct type. " +STRUCT-TYPE is a symbol naming a struct type. Return `vector' or +`list', or nil if STRUCT-TYPE is not a struct type. " (declare (side-effect-free t) (pure t)) (cl--struct-class-type (cl--struct-get-class struct-type))) diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 56f95111ab8..321895de4e1 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -148,7 +148,7 @@ BODY contains code to execute each time the mode is enabled or disabled. For example, you could write (define-minor-mode foo-mode \"If enabled, foo on you!\" - :lighter \" Foo\" :require 'foo :global t :group 'hassle :version \"27.5\" + :lighter \" Foo\" :require \\='foo :global t :group \\='hassle :version \"27.5\" ...BODY CODE...)" (declare (doc-string 2) (debug (&define name string-or-null-p @@ -502,7 +502,7 @@ Valid keywords and arguments are: :inherit Parent keymap. :group Ignored. :suppress Non-nil to call `suppress-keymap' on keymap, - 'nodigits to suppress digits as prefix arguments." + `nodigits' to suppress digits as prefix arguments." (let (inherit dense suppress) (while args (let ((key (pop args)) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 21c1f1be394..d572d544e11 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -187,7 +187,7 @@ using :expected-result. See `ert-test-result-type-p' for a description of valid values for RESULT-TYPE. \(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] \ -[:tags '(TAG...)] BODY...)" +[:tags \\='(TAG...)] BODY...)" (declare (debug (&define :name test name sexp [&optional stringp] [&rest keywordp sexp] def-body)) diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index 94fe6c3d441..9e00190e000 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -534,7 +534,7 @@ This macro only makes sense when used in a place." "Return a reference to PLACE. This is like the `&' operator of the C language. Note: this only works reliably with lexical binding mode, except for very -simple PLACEs such as (function-symbol 'foo) which will also work in dynamic +simple PLACEs such as (function-symbol \\='foo) which will also work in dynamic binding mode." (let ((code (gv-letplace (getter setter) place diff --git a/lisp/emacs-lisp/let-alist.el b/lisp/emacs-lisp/let-alist.el index ca7a904a087..393f1d51050 100644 --- a/lisp/emacs-lisp/let-alist.el +++ b/lisp/emacs-lisp/let-alist.el @@ -117,10 +117,10 @@ For instance, the following code essentially expands to - (let ((.title (cdr (assq 'title alist))) - (.body (cdr (assq 'body alist))) - (.site (cdr (assq 'site alist))) - (.site.contents (cdr (assq 'contents (cdr (assq 'site alist)))))) + (let ((.title (cdr (assq \\='title alist))) + (.body (cdr (assq \\='body alist))) + (.site (cdr (assq \\='site alist))) + (.site.contents (cdr (assq \\='contents (cdr (assq \\='site alist)))))) (if (and .title .body) .body .site -- cgit v1.2.1 From 2e6d7d1e3408168545d5afd33ae8dd5a2881a22c Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Wed, 18 Nov 2015 10:28:02 +0000 Subject: * lisp/emacs-lisp/package.el (package--with-response-buffer): Ensure we're at the start of the buffer before searching for the end of headers. --- lisp/emacs-lisp/package.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 2aea9d11d1f..d747bc226a7 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1165,6 +1165,7 @@ BODY (does not apply to errors signaled by ERROR-FORM). (unwind-protect (wrap-errors (when-let ((er (plist-get status :error))) (error "Error retrieving: %s %S" url er)) + (goto-char (point-min)) (unless (search-forward-regexp "^\r?\n\r?" nil 'noerror) (error "Error retrieving: %s %S" url "incomprehensible buffer")) (with-temp-buffer -- cgit v1.2.1 From 74e5d4e21e7206693ce6ce999e884d75230ad33b Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Mon, 23 Nov 2015 14:10:36 +0000 Subject: Don't let cconv_convert insert a nil argument into a `setq' form. Fixes bug#21983. * lisp/emacs-lisp/cconv.el (cconv-convert): Don't silently insert a nil last argument into a `setq' when there're an odd number of args. This enables the byte compiler to issue a message in this case. --- lisp/emacs-lisp/cconv.el | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index efa9a3da011..4a3c273bc84 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -477,17 +477,19 @@ places where they originally did not directly appear." (while forms (let* ((sym (pop forms)) (sym-new (or (cdr (assq sym env)) sym)) - (value (cconv-convert (pop forms) env extend))) + (value-in-list + (and forms + (list (cconv-convert (pop forms) env extend))))) (push (pcase sym-new - ((pred symbolp) `(setq ,sym-new ,value)) - (`(car-safe ,iexp) `(setcar ,iexp ,value)) + ((pred symbolp) `(setq ,sym-new ,@value-in-list)) + (`(car-safe ,iexp) `(setcar ,iexp ,@value-in-list)) ;; This "should never happen", but for variables which are ;; mutated+captured+unused, we may end up trying to `setq' ;; on a closed-over variable, so just drop the setq. (_ ;; (byte-compile-report-error ;; (format "Internal error in cconv of (setq %s ..)" ;; sym-new)) - value)) + (car value-in-list))) prognlist))) (if (cdr prognlist) `(progn . ,(nreverse prognlist)) -- cgit v1.2.1 From c89b5a0f8a3905c023eb196e453383c95a4f6a89 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Mon, 23 Nov 2015 14:25:15 +0000 Subject: Issue a warning from the byte compiler on a malformed `setq' form. Partly fixes bug#20241. * lisp/emacs-lisp/bytecomp.el (byte-compile-setq): Issue a warning when a `setq' form with an odd number of arguments is compiled. --- lisp/emacs-lisp/bytecomp.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 024719168af..fc3bfc5fc51 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3713,7 +3713,11 @@ discarding." (let ((args (cdr form))) (if args (while args - (byte-compile-form (car (cdr args))) + (if (eq (length args) 1) + (byte-compile-warn + "missing value for `%S' at end of setq" + (car args))) + (byte-compile-form (car (cdr args))) (or byte-compile--for-effect (cdr (cdr args)) (byte-compile-out 'byte-dup 0)) (byte-compile-variable-set (car args)) -- cgit v1.2.1 From 5454708346433d08a41f77a12d416614dd113721 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Mon, 23 Nov 2015 14:49:23 +0000 Subject: Expunge occurrences of `setq' with an odd number of arguments. * lisp/apropos.el (apropos-documentation): * lisp/obsolete/complete.el (PC-include-file-all-completions): * lisp/progmodes/compile.el (compilation-goto-locus): * lisp/vc/vc-cvs.el (vc-cvs-parse-root): (twice) Insert missing nil at end of `setq' forms. * lisp/emacs-lisp/bytecomp.el (byte-compile-file-form-autoload): Remove an erroneous trailing variable name from a setq, thus allowing a compilation properly to track functions not defined at runtime. --- lisp/emacs-lisp/bytecomp.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index fc3bfc5fc51..b29e77b14b5 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2287,8 +2287,7 @@ list that represents a doc string reference. ;; byte-compile-warn-about-unresolved-functions. (if (memq funsym byte-compile-noruntime-functions) (setq byte-compile-noruntime-functions - (delq funsym byte-compile-noruntime-functions) - byte-compile-noruntime-functions) + (delq funsym byte-compile-noruntime-functions)) (setq byte-compile-unresolved-functions (delq (assq funsym byte-compile-unresolved-functions) byte-compile-unresolved-functions))))) -- cgit v1.2.1 From 9f1a5113e103c789e173171ee0cda8d29de2f3d7 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 23 Nov 2015 11:26:16 -0500 Subject: * lisp/emacs-lisp/smie.el (smie-backward-sexp): Handle BOB better. --- lisp/emacs-lisp/smie.el | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index 738bdddcddf..197861fbae2 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -809,7 +809,12 @@ Possible return values: nil: we skipped over an identifier, matched parentheses, ..." (smie-next-sexp (indirect-function smie-backward-token-function) - (indirect-function #'backward-sexp) + (lambda (n) + (if (bobp) + ;; Arguably backward-sexp hould signal this error for us. + (signal 'scan-error + (list "Beginning of buffer" (point) (point))) + (backward-sexp n))) (indirect-function #'smie-op-left) (indirect-function #'smie-op-right) halfsexp)) -- cgit v1.2.1 From b6bc4ab20cb62edc4ab6dac00918f81781ba1925 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Mon, 23 Nov 2015 17:13:55 +0000 Subject: Signal an error when `setf' gets an odd number of arguments. * lisp/emacs-lisp/gv.el (setf): Amend. --- lisp/emacs-lisp/gv.el | 2 ++ 1 file changed, 2 insertions(+) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index 9e00190e000..1fea38c49c1 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -260,6 +260,8 @@ The return value is the last VAL in the list. \(fn PLACE VAL PLACE VAL ...)" (declare (debug (&rest [gv-place form]))) + (if (/= (logand (length args) 1) 0) + (signal 'wrong-number-of-arguments (list 'setf (length args)))) (if (and args (null (cddr args))) (let ((place (pop args)) (val (car args))) -- cgit v1.2.1 From e395cafbc1b3833d5738f7556e1ac33e8363aece Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Johan=20Bockg=C3=A5rd?= Date: Mon, 23 Nov 2015 20:11:10 +0100 Subject: * lisp/emacs-lisp/nadvice.el (add-function): Fix debug spec. (remove-function): Ditto. (Bug#20376) --- lisp/emacs-lisp/nadvice.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 1882eb194f6..a1bc38ce2bf 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -289,7 +289,10 @@ is also interactive. There are 3 cases: argument (the interactive spec of OLDFUN, which it can pass to `advice-eval-interactive-spec') and return the list of arguments to use. - Else, use the interactive spec of FUNCTION and ignore the one of OLDFUN." - (declare (debug t)) ;;(indent 2) + (declare + ;;(indent 2) + (debug (form [&or symbolp ("local" form) ("var" sexp) gv-place] + form &optional form))) `(advice--add-function ,where (gv-ref ,(advice--normalize-place place)) ,function ,props)) @@ -311,7 +314,8 @@ is also interactive. There are 3 cases: If FUNCTION was not added to PLACE, do nothing. Instead of FUNCTION being the actual function, it can also be the `name' of the piece of advice." - (declare (debug t)) + (declare (debug ([&or symbolp ("local" form) ("var" sexp) gv-place] + form))) (gv-letplace (getter setter) (advice--normalize-place place) (macroexp-let2 nil new `(advice--remove-function ,getter ,function) `(unless (eq ,new ,getter) ,(funcall setter new))))) -- cgit v1.2.1 From a67cc630db28cf734d0e47f231add30c782bd8cf Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Tue, 24 Nov 2015 12:40:39 +0000 Subject: Byte compile: Output an error, not a warning, for odd number of args to setq * lisp/emacs-lisp/bytecomp.el (byte-compile-setq): Amend. --- lisp/emacs-lisp/bytecomp.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index b29e77b14b5..5e6df282b3f 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3713,9 +3713,9 @@ discarding." (if args (while args (if (eq (length args) 1) - (byte-compile-warn - "missing value for `%S' at end of setq" - (car args))) + (byte-compile-log-warning + (format "missing value for `%S' at end of setq" (car args)) + nil :error)) (byte-compile-form (car (cdr args))) (or byte-compile--for-effect (cdr (cdr args)) (byte-compile-out 'byte-dup 0)) -- cgit v1.2.1 From acb96f2718ccb0d36af514ce63b5decf0f24a697 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Tue, 24 Nov 2015 17:37:49 +0000 Subject: Squashed commit of the following: commit e1ecf76585bef2eb87995f7a7f92cc12003a6f70 Author: Alan Mackenzie Date: Tue Nov 24 16:50:09 2015 +0000 Byte compile: minor amendments. * lisp/emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment): add a comment to explain the binding of variables around a subsidiary compilation. (byte-compile-new-defuns): Amend the doc string. commit c537bfed1dda1593d218956ff00c6105a3ff0316 Author: Alan Mackenzie Date: Sat Nov 21 18:43:57 2015 +0000 Byte compiler: fix spurious warnings "might not be defined at runtime". Also initialize byte-compile-noruntime-functions between runs. * lisp/emacs-lisp/bytecomp.el (byte-compile-new-defuns): New variable. (byte-compile-initial-macro-environment): For eval-when-compile: bind byte-compile-unresolved-functions and byte-compile-new-defuns around byte-compile-top-level, to prevent spurious entries being made. (byte-compile-warn-about-unresolved-functions): Check whether function is in byte-compile-new-defuns before emitting a warning about it. (byte-compile-from-buffer): Initialize new variable and byte-compile-noruntime-functions to nil. (byte-compile-file-form-require): record all new functions defined by a `require' in byte-compile-new-defuns. (byte-compile-file-form-defmumble): record the new alias in byte-compile-new-defuns. --- lisp/emacs-lisp/bytecomp.el | 46 ++++++++++++++++++++++++++++++++++++++------- 1 file changed, 39 insertions(+), 7 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 5e6df282b3f..58cce67598c 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -456,10 +456,20 @@ Return the compile-time value of FORM." (byte-compile-recurse-toplevel (macroexp-progn body) (lambda (form) - (setf result - (byte-compile-eval - (byte-compile-top-level - (byte-compile-preprocess form)))))) + ;; Insulate the following variables + ;; against changes made in the + ;; subsidiary compilation. This + ;; prevents spurious warning + ;; messages: "not defined at runtime" + ;; etc. + (let ((byte-compile-unresolved-functions + byte-compile-unresolved-functions) + (byte-compile-new-defuns + byte-compile-new-defuns)) + (setf result + (byte-compile-eval + (byte-compile-top-level + (byte-compile-preprocess form))))))) (list 'quote result)))) (eval-and-compile . ,(lambda (&rest body) (byte-compile-recurse-toplevel @@ -503,6 +513,11 @@ defined with incorrect args.") Used for warnings about calling a function that is defined during compilation but won't necessarily be defined when the compiled file is loaded.") +(defvar byte-compile-new-defuns nil + "List of (runtime) functions defined in this compilation run. +This variable is used to qualify `byte-compile-noruntime-functions' when +outputting warnings about functions not being defined at runtime.") + ;; Variables for lexical binding (defvar byte-compile--lexical-environment nil "The current lexical environment.") @@ -1503,8 +1518,9 @@ extra args." ;; Separate the functions that will not be available at runtime ;; from the truly unresolved ones. (dolist (f byte-compile-unresolved-functions) - (setq f (car f)) - (if (fboundp f) (push f noruntime) (push f unresolved))) + (setq f (car f)) + (when (not (memq f byte-compile-new-defuns)) + (if (fboundp f) (push f noruntime) (push f unresolved)))) ;; Complain about the no-run-time functions (byte-compile-print-syms "the function `%s' might not be defined at runtime." @@ -1961,6 +1977,8 @@ With argument ARG, insert value in current buffer after the form." ;; compiled. A: Yes! b-c-u-f might contain dross from a ;; previous byte-compile. (setq byte-compile-unresolved-functions nil) + (setq byte-compile-noruntime-functions nil) + (setq byte-compile-new-defuns nil) ;; Compile the forms from the input buffer. (while (progn @@ -2345,8 +2363,21 @@ list that represents a doc string reference. (defun byte-compile-file-form-require (form) (let ((args (mapcar 'eval (cdr form))) (hist-orig load-history) - hist-new) + hist-new prov-cons) (apply 'require args) + + ;; Record the functions defined by the require in `byte-compille-new-defuns'. + (setq hist-new load-history) + (setq prov-cons (cons 'provide (car args))) + (while (and hist-new + (not (member prov-cons (car hist-new)))) + (setq hist-new (cdr hist-new))) + (when hist-new + (dolist (x (car hist-new)) + (when (and (consp x) + (memq (car x) '(defun t))) + (push (cdr x) byte-compile-new-defuns)))) + (when (byte-compile-warning-enabled-p 'cl-functions) ;; Detect (require 'cl) in a way that works even if cl is already loaded. (if (member (car args) '("cl" cl)) @@ -2402,6 +2433,7 @@ not to take responsibility for the actual compilation of the code." (byte-compile-current-form name)) ; For warnings. (byte-compile-set-symbol-position name) + (push name byte-compile-new-defuns) ;; When a function or macro is defined, add it to the call tree so that ;; we can tell when functions are not used. (if byte-compile-generate-call-tree -- cgit v1.2.1 From 5d93a89e805baa2f29941fd801e48235f6c1a6b6 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Thu, 26 Nov 2015 10:36:32 +0000 Subject: Byte compiler: on setq with an odd number of arguments, generate a `signal' * lisp/emacs-lisp/cconv.el (cconv-convert): Don't transform `setq' form when it has an odd number of arguments, to allow bytecomp to handle the error. * lisp/emacs-lisp/bytecomp.el (byte-compile-setq): In a `setq' form with an odd number of arguments, generate a `signal' instead of the normal code. --- lisp/emacs-lisp/bytecomp.el | 32 ++++++++++++++++++-------------- lisp/emacs-lisp/cconv.el | 43 ++++++++++++++++++++++--------------------- 2 files changed, 40 insertions(+), 35 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 58cce67598c..ffe73defcbb 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3741,20 +3741,24 @@ discarding." (byte-defop-compiler-1 quote) (defun byte-compile-setq (form) - (let ((args (cdr form))) - (if args - (while args - (if (eq (length args) 1) - (byte-compile-log-warning - (format "missing value for `%S' at end of setq" (car args)) - nil :error)) - (byte-compile-form (car (cdr args))) - (or byte-compile--for-effect (cdr (cdr args)) - (byte-compile-out 'byte-dup 0)) - (byte-compile-variable-set (car args)) - (setq args (cdr (cdr args)))) - ;; (setq), with no arguments. - (byte-compile-form nil byte-compile--for-effect)) + (let* ((args (cdr form)) + (len (length args))) + (if (= (logand len 1) 1) + (progn + (byte-compile-log-warning + (format "missing value for `%S' at end of setq" (car (last args))) + nil :error) + (byte-compile-form + `(signal 'wrong-number-of-arguments '(setq ,len)))) + (if args + (while args + (byte-compile-form (car (cdr args))) + (or byte-compile--for-effect (cdr (cdr args)) + (byte-compile-out 'byte-dup 0)) + (byte-compile-variable-set (car args)) + (setq args (cdr (cdr args)))) + ;; (setq), with no arguments. + (byte-compile-form nil byte-compile--for-effect))) (setq byte-compile--for-effect nil))) (defun byte-compile-setq-default (form) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 4a3c273bc84..355913acbed 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -473,27 +473,28 @@ places where they originally did not directly appear." :fun-body ,(cconv--convert-function () body env form))) (`(setq . ,forms) ; setq special form - (let ((prognlist ())) - (while forms - (let* ((sym (pop forms)) - (sym-new (or (cdr (assq sym env)) sym)) - (value-in-list - (and forms - (list (cconv-convert (pop forms) env extend))))) - (push (pcase sym-new - ((pred symbolp) `(setq ,sym-new ,@value-in-list)) - (`(car-safe ,iexp) `(setcar ,iexp ,@value-in-list)) - ;; This "should never happen", but for variables which are - ;; mutated+captured+unused, we may end up trying to `setq' - ;; on a closed-over variable, so just drop the setq. - (_ ;; (byte-compile-report-error - ;; (format "Internal error in cconv of (setq %s ..)" - ;; sym-new)) - (car value-in-list))) - prognlist))) - (if (cdr prognlist) - `(progn . ,(nreverse prognlist)) - (car prognlist)))) + (if (= (logand (length forms) 1) 1) + ;; With an odd number of args, let bytecomp.el handle the error. + form + (let ((prognlist ())) + (while forms + (let* ((sym (pop forms)) + (sym-new (or (cdr (assq sym env)) sym)) + (value (cconv-convert (pop forms) env extend))) + (push (pcase sym-new + ((pred symbolp) `(setq ,sym-new ,value)) + (`(car-safe ,iexp) `(setcar ,iexp ,value)) + ;; This "should never happen", but for variables which are + ;; mutated+captured+unused, we may end up trying to `setq' + ;; on a closed-over variable, so just drop the setq. + (_ ;; (byte-compile-report-error + ;; (format "Internal error in cconv of (setq %s ..)" + ;; sym-new)) + value)) + prognlist))) + (if (cdr prognlist) + `(progn . ,(nreverse prognlist)) + (car prognlist))))) (`(,(and (or `funcall `apply) callsym) ,fun . ,args) ;; These are not special forms but we treat them separately for the needs -- cgit v1.2.1 From af40b7689a768f8a4b931d9c655c9c8bdba9393e Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Thu, 26 Nov 2015 20:57:34 +0000 Subject: Byte Compiler: generate code to adjust stack count after call to `signal'. Corrects change from earlier today. * lisp/emacs-lisp/bytecomp.el (byte-compile-setq): supply the current value of `byte-compile--for-effect' as argument to `byte-compile-form'. --- lisp/emacs-lisp/bytecomp.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index ffe73defcbb..8fd2594fec8 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3749,7 +3749,8 @@ discarding." (format "missing value for `%S' at end of setq" (car (last args))) nil :error) (byte-compile-form - `(signal 'wrong-number-of-arguments '(setq ,len)))) + `(signal 'wrong-number-of-arguments '(setq ,len)) + byte-compile--for-effect)) (if args (while args (byte-compile-form (car (cdr args))) -- cgit v1.2.1 From 165d6e3fddad96a9a856ed601ea5ec43d5804e52 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 27 Nov 2015 12:32:44 +0200 Subject: Add ':version' tag to 'checkdoc-package-keywords-flag' * lisp/emacs-lisp/checkdoc.el (checkdoc-package-keywords-flag): Add a ':version' tag. --- lisp/emacs-lisp/checkdoc.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index bf1a21acaf1..88d5f323f86 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -270,6 +270,7 @@ made in the style guide relating to order." (defcustom checkdoc-package-keywords-flag nil "Non-nil means warn if this file's package keywords are not recognized. Currently, all recognized keywords must be on `finder-known-keywords'." + :version "25.1" :type 'boolean) (define-obsolete-variable-alias 'checkdoc-style-hooks -- cgit v1.2.1 From 5cf012a3a86e700b5f229fc14d9abd1e27fdb5f4 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Sun, 29 Nov 2015 16:17:07 +0000 Subject: Byte compiler: Catch missing argument to `funcall'. Fixes bug#22051. * lisp/emacs-lisp/bytecomp.el (byte-compile-funcall): When there's no argument to `funcall', (i) Output an error message; (ii) Generate code to signal a `wrong-number-of-arguments' error. --- lisp/emacs-lisp/bytecomp.el | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 8fd2594fec8..14173494eeb 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4013,8 +4013,13 @@ that suppresses all warnings during execution of BODY." (setq byte-compile--for-effect nil))) (defun byte-compile-funcall (form) - (mapc 'byte-compile-form (cdr form)) - (byte-compile-out 'byte-call (length (cdr (cdr form))))) + (if (cdr form) + (progn + (mapc 'byte-compile-form (cdr form)) + (byte-compile-out 'byte-call (length (cdr (cdr form))))) + (byte-compile-log-warning "`funcall' called with no arguments" nil :error) + (byte-compile-form '(signal 'wrong-number-of-arguments '(funcall 0)) + byte-compile--for-effect))) ;; let binding -- cgit v1.2.1 From 36649e0150fa7be91040b9d74009ccc085f8a363 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 29 Nov 2015 21:50:59 -0800 Subject: Spelling and grammar fixes --- lisp/emacs-lisp/bytecomp.el | 2 +- lisp/emacs-lisp/smie.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 14173494eeb..b5b618e87d7 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2366,7 +2366,7 @@ list that represents a doc string reference. hist-new prov-cons) (apply 'require args) - ;; Record the functions defined by the require in `byte-compille-new-defuns'. + ;; Record the functions defined by the require in `byte-compile-new-defuns'. (setq hist-new load-history) (setq prov-cons (cons 'provide (car args))) (while (and hist-new diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index 197861fbae2..25ea4bbb588 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -811,7 +811,7 @@ Possible return values: (indirect-function smie-backward-token-function) (lambda (n) (if (bobp) - ;; Arguably backward-sexp hould signal this error for us. + ;; Arguably backward-sexp should signal this error for us. (signal 'scan-error (list "Beginning of buffer" (point) (point))) (backward-sexp n))) -- cgit v1.2.1 From 628d0063f8dbd238df4103c84112f3a19315f590 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Tue, 1 Dec 2015 15:11:33 +0000 Subject: * lisp/emacs-lisp/package.el: Update header comments --- lisp/emacs-lisp/package.el | 28 +++++----------------------- 1 file changed, 5 insertions(+), 23 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index d747bc226a7..91a6330d190 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -5,7 +5,7 @@ ;; Author: Tom Tromey ;; Daniel Hackney ;; Created: 10 Mar 2007 -;; Version: 1.0.1 +;; Version: 1.1.0 ;; Keywords: tools ;; Package-Requires: ((tabulated-list "1.0")) @@ -24,14 +24,6 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . -;;; Change Log: - -;; 2 Apr 2007 - now using ChangeLog file -;; 15 Mar 2007 - updated documentation -;; 14 Mar 2007 - Changed how obsolete packages are handled -;; 13 Mar 2007 - Wrote package-install-from-buffer -;; 12 Mar 2007 - Wrote package-menu mode - ;;; Commentary: ;; The idea behind package.el is to be able to download packages and @@ -69,6 +61,7 @@ ;; * Download. Fetching the package from ELPA. ;; * Install. Untar the package, or write the .el file, into ;; ~/.emacs.d/elpa/ directory. +;; * Autoload generation. ;; * Byte compile. Currently this phase is done during install, ;; but we may change this. ;; * Activate. Evaluate the autoloads for the package to make it @@ -127,14 +120,9 @@ ;; - "installed" instead of a blank in the status column ;; - tramp needs its files to be compiled in a certain order. ;; how to handle this? fix tramp? -;; - on emacs 21 we don't kill the -autoloads.el buffer. what about 22? ;; - maybe we need separate .elc directories for various emacs versions ;; and also emacs-vs-xemacs. That way conditional compilation can ;; work. But would this break anything? -;; - should store the package's keywords in archive-contents, then -;; let the users filter the package-menu by keyword. See -;; finder-by-keyword. (We could also let people view the -;; Commentary, but it isn't clear how useful this is.) ;; - William Xu suggests being able to open a package file without ;; installing it ;; - Interface with desktop.el so that restarting after an install @@ -145,15 +133,9 @@ ;; private data dir, aka ".../etc". Or, maybe data-directory ;; needs to be a list (though this would be less nice) ;; a few packages want this, eg sokoban -;; - package menu needs: -;; ability to know which packages are built-in & thus not deletable -;; it can sometimes print odd results, like 0.3 available but 0.4 active -;; why is that? -;; - Allow multiple versions on the server...? -;; [ why bother? ] -;; - Don't install a package which will invalidate dependencies overall -;; - Allow something like (or (>= emacs 21.0) (>= xemacs 21.5)) -;; [ currently thinking, why bother.. KISS ] +;; - Allow multiple versions on the server, so that if a user doesn't +;; meet the requirements for the most recent version they can still +;; install an older one. ;; - 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 ...? -- cgit v1.2.1 From 0af2c269b1d68d114e74aa1313b2ad7d1fe21726 Mon Sep 17 00:00:00 2001 From: Stephen Leake Date: Wed, 2 Dec 2015 06:25:12 -0600 Subject: Fix bug#22069 in cl-generic.el * lisp/emacs-lisp/cl-generic.el (cl-no-method): Remove %S; this string is not run thru `format'. --- lisp/emacs-lisp/cl-generic.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 9e6102c7300..78f580cbfd0 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -797,10 +797,10 @@ methods.") ;;; Define some pre-defined generic functions, used internally. -(define-error 'cl-no-method "No method for %S") -(define-error 'cl-no-next-method "No next method for %S" 'cl-no-method) -(define-error 'cl-no-primary-method "No primary method for %S" 'cl-no-method) -(define-error 'cl-no-applicable-method "No applicable method for %S" +(define-error 'cl-no-method "No method") +(define-error 'cl-no-next-method "No next method" 'cl-no-method) +(define-error 'cl-no-primary-method "No primary method" 'cl-no-method) +(define-error 'cl-no-applicable-method "No applicable method" 'cl-no-method) (cl-defgeneric cl-no-next-method (generic method &rest args) -- cgit v1.2.1 From 67c6906a5f2e79ef771a1d7c8abeb29eb633c659 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 3 Dec 2015 14:50:09 +0000 Subject: * lisp/emacs-lisp/package.el: Refactor package activation code (package-activate): Move code that activates dependencies into package-activate-1. (package--load-files-for-activation): New function. (package-activate-1): Add code for (optionally) activating dependencies, and move file-loading code into `package--load-files-for-activation'. --- lisp/emacs-lisp/package.el | 63 +++++++++++++++++++++++++--------------------- 1 file changed, 34 insertions(+), 29 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 91a6330d190..f94e7aaa741 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -646,8 +646,30 @@ PKG-DESC is a `package-desc' object." (defvar Info-directory-list) (declare-function info-initialize "info" ()) -(defun package-activate-1 (pkg-desc &optional reload) +(defun package--load-files-for-activation (pkg-desc reload) + "Load files for activating a package given by PKG-DESC. +Load the autoloads file, and ensure `load-path' is setup. If +RELOAD is non-nil, also load all files in the package that +correspond to previously loaded files." + (let* ((loaded-files-list (when reload + (package--list-loaded-files (package-desc-dir pkg-desc))))) + ;; Add to load path, add autoloads, and activate the package. + (package--activate-autoloads-and-load-path pkg-desc) + ;; Call `load' on all files in `package-desc-dir' already present in + ;; `load-history'. This is done so that macros in these files are updated + ;; to their new definitions. If another package is being installed which + ;; depends on this new definition, not doing this update would cause + ;; compilation errors and break the installation. + (with-demoted-errors "Error in package--load-files-for-activation: %s" + (mapc (lambda (feature) (load feature nil t)) + ;; Skip autoloads file since we already evaluated it above. + (remove (file-truename (package--autoloads-file-name pkg-desc)) + loaded-files-list))))) + +(defun package-activate-1 (pkg-desc &optional reload deps) "Activate package given by PKG-DESC, even if it was already active. +If DEPS is non-nil, also activate its dependencies (unless they +are already activated). If RELOAD is non-nil, also `load' any files inside the package which correspond to previously loaded files (those returned by `package--list-loaded-files')." @@ -656,20 +678,15 @@ correspond to previously loaded files (those returned by (unless pkg-dir (error "Internal error: unable to find directory for `%s'" (package-desc-full-name pkg-desc))) - (let* ((loaded-files-list (when reload - (package--list-loaded-files pkg-dir)))) - ;; Add to load path, add autoloads, and activate the package. - (package--activate-autoloads-and-load-path pkg-desc) - ;; Call `load' on all files in `pkg-dir' already present in - ;; `load-history'. This is done so that macros in these files are updated - ;; to their new definitions. If another package is being installed which - ;; depends on this new definition, not doing this update would cause - ;; compilation errors and break the installation. - (with-demoted-errors "Error in package-activate-1: %s" - (mapc (lambda (feature) (load feature nil t)) - ;; Skip autoloads file since we already evaluated it above. - (remove (file-truename (package--autoloads-file-name pkg-desc)) - loaded-files-list)))) + ;; Activate its dependencies recursively. + ;; FIXME: This doesn't check whether the activated version is the + ;; required version. + (when deps + (dolist (req (package-desc-reqs pkg-desc)) + (unless (package-activate (car req)) + (error "Unable to activate package `%s'.\nRequired package `%s-%s' is unavailable" + name (car req) (package-version-join (cadr req)))))) + (package--load-files-for-activation pkg-desc reload) ;; Add info node. (when (file-exists-p (expand-file-name "dir" pkg-dir)) ;; FIXME: not the friendliest, but simple. @@ -721,7 +738,7 @@ DIR, sorted by most recently loaded last." ;; one was already activated. It also loads a features of this ;; package which were already loaded. (defun package-activate (package &optional force) - "Activate package PACKAGE. + "Activate the package named PACKAGE. If FORCE is true, (re-)activate it if it's already activated. Newer versions are always activated, regardless of FORCE." (let ((pkg-descs (cdr (assq package package-alist)))) @@ -741,19 +758,7 @@ Newer versions are always activated, regardless of FORCE." ((and (memq package package-activated-list) (not force)) t) ;; Otherwise, proceed with activation. - (t - (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)) - (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 pkg-vec force))))))) + (t (package-activate-1 (car pkg-descs) nil 'deps))))) ;;; Installation -- Local operations -- cgit v1.2.1 From 50dce3c4225384cc3705bee4f8e55939f0885f73 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 3 Dec 2015 15:24:51 +0000 Subject: * lisp/emacs-lisp/package.el (package-unpack): Load before compiling Reload any previously loaded package files before compiling the package (also reload the same files after compiling). This ensures that we have the most recent definitions during compilation, and avoids generating bad elc files when a macro changes and it is used in a different file from the one it's defined in. --- lisp/emacs-lisp/package.el | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index f94e7aaa741..6b5a2024958 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -830,12 +830,17 @@ untar into a directory named DIR; otherwise, signal an error." ;; Update package-alist. (let ((new-desc (package-load-descriptor pkg-dir))) ;; FIXME: Check that `new-desc' matches `desc'! + ;; Activation has to be done before compilation, so that if we're + ;; upgrading and macros have changed we load the new definitions + ;; before compiling. + (package-activate-1 new-desc :reload :deps) ;; 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) + (package--compile new-desc) + ;; After compilation, load again any files loaded by + ;; `activate-1', so that we use the byte-compiled definitions. + (package--load-files-for-activation new-desc :reload)) pkg-dir)) (defun package-generate-description-file (pkg-desc pkg-file) -- cgit v1.2.1 From 1e1aabbc0931b96d6749839c0d25a23377e3a45b Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 3 Dec 2015 15:27:21 +0000 Subject: Fix some file headers for the purpose of `package--builtins' * lisp/emacs-lisp/cl-preloaded.el * lisp/emacs-lisp/eieio-compat.el * lisp/net/sasl-scram-rfc.el: Add a "Package:" header * lisp/ielm.el: Fix summary line. --- lisp/emacs-lisp/cl-preloaded.el | 1 + lisp/emacs-lisp/eieio-compat.el | 1 + 2 files changed, 2 insertions(+) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 03480b2756b..4fc271b34ce 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2015 Free Software Foundation, Inc ;; Author: Stefan Monnier +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el index 06e65b9df80..641d6572592 100644 --- a/lisp/emacs-lisp/eieio-compat.el +++ b/lisp/emacs-lisp/eieio-compat.el @@ -4,6 +4,7 @@ ;; Author: Eric M. Ludlam ;; Keywords: OO, lisp +;; Package: eieio ;; This file is part of GNU Emacs. -- cgit v1.2.1 From 7d611e25ffdfb31e321d4612b282542690f26534 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 3 Dec 2015 15:22:14 -0500 Subject: * lisp/emacs-lisp/smie.el (smie-next-sexp): Fix BOB "token" --- lisp/emacs-lisp/smie.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index 25ea4bbb588..c9c002bc8fa 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -717,9 +717,10 @@ Possible return values: (goto-char pos) (throw 'return (list t epos - (buffer-substring-no-properties - epos - (+ epos (if (< (point) epos) -1 1)))))))) + (unless (= (point) epos) + (buffer-substring-no-properties + epos + (+ epos (if (< (point) epos) -1 1))))))))) (if (eq pos (point)) ;; We did not move, so let's abort the loop. (throw 'return (list t (point)))))) -- cgit v1.2.1 From 9bfcd87c04c25f9c76c8617853d3d03531259232 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Fri, 4 Dec 2015 07:20:41 -0500 Subject: ; Auto-commit of loaddefs files. --- lisp/emacs-lisp/eieio-core.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index dcaaab69cf5..f524c17e759 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -1101,7 +1101,7 @@ method invocation orders of the involved classes." (list eieio--generic-subclass-generalizer)) -;;;### (autoloads nil "eieio-compat" "eieio-compat.el" "11dd361fd4c1c625de90a39977936236") +;;;### (autoloads nil "eieio-compat" "eieio-compat.el" "52d481d50642de76b077ba0bafdd2cd4") ;;; Generated autoloads from eieio-compat.el (autoload 'eieio--defalias "eieio-compat" "\ -- cgit v1.2.1 From 3a9df7589ae189fc34a5fab98e82d85d2d40433f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 4 Dec 2015 08:28:39 -0500 Subject: * lisp/emacs-lisp/cl-macs.el (character): Can't be negative Fixes (bug#21701) --- lisp/emacs-lisp/cl-macs.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 09d2d3f9a5e..c8aad3aafc8 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2885,7 +2885,7 @@ Of course, we really can't know that for sure, so it's just a heuristic." (put 'real 'cl-deftype-satisfies #'numberp) (put 'fixnum 'cl-deftype-satisfies #'integerp) (put 'base-char 'cl-deftype-satisfies #'characterp) -(put 'character 'cl-deftype-satisfies #'integerp) +(put 'character 'cl-deftype-satisfies #'natnump) ;;;###autoload -- cgit v1.2.1 From c2917b02bfe1a33a283540d9609ffdb215b11999 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 4 Dec 2015 12:59:21 -0500 Subject: * lisp/emacs-lisp/ert.el: Prefer pcase over cl-typecase * lisp/emacs-lisp/ert.el (ert--should-error-handle-error) (ert--explain-format-atom, ert--explain-equal-rec) (ert--print-backtrace, ert-test-result-type-p, ert-select-tests) (ert--insert-human-readable-selector): Prefer pcase over cl-typecase. --- lisp/emacs-lisp/ert.el | 337 ++++++++++++++++++++++++------------------------- 1 file changed, 167 insertions(+), 170 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index d572d544e11..a75b23bbc15 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -374,9 +374,9 @@ Returns nil." Determines whether CONDITION matches TYPE and EXCLUDE-SUBTYPES, and aborts the current test as failed if it doesn't." (let ((signaled-conditions (get (car condition) 'error-conditions)) - (handled-conditions (cl-etypecase type - (list type) - (symbol (list type))))) + (handled-conditions (pcase-exhaustive type + ((pred listp) type) + ((pred symbolp) (list type))))) (cl-assert signaled-conditions) (unless (cl-intersection signaled-conditions handled-conditions) (ert-fail (append @@ -466,18 +466,18 @@ Errors during evaluation are caught and handled like nil." (defun ert--explain-format-atom (x) "Format the atom X for `ert--explain-equal'." - (cl-typecase x - (character (list x (format "#x%x" x) (format "?%c" x))) - (fixnum (list x (format "#x%x" x))) - (t x))) + (pcase x + ((pred characterp) (list x (format "#x%x" x) (format "?%c" x))) + ((pred integerp) (list x (format "#x%x" x))) + (_ x))) (defun ert--explain-equal-rec (a b) "Return a programmer-readable explanation of why A and B are not `equal'. Returns nil if they are." (if (not (equal (type-of a) (type-of b))) `(different-types ,a ,b) - (cl-etypecase a - (cons + (pcase-exhaustive a + ((pred consp) (let ((a-proper-p (ert--proper-list-p a)) (b-proper-p (ert--proper-list-p b))) (if (not (eql (not a-proper-p) (not b-proper-p))) @@ -502,24 +502,26 @@ Returns nil if they are." `(cdr ,cdr-x) (cl-assert (equal a b) t) nil)))))))) - (array (if (not (equal (length a) (length b))) - `(arrays-of-different-length ,(length a) ,(length b) - ,a ,b - ,@(unless (char-table-p a) - `(first-mismatch-at - ,(cl-mismatch a b :test 'equal)))) - (cl-loop for i from 0 - for ai across a - for bi across b - for xi = (ert--explain-equal-rec ai bi) - do (when xi (cl-return `(array-elt ,i ,xi))) - finally (cl-assert (equal a b) t)))) - (atom (if (not (equal a b)) - (if (and (symbolp a) (symbolp b) (string= a b)) - `(different-symbols-with-the-same-name ,a ,b) - `(different-atoms ,(ert--explain-format-atom a) - ,(ert--explain-format-atom b))) - nil))))) + ((pred arrayp) + (if (not (equal (length a) (length b))) + `(arrays-of-different-length ,(length a) ,(length b) + ,a ,b + ,@(unless (char-table-p a) + `(first-mismatch-at + ,(cl-mismatch a b :test 'equal)))) + (cl-loop for i from 0 + for ai across a + for bi across b + for xi = (ert--explain-equal-rec ai bi) + do (when xi (cl-return `(array-elt ,i ,xi))) + finally (cl-assert (equal a b) t)))) + ((pred atomp) + (if (not (equal a b)) + (if (and (symbolp a) (symbolp b) (string= a b)) + `(different-symbols-with-the-same-name ,a ,b) + `(different-atoms ,(ert--explain-format-atom a) + ,(ert--explain-format-atom b))) + nil))))) (defun ert--explain-equal (a b) "Explainer function for `equal'." @@ -694,23 +696,20 @@ and is displayed in front of the value of MESSAGE-FORM." (print-level 8) (print-length 50)) (dolist (frame backtrace) - (cl-ecase (car frame) - ((nil) + (pcase-exhaustive frame + (`(nil ,special-operator . ,arg-forms) ;; Special operator. - (cl-destructuring-bind (special-operator &rest arg-forms) - (cdr frame) - (insert - (format " %S\n" (cons special-operator arg-forms))))) - ((t) + (insert + (format " %S\n" (cons special-operator arg-forms)))) + (`(t ,fn . ,args) ;; Function call. - (cl-destructuring-bind (fn &rest args) (cdr frame) - (insert (format " %S(" fn)) - (cl-loop for firstp = t then nil - for arg in args do - (unless firstp - (insert " ")) - (insert (format "%S" arg))) - (insert ")\n"))))))) + (insert (format " %S(" fn)) + (cl-loop for firstp = t then nil + for arg in args do + (unless firstp + (insert " ")) + (insert (format "%S" arg))) + (insert ")\n")))))) ;; A container for the state of the execution of a single test and ;; environment data needed during its execution. @@ -894,33 +893,32 @@ t -- Always matches. RESULT." ;; It would be easy to add `member' and `eql' types etc., but I ;; haven't bothered yet. - (cl-etypecase result-type - ((member nil) nil) - ((member t) t) - ((member :failed) (ert-test-failed-p result)) - ((member :passed) (ert-test-passed-p result)) - ((member :skipped) (ert-test-skipped-p result)) - (cons - (cl-destructuring-bind (operator &rest operands) result-type - (cl-ecase operator - (and - (cl-case (length operands) - (0 t) - (t - (and (ert-test-result-type-p result (car operands)) - (ert-test-result-type-p result `(and ,@(cdr operands))))))) - (or - (cl-case (length operands) - (0 nil) - (t - (or (ert-test-result-type-p result (car operands)) - (ert-test-result-type-p result `(or ,@(cdr operands))))))) - (not - (cl-assert (eql (length operands) 1)) - (not (ert-test-result-type-p result (car operands)))) - (satisfies - (cl-assert (eql (length operands) 1)) - (funcall (car operands) result))))))) + (pcase-exhaustive result-type + ('nil nil) + ('t t) + (:failed (ert-test-failed-p result)) + (:passed (ert-test-passed-p result)) + (:skipped (ert-test-skipped-p result)) + (`(,operator . ,operands) + (cl-ecase operator + (and + (cl-case (length operands) + (0 t) + (t + (and (ert-test-result-type-p result (car operands)) + (ert-test-result-type-p result `(and ,@(cdr operands))))))) + (or + (cl-case (length operands) + (0 nil) + (t + (or (ert-test-result-type-p result (car operands)) + (ert-test-result-type-p result `(or ,@(cdr operands))))))) + (not + (cl-assert (eql (length operands) 1)) + (not (ert-test-result-type-p result (car operands)))) + (satisfies + (cl-assert (eql (length operands) 1)) + (funcall (car operands) result)))))) (defun ert-test-result-expected-p (test result) "Return non-nil if TEST's expected result type matches RESULT." @@ -961,95 +959,96 @@ as (satisfies ...), strings, :new, etc. make use of UNIVERSE. Selectors that do not, such as (member ...), just return the set implied by them without checking whether it is really contained in UNIVERSE." - ;; This code needs to match the etypecase in + ;; This code needs to match the cases in ;; `ert-insert-human-readable-selector'. - (cl-etypecase selector - ((member nil) nil) - ((member t) (cl-etypecase universe - (list universe) - ((member t) (ert-select-tests "" universe)))) - ((member :new) (ert-select-tests - `(satisfies ,(lambda (test) - (null (ert-test-most-recent-result test)))) - universe)) - ((member :failed) (ert-select-tests - `(satisfies ,(lambda (test) - (ert-test-result-type-p - (ert-test-most-recent-result test) - ':failed))) - universe)) - ((member :passed) (ert-select-tests - `(satisfies ,(lambda (test) - (ert-test-result-type-p - (ert-test-most-recent-result test) - ':passed))) - universe)) - ((member :expected) (ert-select-tests - `(satisfies - ,(lambda (test) - (ert-test-result-expected-p - test - (ert-test-most-recent-result test)))) - universe)) - ((member :unexpected) (ert-select-tests `(not :expected) universe)) - (string - (cl-etypecase universe - ((member t) (mapcar #'ert-get-test - (apropos-internal selector #'ert-test-boundp))) - (list (cl-remove-if-not (lambda (test) - (and (ert-test-name test) - (string-match selector - (symbol-name - (ert-test-name test))))) - universe)))) - (ert-test (list selector)) - (symbol + (pcase-exhaustive selector + ('nil nil) + ('t (pcase-exhaustive universe + ((pred listp) universe) + (`t (ert-select-tests "" universe)))) + (:new (ert-select-tests + `(satisfies ,(lambda (test) + (null (ert-test-most-recent-result test)))) + universe)) + (:failed (ert-select-tests + `(satisfies ,(lambda (test) + (ert-test-result-type-p + (ert-test-most-recent-result test) + ':failed))) + universe)) + (:passed (ert-select-tests + `(satisfies ,(lambda (test) + (ert-test-result-type-p + (ert-test-most-recent-result test) + ':passed))) + universe)) + (:expected (ert-select-tests + `(satisfies + ,(lambda (test) + (ert-test-result-expected-p + test + (ert-test-most-recent-result test)))) + universe)) + (:unexpected (ert-select-tests `(not :expected) universe)) + ((pred stringp) + (pcase-exhaustive universe + (`t (mapcar #'ert-get-test + (apropos-internal selector #'ert-test-boundp))) + ((pred listp) + (cl-remove-if-not (lambda (test) + (and (ert-test-name test) + (string-match selector + (symbol-name + (ert-test-name test))))) + universe)))) + ((pred ert-test-p) (list selector)) + ((pred symbolp) (cl-assert (ert-test-boundp selector)) (list (ert-get-test selector))) - (cons - (cl-destructuring-bind (operator &rest operands) selector - (cl-ecase operator - (member - (mapcar (lambda (purported-test) - (cl-etypecase purported-test - (symbol (cl-assert (ert-test-boundp purported-test)) - (ert-get-test purported-test)) - (ert-test purported-test))) - operands)) - (eql - (cl-assert (eql (length operands) 1)) - (ert-select-tests `(member ,@operands) universe)) - (and - ;; Do these definitions of AND, NOT and OR satisfy de - ;; Morgan's laws? Should they? - (cl-case (length operands) - (0 (ert-select-tests 't universe)) - (t (ert-select-tests `(and ,@(cdr operands)) - (ert-select-tests (car operands) - universe))))) - (not - (cl-assert (eql (length operands) 1)) - (let ((all-tests (ert-select-tests 't universe))) - (cl-set-difference all-tests - (ert-select-tests (car operands) - all-tests)))) - (or - (cl-case (length operands) - (0 (ert-select-tests 'nil universe)) - (t (cl-union (ert-select-tests (car operands) universe) - (ert-select-tests `(or ,@(cdr operands)) - universe))))) - (tag - (cl-assert (eql (length operands) 1)) - (let ((tag (car operands))) - (ert-select-tests `(satisfies - ,(lambda (test) - (member tag (ert-test-tags test)))) - universe))) - (satisfies - (cl-assert (eql (length operands) 1)) - (cl-remove-if-not (car operands) - (ert-select-tests 't universe)))))))) + (`(,operator . ,operands) + (cl-ecase operator + (member + (mapcar (lambda (purported-test) + (pcase-exhaustive purported-test + ((pred symbolp) + (cl-assert (ert-test-boundp purported-test)) + (ert-get-test purported-test)) + ((pred ert-test-p) purported-test))) + operands)) + (eql + (cl-assert (eql (length operands) 1)) + (ert-select-tests `(member ,@operands) universe)) + (and + ;; Do these definitions of AND, NOT and OR satisfy de + ;; Morgan's laws? Should they? + (cl-case (length operands) + (0 (ert-select-tests 't universe)) + (t (ert-select-tests `(and ,@(cdr operands)) + (ert-select-tests (car operands) + universe))))) + (not + (cl-assert (eql (length operands) 1)) + (let ((all-tests (ert-select-tests 't universe))) + (cl-set-difference all-tests + (ert-select-tests (car operands) + all-tests)))) + (or + (cl-case (length operands) + (0 (ert-select-tests 'nil universe)) + (t (cl-union (ert-select-tests (car operands) universe) + (ert-select-tests `(or ,@(cdr operands)) + universe))))) + (tag + (cl-assert (eql (length operands) 1)) + (let ((tag (car operands))) + (ert-select-tests `(satisfies + ,(lambda (test) + (member tag (ert-test-tags test)))) + universe))) + (satisfies + (cl-assert (eql (length operands) 1)) + (cl-remove-if-not (car operands) + (ert-select-tests 't universe))))))) (defun ert--insert-human-readable-selector (selector) "Insert a human-readable presentation of SELECTOR into the current buffer." @@ -1058,26 +1057,24 @@ contained in UNIVERSE." ;; `most-recent-result' slots of test case objects in (eql ...) or ;; (member ...) selectors. (cl-labels ((rec (selector) - ;; This code needs to match the etypecase in + ;; This code needs to match the cases in ;; `ert-select-tests'. - (cl-etypecase selector - ((or (member nil t - :new :failed :passed - :expected :unexpected) - string - symbol) + (pcase-exhaustive selector + ((or + ;; 'nil 't :new :failed :passed :expected :unexpected + (pred stringp) + (pred symbolp)) selector) - (ert-test + ((pred ert-test-p) (if (ert-test-name selector) (make-symbol (format "<%S>" (ert-test-name selector))) (make-symbol ""))) - (cons - (cl-destructuring-bind (operator &rest operands) selector - (cl-ecase operator - ((member eql and not or) - `(,operator ,@(mapcar #'rec operands))) - ((member tag satisfies) - selector))))))) + (`(,operator . ,operands) + (pcase operator + ((or 'eql 'and 'not 'or) + `(,operator ,@(mapcar #'rec operands))) + ((or 'tag 'satisfies) + selector)))))) (insert (format "%S" (rec selector))))) -- cgit v1.2.1 From aac3c8a38f0650e3c703d430f8d606547e0bd73b Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 5 Dec 2015 16:37:01 +0000 Subject: * lisp/emacs-lisp/package.el: Don't install bad signatures (bug#22089) (package--with-response-buffer): NOERROR and ERROR-FORM only handle connection errors. (bad-signature): New error type. (package--check-signature-content): Use it. (package--check-signature): Properly distinguish connection errors from bad-signature errors. Do the check for `package-check-signature' `allow-unsigned' here instead of forcing the callbacks to do it. Add a new argument, UNWIND. (package--download-one-archive, package-install-from-archive): Update usage of `package--check-signature'. --- lisp/emacs-lisp/package.el | 118 ++++++++++++++++++++++++--------------------- 1 file changed, 62 insertions(+), 56 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 6b5a2024958..6da3c1e4bc6 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1133,48 +1133,49 @@ Point is after the headers when BODY runs. FILE, if provided, is added to URL. URL can be a local file name, which must be absolute. ASYNC, if non-nil, runs the request asynchronously. -ERROR-FORM is run only if an error occurs. If NOERROR is -non-nil, don't propagate errors caused by the connection or by -BODY (does not apply to errors signaled by ERROR-FORM). +ERROR-FORM is run only if a connection error occurs. If NOERROR +is non-nil, don't propagate connection errors (does not apply to +errors signaled by ERROR-FORM or by BODY). \(fn URL &key ASYNC FILE ERROR-FORM NOERROR &rest BODY)" (declare (indent defun) (debug t)) (while (keywordp (car body)) (setq body (cdr (cdr body)))) - (macroexp-let2* nil ((url-1 url)) - `(cl-macrolet ((wrap-errors (&rest bodyforms) - (let ((err (make-symbol "err"))) - `(condition-case ,err - ,(macroexp-progn bodyforms) - ,(list 'error ',error-form - (list 'unless ',noerror - `(signal (car ,err) (cdr ,err)))))))) + (macroexp-let2* nil ((url-1 url) + (noerror-1 noerror)) + `(cl-macrolet ((unless-error (body-2 &rest before-body) + (let ((err (make-symbol "err"))) + `(with-temp-buffer + (when (condition-case ,err + (progn ,@before-body t) + ,(list 'error ',error-form + (list 'unless ',noerror-1 + `(signal (car ,err) (cdr ,err))))) + ,@body-2))))) (if (string-match-p "\\`https?:" ,url-1) (let* ((url (concat ,url-1 ,file)) (callback (lambda (status) (let ((b (current-buffer))) (require 'url-handlers) - (unwind-protect (wrap-errors - (when-let ((er (plist-get status :error))) - (error "Error retrieving: %s %S" url er)) - (goto-char (point-min)) - (unless (search-forward-regexp "^\r?\n\r?" nil 'noerror) - (error "Error retrieving: %s %S" url "incomprehensible buffer")) - (with-temp-buffer - (url-insert-buffer-contents b url) - (kill-buffer b) - (goto-char (point-min)) - ,@body))))))) + (unless-error ,body + (when-let ((er (plist-get status :error))) + (error "Error retrieving: %s %S" url er)) + (goto-char (point-min)) + (unless (search-forward-regexp "^\r?\n\r?" nil 'noerror) + (error "Error retrieving: %s %S" url "incomprehensible buffer")) + (url-insert-buffer-contents b url) + (kill-buffer b) + (goto-char (point-min))))))) (if ,async - (wrap-errors (url-retrieve url callback nil 'silent)) - (with-current-buffer (wrap-errors (url-retrieve-synchronously url 'silent)) - (funcall callback nil)))) - (wrap-errors (with-temp-buffer - (let ((url (expand-file-name ,file ,url-1))) - (unless (file-name-absolute-p url) - (error "Location %s is not a url nor an absolute file name" url)) - (insert-file-contents url)) - ,@body)))))) + (unless-error nil (url-retrieve url callback nil 'silent)) + (unless-error ,body (url-insert-file-contents url)))) + (unless-error ,body + (let ((url (expand-file-name ,file ,url-1))) + (unless (file-name-absolute-p url) + (error "Location %s is not a url nor an absolute file name" url)) + (insert-file-contents url))))))) + +(define-error 'bad-signature "Failed to verify signature") (defun package--check-signature-content (content string &optional sig-file) "Check signature CONTENT against STRING. @@ -1186,7 +1187,7 @@ errors." (condition-case error (epg-verify-string context content string) (error (package--display-verify-error context sig-file) - (signal (car error) (cdr error)))) + (signal 'bad-signature error))) (let (good-signatures had-fatal-error) ;; The .sig file may contain multiple signatures. Success if one ;; of the signatures is good. @@ -1202,10 +1203,10 @@ errors." (setq had-fatal-error t)))) (when (and (null good-signatures) had-fatal-error) (package--display-verify-error context sig-file) - (error "Failed to verify signature %s" sig-file)) + (signal 'bad-signature (list sig-file))) good-signatures))) -(defun package--check-signature (location file &optional string async callback) +(defun package--check-signature (location file &optional string async callback unwind) "Check signature of the current buffer. Download the signature file from LOCATION by appending \".sig\" to FILE. @@ -1214,18 +1215,35 @@ STRING is the string to verify, it defaults to `buffer-string'. If ASYNC is non-nil, the download of the signature file is done asynchronously. -If the signature is verified and CALLBACK was provided, CALLBACK -is `funcall'ed with the list of good signatures as argument (the -list can be empty). If the signatures file is not found, -CALLBACK is called with no arguments." +If the signature does not verify, signal an error. +If the signature is verified and CALLBACK was provided, `funcall' +CALLBACK with the list of good signatures as argument (the list +can be empty). +If no signatures file is found, and `package-check-signature' is +`allow-unsigned', call CALLBACK with a nil argument. +Otherwise, an error is signaled. + +UNWIND, if provided, is a function to be called after everything +else, even if an error is signaled." (let ((sig-file (concat file ".sig")) (string (or string (buffer-string)))) (package--with-response-buffer location :file sig-file :async async :noerror t - :error-form (when callback (funcall callback nil)) - (let ((sig (package--check-signature-content (buffer-substring (point) (point-max)) string sig-file))) - (when callback (funcall callback sig)) - sig)))) + ;; Connection error is assumed to mean "no sig-file". + :error-form (let ((allow-unsigned (eq package-check-signature 'allow-unsigned))) + (when (and callback allow-unsigned) + (funcall callback nil)) + (when unwind (funcall unwind)) + (unless allow-unsigned + (error "Unsigned file `%s' at %s" file location))) + ;; OTOH, an error here means "bad signature", which we never + ;; suppress. (Bug#22089) + (unwind-protect + (let ((sig (package--check-signature-content (buffer-substring (point) (point-max)) + string sig-file))) + (when callback (funcall callback sig)) + sig) + (when unwind (funcall unwind)))))) ;;; Packages on Archives ;; The following variables store information about packages available @@ -1488,19 +1506,12 @@ similar to an entry in `package-alist'. Save the cached copy to location file content async ;; This function will be called after signature checking. (lambda (&optional good-sigs) - (unless (or good-sigs (eq package-check-signature 'allow-unsigned)) - ;; Even if the sig fails, this download is done, so - ;; remove it from the in-progress list. - (package--update-downloads-in-progress archive) - (error "Unsigned archive `%s'" name)) - ;; Either everything worked or we don't mind not signing. - ;; Write out the archives file. (write-region content nil local-file nil 'silent) ;; Write out good signatures into archive-contents.signed file. (when good-sigs (write-region (mapconcat #'epg-signature-to-string good-sigs "\n") - nil (concat local-file ".signed") nil 'silent)) - (package--update-downloads-in-progress archive)))))))) + nil (concat local-file ".signed") nil 'silent))) + (lambda () (package--update-downloads-in-progress archive)))))))) (defun package--download-and-read-archives (&optional async) "Download descriptions of all `package-archives' and read them. @@ -1782,11 +1793,6 @@ if all the in-between dependencies are also in PACKAGE-LIST." location file content nil ;; This function will be called after signature checking. (lambda (&optional good-sigs) - (unless (or good-sigs (eq package-check-signature 'allow-unsigned)) - ;; Even if the sig fails, this download is done, so - ;; remove it from the in-progress list. - (error "Unsigned package: `%s'" - (package-desc-name pkg-desc))) ;; Signature checked, unpack now. (with-temp-buffer (insert content) (let ((save-silently t)) -- cgit v1.2.1 From 9b0ffdbaddec7d9d46dcd7fc525c4fde7c842c46 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 7 Dec 2015 08:35:53 -0800 Subject: Spelling fixes MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * doc/misc/calc.texi (Predefined Units): Use the bland modern scientific style for spelling the units “ampere” and “angstrom” rather than the older style “Ampere” and “Ångstrom”. The latter spelling was wrong anyway (it should have been “Ångström”). * lisp/emacs-lisp/ert.el (ert--explain-equal-rec): Fix misspelling of ‘atom’ in code. --- lisp/emacs-lisp/ert.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index a75b23bbc15..470fd493661 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -515,7 +515,7 @@ Returns nil if they are." for xi = (ert--explain-equal-rec ai bi) do (when xi (cl-return `(array-elt ,i ,xi))) finally (cl-assert (equal a b) t)))) - ((pred atomp) + ((pred atom) (if (not (equal a b)) (if (and (symbolp a) (symbolp b) (string= a b)) `(different-symbols-with-the-same-name ,a ,b) -- cgit v1.2.1 From a1ad5311683dc84bf2cb023ea7d3043084452cc3 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Tue, 8 Dec 2015 12:49:20 +0000 Subject: * lisp/emacs-lisp/package.el (package--with-response-buffer): Search for the blank-line in the right buffer. --- lisp/emacs-lisp/package.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 6da3c1e4bc6..265b1cc5485 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1160,9 +1160,10 @@ errors signaled by ERROR-FORM or by BODY). (unless-error ,body (when-let ((er (plist-get status :error))) (error "Error retrieving: %s %S" url er)) - (goto-char (point-min)) - (unless (search-forward-regexp "^\r?\n\r?" nil 'noerror) - (error "Error retrieving: %s %S" url "incomprehensible buffer")) + (with-current-buffer b + (goto-char (point-min)) + (unless (search-forward-regexp "^\r?\n\r?" nil 'noerror) + (error "Error retrieving: %s %S" url "incomprehensible buffer"))) (url-insert-buffer-contents b url) (kill-buffer b) (goto-char (point-min))))))) -- cgit v1.2.1 From 0284660f272a51d17a6f67389a7fa92abf8dec7a Mon Sep 17 00:00:00 2001 From: Anders Lindgren Date: Fri, 11 Dec 2015 06:46:19 +0100 Subject: ; Restore selector `member' accidentally drooped in ert rewrite. ; `test/automated/ert.el' and `test/automated/ert-x.el' now run ; without errors. * lisp/emacs-lisp/ert.el (ert--insert-human-readable-selector): Add the `member' selector. This was accidentally dropped when code was converted from `cl-typecase' (where `member' has a special meaning) and `cl-ecase' (where it doesn't) to `pcase'. --- lisp/emacs-lisp/ert.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 470fd493661..02ae41b9c6b 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -1071,7 +1071,7 @@ contained in UNIVERSE." (make-symbol ""))) (`(,operator . ,operands) (pcase operator - ((or 'eql 'and 'not 'or) + ((or 'member 'eql 'and 'not 'or) `(,operator ,@(mapcar #'rec operands))) ((or 'tag 'satisfies) selector)))))) -- cgit v1.2.1 From c0bc613b24b3ff40c6ea88854544e6d03070dc70 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 12 Dec 2015 15:17:14 +0200 Subject: Document new features of package.el * doc/emacs/package.texi (Package Menu): Document the 'external' status and the new menu commands. (Package Installation): Document archive priorities. * lisp/emacs-lisp/package.el (package-archive-priorities): Doc fix. (package-menu-hide-low-priority): Doc fix. --- lisp/emacs-lisp/package.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 265b1cc5485..67d78987a4f 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -216,7 +216,7 @@ of it available such that: This variable has three possible values: nil: no packages are hidden; - `archive': only criteria (a) is used; + `archive': only criterion (a) is used; t: both criteria are used. This variable has no effect if `package-menu--hide-packages' is @@ -234,7 +234,7 @@ Each element has the form (ARCHIVE-ID . PRIORITY). When installing packages, the package with the highest version number from the archive with the highest priority is -selected. When higher versions are available from archives with +selected. When higher versions are available from archives with lower priorities, the user has to select those manually. Archives not in this list have the priority 0. -- cgit v1.2.1 From cb5c26128f2cdfd5b14e553b347ae96048a838cb Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 12 Dec 2015 21:39:19 +0000 Subject: * lisp/emacs-lisp/package.el (package--compile): Don't activate `package-unpack' takes care of all activations now (other than `package-initialize). `package--compile' now only compiles. --- lisp/emacs-lisp/package.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 67d78987a4f..3cf94ec0255 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -923,11 +923,12 @@ untar into a directory named DIR; otherwise, signal an error." ;;;; Compilation (defvar warning-minimum-level) (defun package--compile (pkg-desc) - "Byte-compile installed package PKG-DESC." + "Byte-compile installed package PKG-DESC. +This assumes that `pkg-desc' has already been activated with +`package-activate-1'." (let ((warning-minimum-level :error) (save-silently inhibit-message) (load-path load-path)) - (package--activate-autoloads-and-load-path pkg-desc) (byte-recompile-directory (package-desc-dir pkg-desc) 0 t))) ;;;; Inferring package from current buffer -- cgit v1.2.1 From 95a5c23f741f42c6f68e283570cdce10b1946296 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 12 Dec 2015 21:43:34 +0000 Subject: * lisp/emacs-lisp/package.el (package-unpack): Security check Check that we received the package we were offered. --- lisp/emacs-lisp/package.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 3cf94ec0255..f60bff4a477 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -829,7 +829,10 @@ untar into a directory named DIR; otherwise, signal an error." (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'! + (unless (equal (package-desc-full-name new-desc) + (package-desc-full-name pkg-desc)) + (error "The retrieved package (`%s') doesn't match what the archive offered (`%s')" + (package-desc-full-name new-desc) (package-desc-full-name pkg-desc))) ;; Activation has to be done before compilation, so that if we're ;; upgrading and macros have changed we load the new definitions ;; before compiling. -- cgit v1.2.1 From ffb16999ef1ccd9226392c238d639725bbae2520 Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Tue, 22 Dec 2015 16:53:05 -0700 Subject: add some cl-* aliases to lisp-mode imenu * (lisp-imenu-generic-expression): Add cl-define-compiler-macro, cl-defgeneric, and cl-defmethod. --- lisp/emacs-lisp/lisp-mode.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 9ce0dfd49e8..47a29a87ba5 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -107,7 +107,8 @@ "define-globalized-minor-mode" "define-derived-mode" "define-generic-mode" "cl-defun" "cl-defsubst" "cl-defmacro" - "cl-define-compiler-macro" + "cl-define-compiler-macro" "cl-defgeneric" + "cl-defmethod" ;; CL. "define-compiler-macro" "define-modify-macro" "defsetf" "define-setf-expander" -- cgit v1.2.1 From ba66b357f14db867b5ffd3e75e94b08fe8c36d9c Mon Sep 17 00:00:00 2001 From: Leo Liu Date: Sun, 27 Dec 2015 04:44:11 +0800 Subject: Add ert-deftest to lisp-mode.el * lisp-mode.el (lisp-imenu-generic-expression, lisp-el-font-lock-keywords-1): Add ert-deftest. --- lisp/emacs-lisp/lisp-mode.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 47a29a87ba5..3448b72c3f1 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -106,6 +106,7 @@ "define-global-minor-mode" "define-globalized-minor-mode" "define-derived-mode" "define-generic-mode" + "ert-deftest" "cl-defun" "cl-defsubst" "cl-defmacro" "cl-define-compiler-macro" "cl-defgeneric" "cl-defmethod" @@ -271,7 +272,7 @@ This will generate compile-time constants from BINDINGS." "define-derived-mode" "define-minor-mode" "define-generic-mode" "define-global-minor-mode" "define-globalized-minor-mode" "define-skeleton" - "define-widget")) + "define-widget" "ert-deftest")) (el-vdefs '("defconst" "defcustom" "defvaralias" "defvar-local" "defface")) (el-tdefs '("defgroup" "deftheme")) -- cgit v1.2.1