mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-15 10:30:25 -08:00
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.
This commit is contained in:
Stefan Monnier
parent
461ef3c518
commit
8b6c19f4c2
5 changed files with 135 additions and 96 deletions
|
|
@ -1,3 +1,17 @@
|
|||
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).
|
||||
|
|
|
|||
|
|
@ -1,3 +1,9 @@
|
|||
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
|
||||
|
|
|
|||
91
lisp/man.el
91
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."
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
))
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue