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.
This commit is contained in:
Stefan Monnier
parent
f49f8c1454
commit
2ec41c415f
12 changed files with 186 additions and 183 deletions
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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."
|
|||
(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
|
||||
|
|
|
|||
|
|
@ -25,19 +25,14 @@
|
|||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; 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 "<Current_Directory>")
|
||||
(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 "<Current_Directory>")
|
||||
"."
|
||||
(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 "<Current_Directory>")
|
||||
(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 "<Current_Directory>")
|
||||
"."
|
||||
(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 "<Current_Directory>")
|
||||
default-directory
|
||||
(expand-file-name
|
||||
(buffer-substring-no-properties
|
||||
(point) (line-end-position)))))
|
||||
(cl-pushnew (if (looking-at "<Current_Directory>")
|
||||
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 "<Current_Directory>")
|
||||
default-directory
|
||||
(expand-file-name
|
||||
(buffer-substring-no-properties
|
||||
(point) (line-end-position)))))
|
||||
(cl-pushnew (if (looking-at "<Current_Directory>")
|
||||
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)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue