Commit 8b6c19f4 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

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.
parent 461ef3c5
2012-04-28 Stefan Monnier <monnier@iro.umontreal.ca>
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 <cyd@gnu.org>
* vc/diff.el (diff-sentinel): Go to bob (Bug#10259).
......
2012-04-28 Stefan Monnier <monnier@iro.umontreal.ca>
* 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 <schwab@linux-m68k.org>
 
* gnus.el (debbugs-gnu): Don't override existing autoload definition.
......
......@@ -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
......
......@@ -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."
......
......@@ -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))
))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment