* 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.
-;;; 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.
(require 'gnus-group)
(require 'message)
(require 'gnus-util)
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
;;; Internal Variables:
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))
(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)))
(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)))))
(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
(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))))
;; 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))))
(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)
(message "Massaging swish++ output...done")
;; Sort by score
- (apply 'vector
+ (apply #'vector
(sort artlist
(function (lambda (x y)
(> (nnir-artitem-rsv x)
(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)
(message "Massaging swish-e output...done")
;; Sort by score
- (apply 'vector
+ (apply #'vector
(sort artlist
(function (lambda (x y)
(> (nnir-artitem-rsv x)
(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)
(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)
(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)
(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)
(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)
(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)))
(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:
(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.
(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)))
(defun nnir-run-query (specs)
"Invoke appropriate search engine function (see `nnir-engines')."
- (apply 'vconcat
+ (apply #'vconcat
(mapcar
(lambda (x)
(let* ((server (car x))
(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.
(require 'password-cache)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defgroup smime nil
"S/MIME configuration."
;; 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
(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
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))
(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)
(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.
;;; Code:
+(eval-when-compile (require 'cl-lib))
(require 'rmail)
(defcustom rmail-forward-separator-regex
(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))
(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))))
(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
(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)
(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)
(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.
;;; 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)
(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.
(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)
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 ()
((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."
;; 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
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"
;;; 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))
(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)
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
(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
(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)))
(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)))
;;; 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:
(require 'ada-xref)
(eval-when-compile
- (require 'ada-mode))
+ (require 'ada-mode))
+(eval-when-compile (require 'cl-lib))
;; ----- Buffer local variables -------------------------------------------
(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
(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)
(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)
(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)
;; 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)
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))))
(inhibit-read-only t)
widget)
(unless value
- (set 'value
+ (setq value
(if is-list '() "")))
(widget-insert text)
(widget-insert ":")
"Load Recursive Directory")
(widget-insert "\n ${build_dir}\n")))
- (set 'widget
+ (setq widget
(if is-list
(if (< (length value) 15)
(widget-create 'editable-list
;; 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:
(require 'comint)
(require 'find-file)
(require 'ada-mode)
+(eval-when-compile (require 'cl-lib))
;; ------ User variables
(defcustom ada-xref-other-buffer t
(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))))
(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))))
(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
(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
;; 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
(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
)
;; 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)
)
)
)
(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
projects / emacs.git / commitdiff