From: Stefan Monnier Date: Wed, 4 Jan 2017 05:40:45 +0000 (-0500) Subject: Avoid add-to-list on local variables X-Git-Tag: emacs-26.0.90~940 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=2ec41c415f39990561cc9da4c9bad0b69bfad489;p=emacs.git Avoid add-to-list on local variables * lisp/gnus/nnir.el: Use lexical-binding and cl-lib. (nnir-retrieve-headers): Use pcase. (nnir-search-thread): Avoid add-to-list on local variables. * lisp/gnus/smime.el: Use lexical-binding and cl-lib. (smime-verify-region): Avoid add-to-list on local variables. * lisp/mail/undigest.el: Use lexical-binding and cl-lib. (rmail-digest-parse-mime, rmail-digest-rfc1153) (rmail-digest-parse-rfc934): Avoid add-to-list on local variable. * lisp/net/ldap.el (ldap-search): Move init into declaration. * lisp/net/newst-backend.el (newsticker--cache-add): Avoid add-to-list on local variables; Simplify code with `assq'. * lisp/net/zeroconf.el: Use lexical-binding and cl-lib. (dbus-debug): Remove declaration, unused. (zeroconf-service-add-hook, zeroconf-service-remove-hook) (zeroconf-service-browser-handler, zeroconf-publish-service): Avoid add-to-list and *-hook on local variables. * lisp/org/org-archive.el (org-all-archive-files): * lisp/org/org-agenda.el (org-agenda-get-restriction-and-command): Avoid add-to-list on local variables. * lisp/org/ox-publish.el (org-publish--run-functions): New function. (org-publish-projects): Use it to avoid run-hooks on a local variable. (org-publish-cache-file-needs-publishing): Avoid add-to-list on local variables. * lisp/progmodes/ada-prj.el: Use setq instead of (set '...). (ada-prj-load-from-file): Avoid add-to-list on local variables. * lisp/progmodes/ada-xref.el (ada-initialize-runtime-library): Simplify. (ada-gnat-parse-gpr, ada-parse-prj-file-1) (ada-xref-find-in-modified-ali): Avoid add-to-list on local variables. * lisp/progmodes/idlw-shell.el (idlwave-shell-update-bp-overlays): Avoid add-to-list on local variables. --- diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 536474cabc6..9640f2c746f 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -1,4 +1,4 @@ -;;; nnir.el --- search mail with various search engines -*- coding: utf-8 -*- +;;; nnir.el --- Search mail with various search engines -*- lexical-binding:t -*- ;; Copyright (C) 1998-2017 Free Software Foundation, Inc. @@ -175,8 +175,7 @@ (require 'gnus-group) (require 'message) (require 'gnus-util) -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;;; Internal Variables: @@ -686,18 +685,18 @@ skips all prompting." parsefunc) ;; (nnir-possibly-change-group nil server) (erase-buffer) - (case (setq gnus-headers-retrieved-by - (or - (and - nnir-retrieve-headers-override-function - (funcall nnir-retrieve-headers-override-function - artlist artgroup)) - (gnus-retrieve-headers artlist artgroup nil))) - (nov + (pcase (setq gnus-headers-retrieved-by + (or + (and + nnir-retrieve-headers-override-function + (funcall nnir-retrieve-headers-override-function + artlist artgroup)) + (gnus-retrieve-headers artlist artgroup nil))) + ('nov (setq parsefunc 'nnheader-parse-nov)) - (headers + ('headers (setq parsefunc 'nnheader-parse-head)) - (t (error "Unknown header type %s while requesting articles \ + (_ (error "Unknown header type %s while requesting articles \ of group %s" gnus-headers-retrieved-by artgroup))) (goto-char (point-min)) (while (not (eobp)) @@ -831,7 +830,7 @@ skips all prompting." (nnir-possibly-change-group group server) (let (mlist) (dolist (action actions) - (destructuring-bind (range action marks) action + (cl-destructuring-bind (range action marks) action (let ((articles-by-group (nnir-categorize (gnus-uncompress-range range) nnir-article-group nnir-article-number))) @@ -839,7 +838,9 @@ skips all prompting." (push (list (car artgroup) (list (gnus-compress-sequence - (sort (cadr artgroup) '<)) action marks)) mlist))))) + (sort (cadr artgroup) '<)) + action marks)) + mlist))))) (dolist (request (nnir-categorize mlist car cadr)) (gnus-request-set-mark (car request) (cadr request))))) @@ -872,7 +873,7 @@ skips all prompting." (when (gnus-member-of-range (cdr art) read) (car art))) articleids)))) (dolist (mark marks) - (destructuring-bind (type . range) mark + (cl-destructuring-bind (type . range) mark (gnus-add-marked-articles group type (delq nil @@ -955,7 +956,7 @@ details on the language and supported extensions." (save-excursion (let ((qstring (cdr (assq 'query query))) (server (cadr (gnus-server-to-method srv))) - (defs (caddr (gnus-server-to-method srv))) + (defs (nth 2 (gnus-server-to-method srv))) (criteria (or (cdr (assq 'criteria query)) (cdr (assoc nnir-imap-default-search-key nnir-imap-search-arguments)))) @@ -1056,13 +1057,13 @@ In future the following will be added to the language: ;; Composite term: or expression ((eq (car-safe expr) 'or) (format "OR %s %s" - (nnir-imap-expr-to-imap criteria (second expr)) - (nnir-imap-expr-to-imap criteria (third expr)))) + (nnir-imap-expr-to-imap criteria (nth 1 expr)) + (nnir-imap-expr-to-imap criteria (nth 2 expr)))) ;; Composite term: just the fax, mam ((eq (car-safe expr) 'not) - (format "NOT (%s)" (nnir-imap-query-to-imap criteria (rest expr)))) + (format "NOT (%s)" (nnir-imap-query-to-imap criteria (cdr expr)))) ;; Composite term: just expand it all. - ((and (not (null expr)) (listp expr)) + ((consp expr) (format "(%s)" (nnir-imap-query-to-imap criteria expr))) ;; Complex value, give up for now. (t (error "Unhandled input: %S" expr)))) @@ -1223,8 +1224,8 @@ Windows NT 4.0." (exitstatus (progn (message "%s args: %s" nnir-swish++-program - (mapconcat 'identity (cddddr cp-list) " ")) ;; ??? - (apply 'call-process cp-list)))) + (mapconcat #'identity (nthcdr 4 cp-list) " ")) ;; ??? + (apply #'call-process cp-list)))) (unless (or (null exitstatus) (zerop exitstatus)) (nnheader-report 'nnir "Couldn't run swish++: %s" exitstatus) @@ -1259,7 +1260,7 @@ Windows NT 4.0." (message "Massaging swish++ output...done") ;; Sort by score - (apply 'vector + (apply #'vector (sort artlist (function (lambda (x y) (> (nnir-artitem-rsv x) @@ -1310,8 +1311,8 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." (exitstatus (progn (message "%s args: %s" nnir-swish-e-program - (mapconcat 'identity (cddddr cp-list) " ")) - (apply 'call-process cp-list)))) + (mapconcat #'identity (nthcdr 4 cp-list) " ")) + (apply #'call-process cp-list)))) (unless (or (null exitstatus) (zerop exitstatus)) (nnheader-report 'nnir "Couldn't run swish-e: %s" exitstatus) @@ -1354,7 +1355,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." (message "Massaging swish-e output...done") ;; Sort by score - (apply 'vector + (apply #'vector (sort artlist (function (lambda (x y) (> (nnir-artitem-rsv x) @@ -1387,8 +1388,8 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." (exitstatus (progn (message "%s args: %s" nnir-hyrex-program - (mapconcat 'identity (cddddr cp-list) " ")) - (apply 'call-process cp-list)))) + (mapconcat #'identity (nthcdr 4 cp-list) " ")) + (apply #'call-process cp-list)))) (unless (or (null exitstatus) (zerop exitstatus)) (nnheader-report 'nnir "Couldn't run hyrex-search: %s" exitstatus) @@ -1421,7 +1422,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." (string-to-number score)) artlist)) (message "Massaging hyrex-search output...done.") - (apply 'vector + (apply #'vector (sort artlist (function (lambda (x y) (if (string-lessp (nnir-artitem-group x) @@ -1467,8 +1468,8 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (exitstatus (progn (message "%s args: %s" nnir-namazu-program - (mapconcat 'identity (cddddr cp-list) " ")) - (apply 'call-process cp-list)))) + (mapconcat #'identity (nthcdr 4 cp-list) " ")) + (apply #'call-process cp-list)))) (unless (or (null exitstatus) (zerop exitstatus)) (nnheader-report 'nnir "Couldn't run namazu: %s" exitstatus) @@ -1495,7 +1496,7 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (nnir-add-result group article score prefix server artlist))) ;; sort artlist by score - (apply 'vector + (apply #'vector (sort artlist (function (lambda (x y) (> (nnir-artitem-rsv x) @@ -1543,8 +1544,8 @@ actually)." (exitstatus (progn (message "%s args: %s" nnir-notmuch-program - (mapconcat 'identity (cddddr cp-list) " ")) ;; ??? - (apply 'call-process cp-list)))) + (mapconcat #'identity (nthcdr 4 cp-list) " ")) ;; ??? + (apply #'call-process cp-list)))) (unless (or (null exitstatus) (zerop exitstatus)) (nnheader-report 'nnir "Couldn't run notmuch: %s" exitstatus) @@ -1639,7 +1640,7 @@ actually)." (art (string-to-number (car (last path))))) (while (string= "." (car path)) (setq path (cdr path))) - (let ((group (mapconcat 'identity + (let ((group (mapconcat #'identity ;; Replace cl-func: ;; (subseq path 0 -1) (let ((end (1- (length path))) @@ -1707,7 +1708,7 @@ actually)." (string-to-number (match-string 2 xref)) xscore) artlist))))) (forward-line 1))) - (apply 'vector (nreverse (delete-dups artlist))))) + (apply #'vector (nreverse (delete-dups artlist))))) ;;; Util Code: @@ -1719,8 +1720,8 @@ actually)." (defun nnir-read-parms (nnir-search-engine) "Reads additional search parameters according to `nnir-engines'." - (let ((parmspec (caddr (assoc nnir-search-engine nnir-engines)))) - (mapcar 'nnir-read-parm parmspec))) + (let ((parmspec (nth 2 (assoc nnir-search-engine nnir-engines)))) + (mapcar #'nnir-read-parm parmspec))) (defun nnir-read-parm (parmspec) "Reads a single search parameter. @@ -1728,7 +1729,7 @@ actually)." (let ((sym (car parmspec)) (prompt (cdr parmspec))) (if (listp prompt) - (let* ((result (apply 'gnus-completing-read prompt)) + (let* ((result (apply #'gnus-completing-read prompt)) (mapping (or (assoc result nnir-imap-search-arguments) (cons nil nnir-imap-search-other)))) (cons sym (format (cdr mapping) result))) @@ -1736,7 +1737,7 @@ actually)." (defun nnir-run-query (specs) "Invoke appropriate search engine function (see `nnir-engines')." - (apply 'vconcat + (apply #'vconcat (mapcar (lambda (x) (let* ((server (car x)) @@ -1796,7 +1797,8 @@ article came from is also searched." (and registry-group (gnus-method-to-server (gnus-find-method-for-group registry-group))))) - (when registry-server (add-to-list 'server (list registry-server))) + (when registry-server + (cl-pushnew (list registry-server) server :test #'equal)) (gnus-group-make-nnir-group nil (list (cons 'nnir-query-spec query) (cons 'nnir-group-spec server))) diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el index 56c651fa7ad..e3c284f033c 100644 --- a/lisp/gnus/smime.el +++ b/lisp/gnus/smime.el @@ -1,4 +1,4 @@ -;;; smime.el --- S/MIME support library +;;; smime.el --- S/MIME support library -*- lexical-binding:t -*- ;; Copyright (C) 2000-2017 Free Software Foundation, Inc. @@ -122,7 +122,7 @@ (require 'password-cache) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defgroup smime nil "S/MIME configuration." @@ -243,13 +243,13 @@ password under `cache-key'." ;; OpenSSL wrappers. (defun smime-call-openssl-region (b e buf &rest args) - (case (apply 'call-process-region b e smime-openssl-program nil buf nil args) + (pcase (apply #'call-process-region b e smime-openssl-program nil buf nil args) (0 t) (1 (message "OpenSSL: An error occurred parsing the command options.") nil) (2 (message "OpenSSL: One of the input files could not be read.") nil) (3 (message "OpenSSL: An error occurred creating the PKCS#7 file or when reading the MIME message.") nil) (4 (message "OpenSSL: An error occurred decrypting or verifying the message.") nil) - (t (error "Unknown OpenSSL exitcode") nil))) + (_ (error "Unknown OpenSSL exitcode")))) (defun smime-make-certfiles (certfiles) (if certfiles @@ -373,7 +373,7 @@ Any details (stdout and stderr) are left in the buffer specified by (unless CAs (error "No CA configured")) (if smime-crl-check - (add-to-list 'CAs smime-crl-check)) + (cl-pushnew smime-crl-check CAs :test #'equal)) (if (apply 'smime-call-openssl-region b e (list smime-details-buffer t) "smime" "-verify" "-out" "/dev/null" CAs) t @@ -400,7 +400,7 @@ Any details (stderr on success, stdout and stderr on error) are left in the buffer specified by `smime-details-buffer'." (smime-new-details-buffer) (let ((buffer (generate-new-buffer " *smime*")) - CAs (passphrase (smime-ask-passphrase (expand-file-name keyfile))) + (passphrase (smime-ask-passphrase (expand-file-name keyfile))) (tmpfile (make-temp-file "smime"))) (if passphrase (setenv "GNUS_SMIME_PASSPHRASE" passphrase)) @@ -507,7 +507,7 @@ A string or a list of strings is returned." (let ((curkey (car keys)) (otherkeys (cdr keys))) (if (string= keyfile (cadr curkey)) - (caddr curkey) + (nth 2 curkey) (smime-get-certfiles keyfile otherkeys))))) (defun smime-buffer-as-string-region (b e) @@ -564,25 +564,29 @@ A string or a list of strings is returned." (concat "mail=" mail) host '("userCertificate") nil)) (retbuf (generate-new-buffer (format "*certificate for %s*" mail))) + ldapstr cert) - (if (and (>= (length ldapresult) 1) - (> (length (cadaar ldapresult)) 0)) + (if (and (consp ldapresult) + ;; FIXME: This seems to expect a format rather different from + ;; the list of alists described in ldap.el. + (setq ldapstr (cadr (caar ldapresult))) + (> (length ldapstr) 0)) (with-current-buffer retbuf ;; Certificates on LDAP servers _should_ be in DER format, ;; but there are some servers out there that distributes the ;; certificates in PEM format (with or without ;; header/footer) so we try to handle them anyway. - (if (or (string= (substring (cadaar ldapresult) 0 27) + (if (or (string= (substring ldapstr 0 27) "-----BEGIN CERTIFICATE-----") - (string= (substring (cadaar ldapresult) 0 3) + (string= (substring ldapstr 0 3) "MII")) (setq cert (replace-regexp-in-string (concat "\\(\n\\|\r\\|-----BEGIN CERTIFICATE-----\\|" "-----END CERTIFICATE-----\\)") "" - (cadaar ldapresult) nil t)) - (setq cert (base64-encode-string (cadaar ldapresult) t))) + ldapstr nil t)) + (setq cert (base64-encode-string ldapstr t))) (insert "-----BEGIN CERTIFICATE-----\n") (let ((i 0) (len (length cert))) (while (> (- len 64) i) diff --git a/lisp/mail/undigest.el b/lisp/mail/undigest.el index c9200745e06..73d7464bc13 100644 --- a/lisp/mail/undigest.el +++ b/lisp/mail/undigest.el @@ -1,4 +1,4 @@ -;;; undigest.el --- digest-cracking support for the RMAIL mail reader +;;; undigest.el --- digest-cracking support for the RMAIL mail reader -*- lexical-binding:t -*- ;; Copyright (C) 1985-1986, 1994, 1996, 2001-2017 Free Software ;; Foundation, Inc. @@ -28,6 +28,7 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) (require 'rmail) (defcustom rmail-forward-separator-regex @@ -59,7 +60,8 @@ each undigestified message as markers.") (re-search-forward (concat "^Content-type: multipart/digest;" - "\\s-* boundary=\"?\\([^\";\n]+\\)[\";\n]") head-end t) + "\\s-* boundary=\"?\\([^\";\n]+\\)[\";\n]") + head-end t) (search-forward (match-string 1) nil t))) ;; Ok, prolog separator found (let ((start (make-marker)) @@ -69,7 +71,8 @@ each undigestified message as markers.") (while (search-forward separator nil t) (move-marker start (match-beginning 0)) (move-marker end (match-end 0)) - (add-to-list 'result (cons (copy-marker start) (copy-marker end t)))) + (cl-pushnew (cons (copy-marker start) (copy-marker end t)) + result :test #'equal)) ;; Return the list of marker pairs (nreverse result)))) @@ -117,8 +120,8 @@ See rmail-digest-methods." (while (search-forward separator nil t) (move-marker start (match-beginning 0)) (move-marker end (match-end 0)) - (add-to-list 'result - (cons (copy-marker start) (copy-marker end t)))) + (cl-pushnew (cons (copy-marker start) (copy-marker end t)) + result :test #'equal)) ;; Undo masking of separators inside digestified messages (goto-char (point-min)) (while (search-forward @@ -139,7 +142,8 @@ See rmail-digest-methods." (while (search-forward separator nil t) (move-marker start (match-beginning 0)) (move-marker end (match-end 0)) - (add-to-list 'result (cons (copy-marker start) (copy-marker end t)))) + (cl-pushnew (cons (copy-marker start) (copy-marker end t)) + result :test #'equal)) ;; Undo masking of separators inside digestified messages (goto-char (point-min)) (while (search-forward "\n- -" nil t) diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index f4910b1dc77..d5303387663 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -470,18 +470,17 @@ Additional search parameters can be specified through (or host (setq host ldap-default-host) (error "No LDAP host specified")) - (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) - result) - (setq result (ldap-search-internal `(host ,host + (let* ((host-plist (cdr (assoc host ldap-host-parameters-alist))) + (result (ldap-search-internal `(host ,host filter ,filter attributes ,attributes attrsonly ,attrsonly withdn ,withdn - ,@host-plist))) + ,@host-plist)))) (if ldap-ignore-attribute-codings result (mapcar (lambda (record) - (mapcar 'ldap-decode-attribute record)) + (mapcar #'ldap-decode-attribute record)) result)))) (defun ldap-password-read (host) diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index 30a9e54b73e..f38c72a26b0 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -2124,15 +2124,12 @@ which the item got." (setq item (list title desc link time age position preformatted-contents preformatted-title extra-elements)) ;;(newsticker--debug-msg "Adding item %s" item) - (catch 'found - (mapc (lambda (this-feed) - (when (eq (car this-feed) feed-name-symbol) - (setcdr this-feed (nconc (cdr this-feed) (list item))) - (throw 'found this-feed))) - data) - ;; the feed is not contained - (add-to-list 'data (list feed-name-symbol item) t)))) - data) + (let ((this-feed (assq feed-name-symbol data))) + (if this-feed + (setcdr this-feed (nconc (cdr this-feed) (list item))) + ;; The feed is not contained. + (setq data (append data (list (list feed-name-symbol item))))))) + data)) (defun newsticker--cache-remove (data feed-symbol age) "Remove all entries from DATA in the feed FEED-SYMBOL with AGE. diff --git a/lisp/net/zeroconf.el b/lisp/net/zeroconf.el index 3db65c624eb..37816bb8881 100644 --- a/lisp/net/zeroconf.el +++ b/lisp/net/zeroconf.el @@ -1,4 +1,4 @@ -;;; zeroconf.el --- Service browser using Avahi. +;;; zeroconf.el --- Service browser using Avahi. -*- lexical-binding:t -*- ;; Copyright (C) 2008-2017 Free Software Foundation, Inc. @@ -99,10 +99,7 @@ ;;; Code: -;; Pacify byte-compiler. D-Bus support in the Emacs core can be -;; disabled with configuration option "--without-dbus". Declare used -;; subroutines and variables of `dbus' therefore. -(defvar dbus-debug) +(eval-when-compile (require 'cl-lib)) (require 'dbus) @@ -296,7 +293,7 @@ The key of an entry is a service type.") (defun zeroconf-service-add-hook (type event function) "Add FUNCTION to the hook of service type TYPE. -EVENT must be either :new or :removed, indicating whether +EVENT must be either `:new' or `:removed', indicating whether FUNCTION shall be called when a new service has been newly detected, or removed. @@ -320,15 +317,13 @@ The attributes of SERVICE can be retrieved via the functions (cond ((equal event :new) - (let ((l-hook (gethash type zeroconf-service-added-hooks-hash nil))) - (add-hook 'l-hook function) - (puthash type l-hook zeroconf-service-added-hooks-hash) - (dolist (service (zeroconf-list-services type)) - (funcall function service)))) + (cl-pushnew function (gethash type zeroconf-service-added-hooks-hash) + :test #'equal) + (dolist (service (zeroconf-list-services type)) + (funcall function service))) ((equal event :removed) - (let ((l-hook (gethash type zeroconf-service-removed-hooks-hash nil))) - (add-hook 'l-hook function) - (puthash type l-hook zeroconf-service-removed-hooks-hash))) + (cl-pushnew function (gethash type zeroconf-service-removed-hooks-hash) + :test #'equal)) (t (error "EVENT must be either `:new' or `:removed'")))) (defun zeroconf-service-remove-hook (type event function) @@ -336,16 +331,13 @@ The attributes of SERVICE can be retrieved via the functions EVENT must be either :new or :removed and has to match the event type used when registering FUNCTION." - (let* ((table (cond - ((equal event :new) - zeroconf-service-added-hooks-hash) - ((equal event :removed) - zeroconf-service-removed-hooks-hash) - (t (error "EVENT must be either `:new' or `:removed'")))) - (l-hook (gethash type table nil))) - (remove-hook 'l-hook function) - (if l-hook - (puthash type l-hook table) + (let* ((table (pcase event + (:new zeroconf-service-added-hooks-hash) + (:removed zeroconf-service-removed-hooks-hash) + (_ (error "EVENT must be either `:new' or `:removed'")))) + (functions (remove function (gethash type table)))) + (if functions + (puthash type functions table) (remhash type table)))) (defun zeroconf-get-host () @@ -580,13 +572,13 @@ DOMAIN is nil, the local domain is used." ((string-equal (dbus-event-member-name last-input-event) "ItemNew") ;; Add new service. (puthash key val zeroconf-services-hash) - (run-hook-with-args 'ahook val)) + (dolist (f ahook) (funcall f val))) ((string-equal (dbus-event-member-name last-input-event) "ItemRemove") ;; Remove the service. (remhash key zeroconf-services-hash) (remhash key zeroconf-resolved-services-hash) - (run-hook-with-args 'rhook val))))) + (dolist (f rhook) (funcall f val)))))) (defun zeroconf-register-service-resolver (name type) "Register a service resolver at the Avahi daemon." @@ -653,7 +645,7 @@ For the description of arguments, see `zeroconf-resolved-services-hash'." ;; The TXT field has the signature "as". Transform to "aay". (dolist (elt txt) - (add-to-list 'result (dbus-string-to-byte-array elt))) + (cl-pushnew (dbus-string-to-byte-array elt) result :test #'equal)) ;; Add the service. (dbus-call-method diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index e119d9ffeb1..c870ddd4e43 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -2928,7 +2928,7 @@ L Timeline for current buffer # List stuck projects (!=configure) type (nth 2 entry) match (nth 3 entry)) (if (> (length key) 1) - (add-to-list 'prefixes (string-to-char key)) + (pushnew (string-to-char key) prefixes :test #'equal) (setq line (format "%-4s%-14s" diff --git a/lisp/org/org-archive.el b/lisp/org/org-archive.el index a7afa19c0f9..39a6581046a 100644 --- a/lisp/org/org-archive.el +++ b/lisp/org/org-archive.el @@ -29,6 +29,7 @@ ;;; Code: (require 'org) +(eval-when-compile (require 'cl)) (declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) (declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction)) @@ -163,11 +164,11 @@ archive file is." (setq file (org-extract-archive-file (org-match-string-no-properties 2))) (and file (> (length file) 0) (file-exists-p file) - (add-to-list 'files file))))) + (pushnew file files :test #'equal))))) (setq files (nreverse files)) (setq file (org-extract-archive-file)) (and file (> (length file) 0) (file-exists-p file) - (add-to-list 'files file)) + (pushnew file files :test #'equal)) files)) (defun org-extract-archive-file (&optional location) diff --git a/lisp/org/ox-publish.el b/lisp/org/ox-publish.el index fdab9ac46e6..4ebc073990e 100644 --- a/lisp/org/ox-publish.el +++ b/lisp/org/ox-publish.el @@ -662,6 +662,13 @@ See `org-publish-projects'." filename pub-dir publishing-function base-dir))) (unless no-cache (org-publish-write-cache-file)))) +(defun org-publish--run-functions (functions) + (cond + ((null functions) nil) + ((functionp functions) (funcall functions)) + ((consp functions) (mapc #'funcall functions)) + (t (error "Neither a function nor a list: %S" functions)))) + (defun org-publish-projects (projects) "Publish all files belonging to the PROJECTS alist. If `:auto-sitemap' is set, publish the sitemap too. If @@ -690,7 +697,7 @@ If `:auto-sitemap' is set, publish the sitemap too. If (theindex (expand-file-name "theindex.org" (plist-get project-plist :base-directory)))) - (when preparation-function (run-hooks 'preparation-function)) + (org-publish--run-functions preparation-function) (if sitemap-p (funcall sitemap-function project sitemap-filename)) ;; Publish all files from PROJECT excepted "theindex.org". Its ;; publishing will be deferred until "theindex.inc" is @@ -704,7 +711,7 @@ If `:auto-sitemap' is set, publish the sitemap too. If (org-publish-index-generate-theindex project (plist-get project-plist :base-directory)) (org-publish-file theindex project t)) - (when completion-function (run-hooks 'completion-function)) + (org-publish--run-functions completion-function) (org-publish-write-cache-file))) (org-publish-expand-projects projects))) @@ -1171,9 +1178,13 @@ the file including them will be republished as well." (goto-char (point-min)) (while (re-search-forward "^#\\+INCLUDE:[ \t]+\"\\([^\t\n\r\"]*\\)\"[ \t]*.*$" nil t) - (let* ((included-file (expand-file-name (match-string 1)))) - (add-to-list 'included-files-ctime - (org-publish-cache-ctime-of-src included-file) t)))) + (let* ((included-file (expand-file-name (match-string 1))) + (ctime (org-publish-cache-ctime-of-src included-file))) + (unless (member ctime included-files-ctime) + ;; FIXME: The original code insisted on appending this ctime + ;; to the end of the list, even tho the order seems irrelevant. + (setq included-files-ctime + (append included-files-ctime (list ctime))))))) (unless visiting (kill-buffer buf))) (if (null pstamp) t (let ((ctime (org-publish-cache-ctime-of-src filename))) diff --git a/lisp/progmodes/ada-prj.el b/lisp/progmodes/ada-prj.el index a49e5168b2e..f1b90875044 100644 --- a/lisp/progmodes/ada-prj.el +++ b/lisp/progmodes/ada-prj.el @@ -24,17 +24,13 @@ ;;; Commentary: -;;; This package provides a set of functions to easily edit the project -;;; files used by the ada-mode. -;;; The only function publicly available here is `ada-customize'. -;;; See the documentation of the Ada mode for more information on the project -;;; files. -;;; Internally, a project file is represented as a property list, with each -;;; field of the project file matching one property of the list. - - -;;; History: -;; +;; This package provides a set of functions to easily edit the project +;; files used by the ada-mode. +;; The only function publicly available here is `ada-customize'. +;; See the documentation of the Ada mode for more information on the project +;; files. +;; Internally, a project file is represented as a property list, with each +;; field of the project file matching one property of the list. ;;; Code: @@ -45,7 +41,8 @@ (require 'ada-xref) (eval-when-compile - (require 'ada-mode)) + (require 'ada-mode)) +(eval-when-compile (require 'cl-lib)) ;; ----- Buffer local variables ------------------------------------------- @@ -125,7 +122,7 @@ If the current value of FIELD is the default value, return an empty string." (let ((file-name (or (plist-get ada-prj-current-values 'filename) (read-file-name "Save project as: "))) output) - (set 'output + (setq output (concat ;; Save the fields that do not depend on the current buffer @@ -176,7 +173,7 @@ If the current value of FIELD is the default value, return an empty string." (kill-buffer "*Edit Ada Mode Project*") ;; automatically set the new project file as the active one - (set 'ada-prj-default-project-file file-name) + (setq ada-prj-default-project-file file-name) ;; force Emacs to reread the project files (ada-reread-prj-file file-name) @@ -195,12 +192,12 @@ One item per line should be found in the file." (widen) (goto-char (point-min)) (while (not (eobp)) - (set 'line (buffer-substring-no-properties (point) (point-at-eol))) - (add-to-list 'list line) + (setq line (buffer-substring-no-properties (point) (point-at-eol))) + (cl-pushnew line list :test #'equal) (forward-line 1)) (kill-buffer nil) (set-buffer buffer) - (set 'ada-prj-current-values + (setq ada-prj-current-values (plist-put ada-prj-current-values symbol (append (plist-get ada-prj-current-values symbol) @@ -215,8 +212,8 @@ One item per line should be found in the file." (if (file-directory-p (car subdirs)) (let ((sub (ada-prj-subdirs-of (car subdirs)))) (if sub - (set 'dirlist (append sub dirlist))))) - (set 'subdirs (cdr subdirs))) + (setq dirlist (append sub dirlist))))) + (setq subdirs (cdr subdirs))) dirlist)) (defun ada-prj-load-directory (field &optional file-name) @@ -227,9 +224,9 @@ If FILE-NAME is nil, ask the user for the name." ;; the user to select a directory (let ((use-dialog-box nil)) (unless file-name - (set 'file-name (read-directory-name "Root directory: " nil nil t)))) + (setq file-name (read-directory-name "Root directory: " nil nil t)))) - (set 'ada-prj-current-values + (setq ada-prj-current-values (plist-put ada-prj-current-values field (append (plist-get ada-prj-current-values field) @@ -551,7 +548,7 @@ converted to a directory name." Remaining args DUMMY are ignored. Save the change in `ada-prj-current-values' so that selecting another page and coming back keeps the new value." - (set 'ada-prj-current-values + (setq ada-prj-current-values (plist-put ada-prj-current-values (widget-get widget ':prj-field) (widget-value widget)))) @@ -621,7 +618,7 @@ AFTER-TEXT is inserted just after the widget." (inhibit-read-only t) widget) (unless value - (set 'value + (setq value (if is-list '() ""))) (widget-insert text) (widget-insert ":") @@ -649,7 +646,7 @@ AFTER-TEXT is inserted just after the widget." "Load Recursive Directory") (widget-insert "\n ${build_dir}\n"))) - (set 'widget + (setq widget (if is-list (if (< (length value) 15) (widget-create 'editable-list diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el index 4da81da7854..4e196505b6c 100644 --- a/lisp/progmodes/ada-xref.el +++ b/lisp/progmodes/ada-xref.el @@ -25,19 +25,14 @@ ;; along with GNU Emacs. If not, see . ;;; Commentary: -;;; This Package provides a set of functions to use the output of the -;;; cross reference capabilities of the GNAT Ada compiler -;;; for lookup and completion in Ada mode. -;;; -;;; If a file *.`adp' exists in the ada-file directory, then it is -;;; read for configuration information. It is read only the first -;;; time a cross-reference is asked for, and is not read later. -;;; You need Emacs >= 20.2 to run this package - - -;;; History: +;; This Package provides a set of functions to use the output of the +;; cross reference capabilities of the GNAT Ada compiler +;; for lookup and completion in Ada mode. ;; +;; If a file *.`adp' exists in the ada-file directory, then it is +;; read for configuration information. It is read only the first +;; time a cross-reference is asked for, and is not read later. ;;; Code: @@ -47,6 +42,7 @@ (require 'comint) (require 'find-file) (require 'ada-mode) +(eval-when-compile (require 'cl-lib)) ;; ------ User variables (defcustom ada-xref-other-buffer t @@ -318,9 +314,9 @@ CROSS-PREFIX is the prefix to use for the `gnatls' command." (forward-line 1) (while (not (looking-at "^$")) (back-to-indentation) - (if (looking-at "") - (add-to-list 'ada-xref-runtime-library-specs-path ".") - (add-to-list 'ada-xref-runtime-library-specs-path + (add-to-list 'ada-xref-runtime-library-specs-path + (if (looking-at "") + "." (buffer-substring-no-properties (point) (point-at-eol)))) @@ -332,9 +328,9 @@ CROSS-PREFIX is the prefix to use for the `gnatls' command." (forward-line 1) (while (not (looking-at "^$")) (back-to-indentation) - (if (looking-at "") - (add-to-list 'ada-xref-runtime-library-ali-path ".") - (add-to-list 'ada-xref-runtime-library-ali-path + (add-to-list 'ada-xref-runtime-library-ali-path + (if (looking-at "") + "." (buffer-substring-no-properties (point) (point-at-eol)))) @@ -380,12 +376,12 @@ Assumes environment variable ADA_PROJECT_PATH is set properly." (forward-line 1) ; first directory in list (while (not (looking-at "^$")) ; terminate on blank line (back-to-indentation) ; skip whitespace - (add-to-list 'src-dir - (if (looking-at "") - default-directory - (expand-file-name - (buffer-substring-no-properties - (point) (line-end-position))))) + (cl-pushnew (if (looking-at "") + default-directory + (expand-file-name + (buffer-substring-no-properties + (point) (line-end-position)))) + src-dir :test #'equal) (forward-line 1)) ;; Object path @@ -394,12 +390,12 @@ Assumes environment variable ADA_PROJECT_PATH is set properly." (forward-line 1) (while (not (looking-at "^$")) (back-to-indentation) - (add-to-list 'obj-dir - (if (looking-at "") - default-directory - (expand-file-name - (buffer-substring-no-properties - (point) (line-end-position))))) + (cl-pushnew (if (looking-at "") + default-directory + (expand-file-name + (buffer-substring-no-properties + (point) (line-end-position)))) + obj-dir :test #'equal) (forward-line 1)) ;; Set properties @@ -831,9 +827,9 @@ Return new value of PROJECT." ;; FIXME: strip trailing spaces ;; variable name alphabetical order ((string= (match-string 1) "ada_project_path") - (add-to-list 'ada_project_path - (expand-file-name - (substitute-in-file-name (match-string 2))))) + (cl-pushnew (expand-file-name + (substitute-in-file-name (match-string 2))) + ada_project_path :test #'equal)) ((string= (match-string 1) "build_dir") (setq project @@ -841,40 +837,40 @@ Return new value of PROJECT." (file-name-as-directory (match-string 2))))) ((string= (match-string 1) "casing") - (add-to-list 'casing - (expand-file-name (substitute-in-file-name (match-string 2))))) + (cl-pushnew (expand-file-name (substitute-in-file-name (match-string 2))) + casing :test #'equal)) ((string= (match-string 1) "check_cmd") - (add-to-list 'check_cmd (match-string 2))) + (cl-pushnew (match-string 2) check_cmd :test #'equal)) ((string= (match-string 1) "comp_cmd") - (add-to-list 'comp_cmd (match-string 2))) + (cl-pushnew (match-string 2) comp_cmd :test #'equal)) ((string= (match-string 1) "debug_post_cmd") - (add-to-list 'debug_post_cmd (match-string 2))) + (cl-pushnew (match-string 2) debug_post_cmd :test #'equal)) ((string= (match-string 1) "debug_pre_cmd") - (add-to-list 'debug_pre_cmd (match-string 2))) + (cl-pushnew (match-string 2) debug_pre_cmd :test #'equal)) ((string= (match-string 1) "gpr_file") ;; expand now; path is relative to Emacs project file (setq gpr_file (expand-file-name (match-string 2)))) ((string= (match-string 1) "make_cmd") - (add-to-list 'make_cmd (match-string 2))) + (cl-pushnew (match-string 2) make_cmd :test #'equal)) ((string= (match-string 1) "obj_dir") - (add-to-list 'obj_dir - (file-name-as-directory - (expand-file-name (match-string 2))))) + (cl-pushnew (file-name-as-directory + (expand-file-name (match-string 2))) + obj_dir :test #'equal)) ((string= (match-string 1) "run_cmd") - (add-to-list 'run_cmd (match-string 2))) + (cl-pushnew (match-string 2) run_cmd :test #'equal)) ((string= (match-string 1) "src_dir") - (add-to-list 'src_dir - (file-name-as-directory - (expand-file-name (match-string 2))))) + (cl-pushnew (file-name-as-directory + (expand-file-name (match-string 2))) + src_dir :test #'equal)) (t ;; any other field in the file is just copied @@ -1866,8 +1862,8 @@ This function is disabled for operators, and only works for identifiers." ) ;; construct a list with the file names and the positions within (if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9._-]+\\)" nil t) - (add-to-list - 'declist (list line-ali (match-string 1) line-ada col-ada)) + (cl-pushnew (list line-ali (match-string 1) line-ada col-ada) + declist :test #'equal) ) ) ) diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index 689c1ade8a2..1282f08b073 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -3597,7 +3597,7 @@ Existing overlays are recycled, in order to minimize consumption." (if ov-alist (while (setq ov-list (pop ov-alist)) (while (setq ov (pop (cdr ov-list))) - (add-to-list 'old-buffers (overlay-buffer ov)) + (pushnew (overlay-buffer ov) old-buffers) (delete-overlay ov)))) (setq ov-alist idlwave-shell-bp-overlays