Commit 2ec41c41 authored by Stefan Monnier's avatar Stefan Monnier

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.
parent f49f8c14
;;; 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)))
......
;;; 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)
......
;;; 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)
......
......@@ -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)
......
......@@ -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.
......
;;; 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
......
......@@ -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"
......
......@@ -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)
......
......@@ -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)))
......
......@@ -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."