[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] trunk r118000: * lisp/subr.el (alist-get): New accessor.
From: |
Stefan Monnier |
Subject: |
[Emacs-diffs] trunk r118000: * lisp/subr.el (alist-get): New accessor. |
Date: |
Wed, 01 Oct 2014 17:23:54 +0000 |
User-agent: |
Bazaar (2.6b2) |
------------------------------------------------------------
revno: 118000
revision-id: address@hidden
parent: address@hidden
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Wed 2014-10-01 13:23:42 -0400
message:
* lisp/subr.el (alist-get): New accessor.
* lisp/emacs-lisp/gv.el (alist-get): Provide expander.
* lisp/winner.el (winner-remember):
* lisp/tempo.el (tempo-use-tag-list):
* lisp/progmodes/gud.el (minor-mode-map-alist):
* lisp/international/mule-cmds.el (define-char-code-property):
* lisp/frameset.el (frameset-filter-params):
* lisp/files.el (dir-locals-set-class-variables):
* lisp/register.el (get-register, set-register):
* lisp/calc/calc-yank.el (calc-set-register): Use it.
* lisp/ps-print.el (ps-get, ps-put, ps-del): Mark as obsolete.
* lisp/tooltip.el (tooltip-set-param): Mark as obsolete.
(tooltip-show): Use alist-get instead.
* lisp/ses.el (ses--alist-get): Remove. Use alist-get instead.
* admin/unidata/unidata-gen.el (unidata-gen-table-word-list): Use alist-get
and cl-incf.
modified:
admin/ChangeLog changelog-20091113204419-o5vbwnq5f7feedwu-2226
admin/unidata/unidata-gen.el
unidatagen.el-20091113204419-o5vbwnq5f7feedwu-8382
etc/NEWS news-20100311060928-aoit31wvzf25yr1z-1
lisp/ChangeLog changelog-20091113204419-o5vbwnq5f7feedwu-1432
lisp/calc/calc-prog.el
calcprog.el-20091113204419-o5vbwnq5f7feedwu-2294
lisp/calc/calc-yank.el
calcyank.el-20091113204419-o5vbwnq5f7feedwu-2305
lisp/emacs-lisp/gv.el setf.el-20120531120738-6w8114hk2anryyud-1
lisp/files.el files.el-20091113204419-o5vbwnq5f7feedwu-265
lisp/frameset.el frameset.el-20130802043218-tfwraxv1c2zlibpw-1
lisp/international/mule-cmds.el
mulecmds.el-20091113204419-o5vbwnq5f7feedwu-1043
lisp/progmodes/gud.el gud.el-20091113204419-o5vbwnq5f7feedwu-2927
lisp/ps-print.el psprint.el-20091113204419-o5vbwnq5f7feedwu-767
lisp/register.el register.el-20091113204419-o5vbwnq5f7feedwu-104
lisp/ses.el ses.el-20091113204419-o5vbwnq5f7feedwu-2447
lisp/subr.el subr.el-20091113204419-o5vbwnq5f7feedwu-151
lisp/tempo.el tempo.el-20091113204419-o5vbwnq5f7feedwu-774
lisp/tooltip.el tooltip.el-20091113204419-o5vbwnq5f7feedwu-1322
lisp/winner.el winner.el-20091113204419-o5vbwnq5f7feedwu-1104
=== modified file 'admin/ChangeLog'
--- a/admin/ChangeLog 2014-09-08 06:00:58 +0000
+++ b/admin/ChangeLog 2014-10-01 17:23:42 +0000
@@ -1,3 +1,8 @@
+2014-10-01 Stefan Monnier <address@hidden>
+
+ * unidata/unidata-gen.el (unidata-gen-table-word-list): Use alist-get
+ and cl-incf.
+
2014-09-08 Eli Zaretskii <address@hidden>
* unidata/unidata-gen.el (unidata-check): Bring this function up
=== modified file 'admin/unidata/unidata-gen.el'
--- a/admin/unidata/unidata-gen.el 2014-09-03 16:03:34 +0000
+++ b/admin/unidata/unidata-gen.el 2014-10-01 17:23:42 +0000
@@ -88,6 +88,8 @@
;; CHAR-or-RANGE: a character code or a cons of character codes
;; PROPn: string representing the nth property value
+(eval-when-compile (require 'cl-lib))
+
(defvar unidata-list nil)
;; Name of the directory containing files of Unicode Character Database.
@@ -923,11 +925,7 @@
(dotimes (i (length vec))
(dolist (elt (aref vec i))
(if (symbolp elt)
- (let ((slot (assq elt word-list)))
- (if slot
- (setcdr slot (1+ (cdr slot)))
- (setcdr word-list
- (cons (cons elt 1) (cdr word-list))))))))
+ (cl-incf (alist-get elt (cdr word-list) 0)))))
(set-char-table-range table (cons start limit) vec))))))
(setq word-list (sort (cdr word-list)
#'(lambda (x y) (> (cdr x) (cdr y)))))
=== modified file 'etc/NEWS'
--- a/etc/NEWS 2014-09-30 23:19:31 +0000
+++ b/etc/NEWS 2014-10-01 17:23:42 +0000
@@ -245,6 +245,8 @@
*** call-process-shell-command and process-file-shell-command
don't take "&rest args" any more.
+** New function `alist-get', which is also a valid place (aka lvalue).
+
** New function `funcall-interactively', which works like `funcall'
but makes `called-interactively-p' treat the function as (you guessed it)
called interactively.
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2014-10-01 17:20:00 +0000
+++ b/lisp/ChangeLog 2014-10-01 17:23:42 +0000
@@ -1,3 +1,20 @@
+2014-10-01 Stefan Monnier <address@hidden>
+
+ * subr.el (alist-get): New accessor.
+ * emacs-lisp/gv.el (alist-get): Provide expander.
+ * winner.el (winner-remember):
+ * tempo.el (tempo-use-tag-list):
+ * progmodes/gud.el (minor-mode-map-alist):
+ * international/mule-cmds.el (define-char-code-property):
+ * frameset.el (frameset-filter-params):
+ * files.el (dir-locals-set-class-variables):
+ * register.el (get-register, set-register):
+ * calc/calc-yank.el (calc-set-register): Use it.
+ * ps-print.el (ps-get, ps-put, ps-del): Mark as obsolete.
+ * tooltip.el (tooltip-set-param): Mark as obsolete.
+ (tooltip-show): Use alist-get instead.
+ * ses.el (ses--alist-get): Remove. Use alist-get instead.
+
2014-10-01 Ulf Jasper <address@hidden>
* net/newst-backend.el: Remove Time-stamp. Rename variable
@@ -5,8 +22,8 @@
make it customizable.
(newsticker--sentinel-work): Move xml-workarounds to function
`newsticker--do-xml-workarounds', call unless libxml-parser is
- used. Allow single quote in regexp for encoding. Use
- libxml-parser if available, else fall back to `xml-parse-region'.
+ used. Allow single quote in regexp for encoding.
+ Use libxml-parser if available, else fall back to `xml-parse-region'.
Take care of possibly missing namespace prefixes (like "RDF"
instead of "rdf:RDF") when checking xml nodes and attributes (as
libxml correctly removes the prefixes). Always use Atom 1.0 as
=== modified file 'lisp/calc/calc-prog.el'
--- a/lisp/calc/calc-prog.el 2014-01-01 07:43:34 +0000
+++ b/lisp/calc/calc-prog.el 2014-10-01 17:23:42 +0000
@@ -139,6 +139,7 @@
"calc-"))))
(let* ((kmap (calc-user-key-map))
(old (assq key kmap)))
+ ;; FIXME: Why not (define-key kmap (vector key) func)?
(if old
(setcdr old func)
(setcdr kmap (cons (cons key func) (cdr kmap))))))))
@@ -322,6 +323,7 @@
(if key
(let* ((kmap (calc-user-key-map))
(old (assq key kmap)))
+ ;; FIXME: Why not (define-key kmap (vector key) cmd)?
(if old
(setcdr old cmd)
(setcdr kmap (cons (cons key cmd) (cdr kmap)))))))
@@ -467,6 +469,7 @@
(format "z%c" key)))))
(let* ((kmap (calc-user-key-map))
(old (assq key kmap)))
+ ;; FIXME: Why not (define-key kmap (vector key) func)?
(if old
(setcdr old cmd)
(setcdr kmap (cons (cons key cmd) (cdr kmap))))))))
=== modified file 'lisp/calc/calc-yank.el'
--- a/lisp/calc/calc-yank.el 2014-02-03 00:40:49 +0000
+++ b/lisp/calc/calc-yank.el 2014-10-01 17:23:42 +0000
@@ -143,10 +143,7 @@
"Set the contents of the Calc register REGISTER to (TEXT . CALCVAL),
as well as set the contents of the Emacs register REGISTER to TEXT."
(set-register register text)
- (let ((aelt (assq register calc-register-alist)))
- (if aelt
- (setcdr aelt (cons text calcval))
- (push (cons register (cons text calcval)) calc-register-alist))))
+ (setf (alist-get register calc-register-alist) (cons text calcval)))
(defun calc-get-register (reg)
"Return the CALCVAL portion of the contents of the Calc register REG,
=== modified file 'lisp/emacs-lisp/gv.el'
--- a/lisp/emacs-lisp/gv.el 2014-05-31 15:43:43 +0000
+++ b/lisp/emacs-lisp/gv.el 2014-10-01 17:23:42 +0000
@@ -357,6 +357,34 @@
(macroexp-let2 nil v val
`(with-current-buffer ,buf (set (make-local-variable ,var) ,v))))
+(gv-define-expander alist-get
+ (lambda (do key alist &optional default remove)
+ (macroexp-let2 macroexp-copyable-p k key
+ (gv-letplace (getter setter) alist
+ (macroexp-let2 nil p `(assq ,k ,getter)
+ (funcall do (if (null default) `(cdr ,p)
+ `(if ,p (cdr ,p) ,default))
+ (lambda (v)
+ (macroexp-let2 nil v v
+ (let ((set-exp
+ `(if ,p (setcdr ,p ,v)
+ ,(funcall setter
+ `(cons (setq ,p (cons ,k ,v))
+ ,getter)))))
+ (cond
+ ((null remove) set-exp)
+ ((or (eql v default)
+ (and (eq (car-safe v) 'quote)
+ (eq (car-safe default) 'quote)
+ (eql (cadr v) (cadr default))))
+ `(if ,p ,(funcall setter `(delq ,p ,getter))))
+ (t
+ `(cond
+ ((not (eql ,default ,v)) ,set-exp)
+ (,p ,(funcall setter
+ `(delq ,p ,getter)))))))))))))))
+
+
;;; Some occasionally handy extensions.
;; While several of the "places" below are not terribly useful for direct use,
@@ -479,22 +507,13 @@
;; … => (load "gv.el") => (macroexpand-all (defsubst gv-deref …)) =>
(macroexpand (defun …)) => (load "gv.el")
(gv-define-setter gv-deref (v ref) `(funcall (cdr ,ref) ,v))
-;;; Vaguely related definitions that should be moved elsewhere.
-
-;; (defun alist-get (key alist)
-;; "Get the value associated to KEY in ALIST."
-;; (declare
-;; (gv-expander
-;; (lambda (do)
-;; (macroexp-let2 macroexp-copyable-p k key
-;; (gv-letplace (getter setter) alist
-;; (macroexp-let2 nil p `(assoc ,k ,getter)
-;; (funcall do `(cdr ,p)
-;; (lambda (v)
-;; `(if ,p (setcdr ,p ,v)
-;; ,(funcall setter
-;; `(cons (cons ,k ,v) ,getter)))))))))))
-;; (cdr (assoc key alist)))
+;; (defmacro gv-letref (vars place &rest body)
+;; (declare (indent 2) (debug (sexp form &rest body)))
+;; (require 'cl-lib) ;Can't require cl-lib at top-level for bootstrap
reasons!
+;; (gv-letplace (getter setter) place
+;; `(cl-macrolet ((,(nth 0 vars) () ',getter)
+;; (,(nth 1 vars) (v) (funcall ',setter v)))
+;; ,@body)))
(provide 'gv)
;;; gv.el ends here
=== modified file 'lisp/files.el'
--- a/lisp/files.el 2014-09-29 18:14:08 +0000
+++ b/lisp/files.el 2014-10-01 17:23:42 +0000
@@ -3649,10 +3649,7 @@
* If the element is of the form (DIRECTORY . LIST), and DIRECTORY
is an initial substring of the file's directory, then LIST is
applied by recursively following these rules."
- (let ((elt (assq class dir-locals-class-alist)))
- (if elt
- (setcdr elt variables)
- (push (cons class variables) dir-locals-class-alist))))
+ (setf (alist-get class dir-locals-class-alist) variables))
(defconst dir-locals-file ".dir-locals.el"
"File that contains directory-local variables.
=== modified file 'lisp/frameset.el'
--- a/lisp/frameset.el 2014-03-27 17:34:22 +0000
+++ b/lisp/frameset.el 2014-10-01 17:23:42 +0000
@@ -664,10 +664,7 @@
;; Set the display parameter after filtering, so that filter functions
;; have access to its original value.
(when frameset--target-display
- (let ((display (assq 'display filtered)))
- (if display
- (setcdr display (cdr frameset--target-display))
- (push frameset--target-display filtered))))
+ (setf (alist-get 'display filtered) (cdr frameset--target-display)))
filtered))
=== modified file 'lisp/international/mule-cmds.el'
--- a/lisp/international/mule-cmds.el 2014-06-12 01:47:28 +0000
+++ b/lisp/international/mule-cmds.el 2014-10-01 17:23:42 +0000
@@ -2776,11 +2776,7 @@
(or (stringp table)
(error "Not a char-table nor a file name: %s" table)))
(if (stringp table) (setq table (purecopy table)))
- (let ((slot (assq name char-code-property-alist)))
- (if slot
- (setcdr slot table)
- (setq char-code-property-alist
- (cons (cons name table) char-code-property-alist))))
+ (setf (alist-get name char-code-property-alist) table)
(put name 'char-code-property-documentation (purecopy docstring)))
(defvar char-code-property-table
=== modified file 'lisp/progmodes/gud.el'
--- a/lisp/progmodes/gud.el 2014-09-03 04:21:40 +0000
+++ b/lisp/progmodes/gud.el 2014-10-01 17:23:42 +0000
@@ -256,9 +256,8 @@
([menu-bar file] . undefined))))
"Map used in visited files.")
-(let ((m (assq 'gud-minor-mode minor-mode-map-alist)))
- (if m (setcdr m gud-minor-mode-map)
- (push (cons 'gud-minor-mode gud-minor-mode-map) minor-mode-map-alist)))
+(setf (alist-get 'gud-minor-mode minor-mode-map-alist)
+ gud-minor-mode-map)
(defvar gud-mode-map
;; Will inherit from comint-mode via define-derived-mode.
=== modified file 'lisp/ps-print.el'
--- a/lisp/ps-print.el 2014-05-10 21:41:12 +0000
+++ b/lisp/ps-print.el 2014-10-01 17:23:42 +0000
@@ -3822,6 +3822,7 @@
(defun ps-get (alist-sym key)
"Return element from association list ALIST-SYM which car is `eq' to KEY."
+ (declare (obsolete alist-get "25.1"))
(assq key (symbol-value alist-sym)))
@@ -3829,6 +3830,7 @@
"Store element (KEY . VALUE) into association list ALIST-SYM.
If KEY already exists in ALIST-SYM, modify cdr to VALUE.
It can be retrieved with `(ps-get ALIST-SYM KEY)'."
+ (declare (obsolete "use (setf (alist-get ..) ..) instead" "25.1"))
(let ((elt: (assq key (symbol-value alist-sym)))) ; to avoid name conflict
(if elt:
(setcdr elt: value)
@@ -3839,6 +3841,7 @@
(defun ps-del (alist-sym key)
"Delete by side effect element KEY from association list ALIST-SYM."
+ (declare (obsolete "use (setf (alist-get k alist nil t) nil) instead"
"25.1"))
(let ((a:list: (symbol-value alist-sym)) ; to avoid name conflict
old)
(while a:list:
=== modified file 'lisp/register.el'
--- a/lisp/register.el 2014-09-14 23:11:52 +0000
+++ b/lisp/register.el 2014-10-01 17:23:42 +0000
@@ -33,6 +33,8 @@
;;; Code:
+;; FIXME: Clean up namespace usage!
+
(cl-defstruct
(registerv (:constructor nil)
(:constructor registerv--make (&optional data print-func
@@ -98,16 +100,12 @@
(defun get-register (register)
"Return contents of Emacs register named REGISTER, or nil if none."
- (cdr (assq register register-alist)))
+ (alist-get register register-alist))
(defun set-register (register value)
"Set contents of Emacs register named REGISTER to VALUE. Returns VALUE.
See the documentation of the variable `register-alist' for possible VALUEs."
- (let ((aelt (assq register register-alist)))
- (if aelt
- (setcdr aelt value)
- (push (cons register value) register-alist))
- value))
+ (setf (alist-get register register-alist) value))
(defun register-describe-oneline (c)
"One-line description of register C."
=== modified file 'lisp/ses.el'
--- a/lisp/ses.el 2014-09-30 17:52:11 +0000
+++ b/lisp/ses.el 2014-10-01 17:23:42 +0000
@@ -426,33 +426,6 @@
(ses-get-cell (car rowcol) (cdr rowcol)))))))
-(defun ses--alist-get (key alist &optional remove)
- "Get the value associated to KEY in ALIST."
- (declare
- (gv-expander
- (lambda (do)
- (macroexp-let2 macroexp-copyable-p k key
- (gv-letplace (getter setter) alist
- (macroexp-let2 nil p `(assq ,k ,getter)
- (funcall do `(cdr ,p)
- (lambda (v)
- (let ((set-exp
- `(if ,p (setcdr ,p ,v)
- ,(funcall setter
- `(cons (setq ,p (cons ,k ,v))
- ,getter)))))
- (cond
- ((null remove) set-exp)
- ((null v)
- `(if ,p ,(funcall setter `(delq ,p ,getter))))
- (t
- `(cond
- (,v ,set-exp)
- (,p ,(funcall setter
- `(delq ,p ,getter)))))))))))))))
- (ignore remove) ;;Silence byte-compiler.
- (cdr (assoc key alist)))
-
(defmacro ses--letref (vars place &rest body)
(declare (indent 2) (debug (sexp form &rest body)))
(gv-letplace (getter setter) place
@@ -467,18 +440,18 @@
present ROW and COL are the integer coordinates of the cell of
interest."
(declare (debug t))
- `(ses--alist-get ,property-name
- (ses-cell--properties
- ,(if col `(ses-get-cell ,row ,col) row))))
+ `(alist-get ,property-name
+ (ses-cell--properties
+ ,(if col `(ses-get-cell ,row ,col) row))))
(defmacro ses-cell-property-pop (property-name row &optional col)
"From a CELL or a pair (ROW,COL), get and remove the property value of
the corresponding cell with name PROPERTY-NAME."
`(ses--letref (pget pset)
- (ses--alist-get ,property-name
- (ses-cell--properties
- ,(if col `(ses-get-cell ,row ,col) row))
- t)
+ (alist-get ,property-name
+ (ses-cell--properties
+ ,(if col `(ses-get-cell ,row ,col) row))
+ nil t)
(prog1 (pget) (pset nil))))
(defmacro ses-cell-value (row &optional col)
=== modified file 'lisp/subr.el'
--- a/lisp/subr.el 2014-09-27 15:52:28 +0000
+++ b/lisp/subr.el 2014-10-01 17:23:42 +0000
@@ -555,6 +555,15 @@
(setq tail tail-cdr))))
alist)
+(defun alist-get (key alist &optional default remove)
+ "Get the value associated to KEY in ALIST.
+DEFAULT is the value to return if KEY is not found in ALIST.
+REMOVE, if non-nil, means that when setting this element, we should
+remove the entry if the new value is `eql' to DEFAULT."
+ (ignore remove) ;;Silence byte-compiler.
+ (let ((x (assq key alist)))
+ (if x (cdr x) default)))
+
(defun remove (elt seq)
"Return a copy of SEQ with all occurrences of ELT removed.
SEQ must be a list, vector, or string. The comparison is done with `equal'."
=== modified file 'lisp/tempo.el'
--- a/lisp/tempo.el 2014-03-01 02:31:05 +0000
+++ b/lisp/tempo.el 2014-10-01 17:23:42 +0000
@@ -611,11 +611,7 @@
string to match the tag against. It has the same definition as the
variable `tempo-match-finder'. In this version, supplying a
COMPLETION-FUNCTION just sets `tempo-match-finder' locally."
- (let ((old (assq tag-list tempo-local-tags)))
- (if old
- (setcdr old completion-function)
- (setq tempo-local-tags (cons (cons tag-list completion-function)
- tempo-local-tags))))
+ (setf (alist-get tag-list tempo-local-tags) completion-function)
(if completion-function
(setq tempo-match-finder completion-function))
(tempo-invalidate-collection))
=== modified file 'lisp/tooltip.el'
--- a/lisp/tooltip.el 2014-04-24 15:02:56 +0000
+++ b/lisp/tooltip.el 2014-10-01 17:23:42 +0000
@@ -215,11 +215,9 @@
"Change the value of KEY in alist ALIST to VALUE.
If there's no association for KEY in ALIST, add one, otherwise
change the existing association. Value is the resulting alist."
- (let ((param (assq key alist)))
- (if (consp param)
- (setcdr param value)
- (push (cons key value) alist))
- alist))
+ (declare (obsolete "use (setf (alist-get ..) ..) instead" "25.1"))
+ (setf (alist-get key alist) value)
+ alist)
(declare-function x-show-tip "xfns.c"
(string &optional frame parms timeout dx dy))
@@ -244,10 +242,10 @@
(fg (face-attribute 'tooltip :foreground))
(bg (face-attribute 'tooltip :background)))
(when (stringp fg)
- (setq params (tooltip-set-param params 'foreground-color fg))
- (setq params (tooltip-set-param params 'border-color fg)))
+ (setf (alist-get 'foreground-color params) fg)
+ (setf (alist-get 'border-color params) fg))
(when (stringp bg)
- (setq params (tooltip-set-param params 'background-color bg)))
+ (setf (alist-get 'background-color params) bg))
(x-show-tip (propertize text 'face 'tooltip)
(selected-frame)
params
=== modified file 'lisp/winner.el'
--- a/lisp/winner.el 2014-01-01 07:43:34 +0000
+++ b/lisp/winner.el 2014-10-01 17:23:42 +0000
@@ -112,10 +112,7 @@
;; Save current configuration.
;; (Called below by `winner-save-old-configurations').
(defun winner-remember ()
- (let ((entry (assq (selected-frame) winner-currents)))
- (if entry (setcdr entry (winner-conf))
- (push (cons (selected-frame) (winner-conf))
- winner-currents))))
+ (setf (alist-get (selected-frame) winner-currents) (winner-conf)))
;; Consult `winner-currents'.
(defun winner-configuration (&optional frame)
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] trunk r118000: * lisp/subr.el (alist-get): New accessor.,
Stefan Monnier <=