From 8b6c19f4c23e69f2133a8432d614abdc03bdadc6 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 28 Apr 2012 17:59:08 -0400 Subject: [PATCH] Avoid the obsolete `assoc' package. * lisp/speedbar.el (speedbar-refresh): Avoid adelete. (speedbar-file-lists): Simplify and avoid aput. * lisp/man.el (Man--sections, Man--refpages): New vars, replacing Man-sections-alist and Man-refpages-alist. (Man-build-section-alist, Man-build-references-alist): Use them; avoid aput. (Man--last-section, Man--last-refpage): New vars. (Man-follow-manual-reference): Use them. Use the `default' arg of completing-read. (Man-goto-section): Idem. Move prompt to the `interactive' spec. * lisp/gnus/auth-source.el (auth-source--aput-1, auth-source--aput) (auth-source--aget): New functions and macros. Use them instead of aput/aget. --- lisp/ChangeLog | 14 +++++++ lisp/gnus/ChangeLog | 6 +++ lisp/gnus/auth-source.el | 98 ++++++++++++++++++++++++++++-------------------- lisp/man.el | 91 ++++++++++++++++++++++---------------------- lisp/speedbar.el | 22 +++++------ 5 files changed, 135 insertions(+), 96 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index eaf07c087a2..13c6c1ecbed 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,17 @@ +2012-04-28 Stefan Monnier + + Avoid the obsolete `assoc' package. + * speedbar.el (speedbar-refresh): Avoid adelete. + (speedbar-file-lists): Simplify and avoid aput. + * man.el (Man--sections, Man--refpages): New vars, replacing + Man-sections-alist and Man-refpages-alist. + (Man-build-section-alist, Man-build-references-alist): + Use them; avoid aput. + (Man--last-section, Man--last-refpage): New vars. + (Man-follow-manual-reference): Use them. + Use the `default' arg of completing-read. + (Man-goto-section): Idem. Move prompt to the `interactive' spec. + 2012-04-27 Chong Yidong * vc/diff.el (diff-sentinel): Go to bob (Bug#10259). diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 556094ca614..cacd20ce99d 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,9 @@ +2012-04-28 Stefan Monnier + + * auth-source.el (auth-source--aput-1, auth-source--aput) + (auth-source--aget): New functions and macros. + Use them instead of aput/aget. + 2012-04-27 Andreas Schwab * gnus.el (debbugs-gnu): Don't override existing autoload definition. diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index 34fe5afe7af..d3d213a753b 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el @@ -42,7 +42,6 @@ (require 'password-cache) (require 'mm-util) (require 'gnus-util) -(require 'assoc) (eval-when-compile (require 'cl)) (require 'eieio) @@ -853,6 +852,21 @@ while \(:host t) would find all host entries." ;;; Backend specific parsing: netrc/authinfo backend +(defun auth-source--aput-1 (alist key val) + (let ((seen ()) + (rest alist)) + (while (and (consp rest) (not (equal key (caar rest)))) + (push (pop rest) seen)) + (cons (cons key val) + (if (null rest) alist + (nconc (nreverse seen) + (if (equal key (caar rest)) (cdr rest) rest)))))) +(defmacro auth-source--aput (var key val) + `(setq ,var (auth-source--aput-1 ,var ,key ,val))) + +(defun auth-source--aget (alist key) + (cdr (assoc key alist))) + ;;; (auth-source-netrc-parse "~/.authinfo.gpg") (defun* auth-source-netrc-parse (&rest spec @@ -888,10 +902,11 @@ Note that the MAX parameter is used so we can exit the parse early." ;; cache all netrc files (used to be just .gpg files) ;; Store the contents of the file heavily encrypted in memory. ;; (note for the irony-impaired: they are just obfuscated) - (aput 'auth-source-netrc-cache file - (list :mtime (nth 5 (file-attributes file)) - :secret (lexical-let ((v (mapcar '1+ (buffer-string)))) - (lambda () (apply 'string (mapcar '1- v))))))) + (auth-source--aput + auth-source-netrc-cache file + (list :mtime (nth 5 (file-attributes file)) + :secret (lexical-let ((v (mapcar '1+ (buffer-string)))) + (lambda () (apply 'string (mapcar '1- v))))))) (goto-char (point-min)) ;; Go through the file, line by line. (while (and (not (eobp)) @@ -937,21 +952,21 @@ Note that the MAX parameter is used so we can exit the parse early." (auth-source-search-collection host (or - (aget alist "machine") - (aget alist "host") + (auth-source--aget alist "machine") + (auth-source--aget alist "host") t)) (auth-source-search-collection user (or - (aget alist "login") - (aget alist "account") - (aget alist "user") + (auth-source--aget alist "login") + (auth-source--aget alist "account") + (auth-source--aget alist "user") t)) (auth-source-search-collection port (or - (aget alist "port") - (aget alist "protocol") + (auth-source--aget alist "port") + (auth-source--aget alist "protocol") t)) (or ;; the required list of keys is nil, or @@ -1166,7 +1181,7 @@ See `auth-source-search' for details on SPEC." ;; just the value otherwise (t (symbol-value br))))) (when br-choice - (aput 'valist br br-choice))))) + (auth-source--aput valist br br-choice))))) ;; for extra required elements, see if the spec includes a value for them (dolist (er create-extra) @@ -1175,17 +1190,18 @@ See `auth-source-search' for details on SPEC." collect (nth i spec)))) (dolist (k keys) (when (equal (symbol-name k) name) - (aput 'valist er (plist-get spec k)))))) + (auth-source--aput valist er (plist-get spec k)))))) ;; for each required element (dolist (r required) - (let* ((data (aget valist r)) + (let* ((data (auth-source--aget valist r)) ;; take the first element if the data is a list (data (or (auth-source-netrc-element-or-first data) (plist-get current-data (intern (format ":%s" r) obarray)))) ;; this is the default to be offered - (given-default (aget auth-source-creation-defaults r)) + (given-default (auth-source--aget + auth-source-creation-defaults r)) ;; the default supplementals are simple: ;; for the user, try `given-default' and then (user-login-name); ;; otherwise take `given-default' @@ -1197,22 +1213,22 @@ See `auth-source-search' for details on SPEC." (cons 'user (or (auth-source-netrc-element-or-first - (aget valist 'user)) + (auth-source--aget valist 'user)) (plist-get artificial :user) "[any user]")) (cons 'host (or (auth-source-netrc-element-or-first - (aget valist 'host)) + (auth-source--aget valist 'host)) (plist-get artificial :host) "[any host]")) (cons 'port (or (auth-source-netrc-element-or-first - (aget valist 'port)) + (auth-source--aget valist 'port)) (plist-get artificial :port) "[any port]")))) - (prompt (or (aget auth-source-creation-prompts r) + (prompt (or (auth-source--aget auth-source-creation-prompts r) (case r (secret "%p password for %u@%h: ") (user "%p user name for %h: ") @@ -1221,9 +1237,9 @@ See `auth-source-search' for details on SPEC." (format "Enter %s (%%u@%%h:%%p): " r))) (prompt (auth-source-format-prompt prompt - `((?u ,(aget printable-defaults 'user)) - (?h ,(aget printable-defaults 'host)) - (?p ,(aget printable-defaults 'port)))))) + `((?u ,(auth-source--aget printable-defaults 'user)) + (?h ,(auth-source--aget printable-defaults 'host)) + (?p ,(auth-source--aget printable-defaults 'port)))))) ;; Store the data, prompting for the password if needed. (setq data (or data @@ -1384,7 +1400,7 @@ Respects `auth-source-save-behavior'. Uses file) (message "Saved new authentication information to %s" file) nil)))) - (aput 'auth-source-netrc-cache key "ran")))) + (auth-source--aput auth-source-netrc-cache key "ran")))) ;;; Backend specific parsing: Secrets API backend @@ -1609,7 +1625,7 @@ authentication tokens: ;; just the value otherwise (t (symbol-value br))))) (when br-choice - (aput 'valist br br-choice))))) + (auth-source--aput valist br br-choice))))) ;; for extra required elements, see if the spec includes a value for them (dolist (er create-extra) @@ -1618,17 +1634,18 @@ authentication tokens: collect (nth i spec)))) (dolist (k keys) (when (equal (symbol-name k) name) - (aput 'valist er (plist-get spec k)))))) + (auth-source--aput valist er (plist-get spec k)))))) ;; for each required element (dolist (r required) - (let* ((data (aget valist r)) + (let* ((data (auth-source--aget valist r)) ;; take the first element if the data is a list (data (or (auth-source-netrc-element-or-first data) (plist-get current-data (intern (format ":%s" r) obarray)))) ;; this is the default to be offered - (given-default (aget auth-source-creation-defaults r)) + (given-default (auth-source--aget + auth-source-creation-defaults r)) ;; the default supplementals are simple: ;; for the user, try `given-default' and then (user-login-name); ;; otherwise take `given-default' @@ -1640,22 +1657,22 @@ authentication tokens: (cons 'user (or (auth-source-netrc-element-or-first - (aget valist 'user)) + (auth-source--aget valist 'user)) (plist-get artificial :user) "[any user]")) (cons 'host (or (auth-source-netrc-element-or-first - (aget valist 'host)) + (auth-source--aget valist 'host)) (plist-get artificial :host) "[any host]")) (cons 'port (or (auth-source-netrc-element-or-first - (aget valist 'port)) + (auth-source--aget valist 'port)) (plist-get artificial :port) "[any port]")))) - (prompt (or (aget auth-source-creation-prompts r) + (prompt (or (auth-source--aget auth-source-creation-prompts r) (case r (secret "%p password for %u@%h: ") (user "%p user name for %h: ") @@ -1664,20 +1681,21 @@ authentication tokens: (format "Enter %s (%%u@%%h:%%p): " r))) (prompt (auth-source-format-prompt prompt - `((?u ,(aget printable-defaults 'user)) - (?h ,(aget printable-defaults 'host)) - (?p ,(aget printable-defaults 'port)))))) + `((?u ,(auth-source--aget printable-defaults 'user)) + (?h ,(auth-source--aget printable-defaults 'host)) + (?p ,(auth-source--aget printable-defaults 'port)))))) ;; Store the data, prompting for the password if needed. (setq data (or data (if (eq r 'secret) (or (eval default) (read-passwd prompt)) (if (stringp default) - (read-string (if (string-match ": *\\'" prompt) - (concat (substring prompt 0 (match-beginning 0)) - " (default " default "): ") - (concat prompt "(default " default ") ")) - nil nil default) + (read-string + (if (string-match ": *\\'" prompt) + (concat (substring prompt 0 (match-beginning 0)) + " (default " default "): ") + (concat prompt "(default " default ") ")) + nil nil default) (eval default))))) (when data diff --git a/lisp/man.el b/lisp/man.el index 0a7b831ca8e..6912486dffa 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -89,7 +89,6 @@ ;;; Code: (eval-when-compile (require 'cl)) -(require 'assoc) (require 'button) ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv @@ -360,10 +359,10 @@ Otherwise, the value is whatever the function (make-variable-buffer-local 'Man-arguments) (put 'Man-arguments 'permanent-local t) -(defvar Man-sections-alist nil) -(make-variable-buffer-local 'Man-sections-alist) -(defvar Man-refpages-alist nil) -(make-variable-buffer-local 'Man-refpages-alist) +(defvar Man--sections nil) +(make-variable-buffer-local 'Man--sections) +(defvar Man--refpages nil) +(make-variable-buffer-local 'Man--refpages) (defvar Man-page-list nil) (make-variable-buffer-local 'Man-page-list) (defvar Man-current-page 0) @@ -1370,17 +1369,19 @@ The following key bindings are currently in effect in the buffer: (run-mode-hooks 'Man-mode-hook)) (defsubst Man-build-section-alist () - "Build the association list of manpage sections." - (setq Man-sections-alist nil) + "Build the list of manpage sections." + (setq Man--sections nil) (goto-char (point-min)) (let ((case-fold-search nil)) (while (re-search-forward Man-heading-regexp (point-max) t) - (aput 'Man-sections-alist (match-string 1)) + (let ((section (match-string 1))) + (unless (member section Man--sections) + (push section Man--sections))) (forward-line 1)))) (defsubst Man-build-references-alist () - "Build the association list of references (in the SEE ALSO section)." - (setq Man-refpages-alist nil) + "Build the list of references (in the SEE ALSO section)." + (setq Man--refpages nil) (save-excursion (if (Man-find-section Man-see-also-regexp) (let ((start (progn (forward-line 1) (point))) @@ -1406,10 +1407,11 @@ The following key bindings are currently in effect in the buffer: len (1- (length word)))) (if (memq (aref word len) '(?- ?­)) (setq hyphenated (substring word 0 len))) - (if (string-match Man-reference-regexp word) - (aput 'Man-refpages-alist word)))) + (and (string-match Man-reference-regexp word) + (not (member word Man--refpages)) + (push word Man--refpages)))) (skip-chars-forward " \t\n,")))))) - (setq Man-refpages-alist (nreverse Man-refpages-alist))) + (setq Man--refpages (nreverse Man--refpages))) (defun Man-build-page-list () "Build the list of separate manpages in the buffer." @@ -1541,21 +1543,22 @@ Returns t if section is found, nil otherwise." nil) )) -(defun Man-goto-section () - "Query for section to move point to." - (interactive) - (aput 'Man-sections-alist - (let* ((default (aheadsym Man-sections-alist)) - (completion-ignore-case t) - chosen - (prompt (concat "Go to section (default " default "): "))) - (setq chosen (completing-read prompt Man-sections-alist)) - (if (or (not chosen) - (string= chosen "")) - default - chosen))) - (unless (Man-find-section (aheadsym Man-sections-alist)) - (error "Section not found"))) +(defvar Man--last-section nil) + +(defun Man-goto-section (section) + "Move point to SECTION." + (interactive + (let* ((default (if (member Man--last-section Man--sections) + Man--last-section + (car Man--sections))) + (completion-ignore-case t) + (prompt (concat "Go to section (default " default "): ")) + (chosen (completing-read prompt Man--sections + nil nil nil nil default))) + (list chosen))) + (setq Man--last-section section) + (unless (Man-find-section section) + (error "Section %s not found" section))) (defun Man-goto-see-also-section () @@ -1586,11 +1589,13 @@ as \"tcgetp-grp(3V)\", and point is at \"grp(3V)\", we return (setq word (current-word)))) word))) +(defvar Man--last-refpage nil) + (defun Man-follow-manual-reference (reference) "Get one of the manpages referred to in the \"SEE ALSO\" section. Specify which REFERENCE to use; default is based on word at point." (interactive - (if (not Man-refpages-alist) + (if (not Man--refpages) (error "There are no references in the current man page") (list (let* ((default (or @@ -1603,26 +1608,22 @@ Specify which REFERENCE to use; default is based on word at point." (substring word 0 (match-beginning 0)) word)) - Man-refpages-alist)) - (aheadsym Man-refpages-alist))) + Man--refpages)) + (if (member Man--last-refpage Man--refpages) + Man--last-refpage + (car Man--refpages)))) (defaults (mapcar 'substring-no-properties - (delete-dups - (delq nil (cons default - (mapcar 'car Man-refpages-alist)))))) - chosen - (prompt (concat "Refer to (default " default "): "))) - (setq chosen (completing-read prompt Man-refpages-alist - nil nil nil nil defaults)) - (if (or (not chosen) - (string= chosen "")) - default - chosen))))) - (if (not Man-refpages-alist) + (cons default Man--refpages))) + (prompt (concat "Refer to (default " default "): ")) + (chosen (completing-read prompt Man--refpages + nil nil nil nil defaults))) + chosen)))) + (if (not Man--refpages) (error "Can't find any references in the current manpage") - (aput 'Man-refpages-alist reference) + (setq Man--last-refpage reference) (Man-getpage-in-background - (Man-translate-references (aheadsym Man-refpages-alist))))) + (Man-translate-references reference)))) (defun Man-kill () "Kill the buffer containing the manpage." diff --git a/lisp/speedbar.el b/lisp/speedbar.el index 9065d9ed131..c1e86e17e37 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -125,7 +125,6 @@ this version is not backward compatible to 0.14 or earlier.") ;;; TODO: ;; - Timeout directories we haven't visited in a while. -(require 'assoc) (require 'easymenu) (require 'dframe) (require 'sb-image) @@ -1413,9 +1412,10 @@ Argument ARG represents to force a refresh past any caches that may exist." (dframe-power-click arg) deactivate-mark) ;; We need to hack something so this works in detached frames. - (while dl - (adelete 'speedbar-directory-contents-alist (car dl)) - (setq dl (cdr dl))) + (dolist (d dl) + (setq speedbar-directory-contents-alist + (delq (assoc d speedbar-directory-contents-alist) + speedbar-directory-contents-alist))) (if (<= 1 speedbar-verbosity-level) (speedbar-message "Refreshing speedbar...")) (speedbar-update-contents) @@ -1898,12 +1898,9 @@ matching ignored headers. Cache any directory files found in `speedbar-directory-contents-alist' and use that cache before scanning the file-system." (setq directory (expand-file-name directory)) - ;; If in powerclick mode, then the directory we are getting - ;; should be rescanned. - (if dframe-power-click - (adelete 'speedbar-directory-contents-alist directory)) ;; find the directory, either in the cache, or build it. - (or (cdr-safe (assoc directory speedbar-directory-contents-alist)) + (or (and (not dframe-power-click) ;; In powerclick mode, always rescan. + (cdr-safe (assoc directory speedbar-directory-contents-alist))) (let ((default-directory directory) (dir (directory-files directory nil)) (dirs nil) @@ -1917,8 +1914,11 @@ the file-system." (setq dirs (cons (car dir) dirs)) (setq files (cons (car dir) files)))) (setq dir (cdr dir))) - (let ((nl (cons (nreverse dirs) (list (nreverse files))))) - (aput 'speedbar-directory-contents-alist directory nl) + (let ((nl (cons (nreverse dirs) (list (nreverse files)))) + (ae (assoc directory speedbar-directory-contents-alist))) + (if ae (setcdr ae nl) + (push (cons directory nl) + speedbar-directory-contents-alist)) nl)) )) -- 2.11.4.GIT