emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] /srv/bzr/emacs/trunk r108058: Avoid the obsolete `assoc' p


From: Stefan Monnier
Subject: [Emacs-diffs] /srv/bzr/emacs/trunk r108058: Avoid the obsolete `assoc' package.
Date: Sat, 28 Apr 2012 17:59:08 -0400
User-agent: Bazaar (2.3.1)

------------------------------------------------------------
revno: 108058
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Sat 2012-04-28 17:59:08 -0400
message:
  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.
modified:
  lisp/ChangeLog
  lisp/gnus/ChangeLog
  lisp/gnus/auth-source.el
  lisp/man.el
  lisp/speedbar.el
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-04-27 14:16:02 +0000
+++ b/lisp/ChangeLog    2012-04-28 21:59:08 +0000
@@ -1,3 +1,17 @@
+2012-04-28  Stefan Monnier  <address@hidden>
+
+       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  <address@hidden>
 
        * vc/diff.el (diff-sentinel): Go to bob (Bug#10259).

=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog       2012-04-27 03:10:38 +0000
+++ b/lisp/gnus/ChangeLog       2012-04-28 21:59:08 +0000
@@ -1,3 +1,9 @@
+2012-04-28  Stefan Monnier  <address@hidden>
+
+       * 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  <address@hidden>
 
        * gnus.el (debbugs-gnu): Don't override existing autoload definition.

=== modified file 'lisp/gnus/auth-source.el'
--- a/lisp/gnus/auth-source.el  2012-03-23 11:22:21 +0000
+++ b/lisp/gnus/auth-source.el  2012-04-28 21:59:08 +0000
@@ -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 @@
 
 ;;; 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 @@
             ;; 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 @@
                        (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 @@
                           ;; 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 @@
                         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 @@
                                   (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 address@hidden: ")
                            (user "%p user name for %h: ")
@@ -1221,9 +1237,9 @@
                          (format "Enter %s (address@hidden:%%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 @@
                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 @@
                           ;; 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 @@
                         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 @@
                                   (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 address@hidden: ")
                            (user "%p user name for %h: ")
@@ -1664,20 +1681,21 @@
                          (format "Enter %s (address@hidden:%%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

=== modified file 'lisp/man.el'
--- a/lisp/man.el       2012-02-22 08:34:02 +0000
+++ b/lisp/man.el       2012-04-28 21:59:08 +0000
@@ -89,7 +89,6 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
-(require 'assoc)
 (require 'button)
 
 ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
@@ -360,10 +359,10 @@
 (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 @@
   (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 @@
                              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 @@
       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 @@
            (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 @@
                                   (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."

=== modified file 'lisp/speedbar.el'
--- a/lisp/speedbar.el  2012-04-17 00:04:53 +0000
+++ b/lisp/speedbar.el  2012-04-28 21:59:08 +0000
@@ -125,7 +125,6 @@
 ;;; TODO:
 ;; - Timeout directories we haven't visited in a while.
 
-(require 'assoc)
 (require 'easymenu)
 (require 'dframe)
 (require 'sb-image)
@@ -1413,9 +1412,10 @@
        (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 @@
 `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 @@
                  (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))
       ))
 


reply via email to

[Prev in Thread] Current Thread [Next in Thread]