* 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.

18 files changed, 104 insertions, 100 deletions

diff --git a/admin/ChangeLog b/admin/ChangeLog
index 4ebf97d3163..cd5f08989fc 100644
--- a/admin/ChangeLog
+++ b/admin/ChangeLog
@@ -1,3 +1,8 @@
+2014-10-01  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * unidata/unidata-gen.el (unidata-gen-table-word-list): Use alist-get
+        and cl-incf.
+
 2014-09-08  Eli Zaretskii  <eliz@gnu.org>
 
         * unidata/unidata-gen.el (unidata-check): Bring this function up
diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el
index fb9b6dccc72..ec4f9d154d2 100644
--- a/admin/unidata/unidata-gen.el
+++ b/admin/unidata/unidata-gen.el
@@ -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 @@ is the character itself.")))
               (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)))))
diff --git a/etc/NEWS b/etc/NEWS
index 59842fa7eee..8c2b64b14fc 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -245,6 +245,8 @@ Emacs-21.
 *** 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.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index b1e510b6f7d..ea8587e40a4 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,20 @@
+2014-10-01  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * 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  <ulf.jasper@web.de>
 
         * 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
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el
index 30a06a2aa00..156bf4cd0db 100644
--- a/lisp/calc/calc-prog.el
+++ b/lisp/calc/calc-prog.el
@@ -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))))))))
diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el
index 8d182372cfb..9781d4174f5 100644
--- a/lisp/calc/calc-yank.el
+++ b/lisp/calc/calc-yank.el
@@ -143,10 +143,7 @@ TEXT and CALCVAL are the TEXT and internal structure of stack entries.")
   "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,
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index 692b76e8a36..229ad275bf5 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -357,6 +357,34 @@ The return value is the last VAL in the list.
   (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 @@ REF must have been previously obtained with `gv-ref'."
 ;;  … => (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
diff --git a/lisp/files.el b/lisp/files.el
index 5d1276f261e..f360c1342d6 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -3649,10 +3649,7 @@ VARIABLES list of the class.  The list is processed in order.
 * 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.
diff --git a/lisp/frameset.el b/lisp/frameset.el
index b943d47e7bf..f8436259df0 100644
--- a/lisp/frameset.el
+++ b/lisp/frameset.el
@@ -664,10 +664,7 @@ nil while the filtering is done to restore it."
     ;; 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))
 
 
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index f6c0719e4c4..61ecc8b702a 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -2776,11 +2776,7 @@ See also the documentation of `get-char-code-property' and
     (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
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index a2e015fd287..24d5469adc3 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -256,9 +256,8 @@ Used to gray out relevant toolbar icons.")
        ([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.
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index 83f2cde4010..28682f52b0e 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -3822,6 +3822,7 @@ If `ps-prefix-quote' is nil, it's set to t after generating string."
 
 (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 @@ If `ps-prefix-quote' is nil, it's set to t after generating string."
   "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 @@ It can be retrieved with `(ps-get ALIST-SYM KEY)'."
 
 (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:
diff --git a/lisp/register.el b/lisp/register.el
index ffa3c954ed2..24146065384 100644
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -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 @@ If nil, do not show register previews, unless `help-char' (or a member of
 
 (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."
diff --git a/lisp/ses.el b/lisp/ses.el
index ffd844d06bf..541c1e19769 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -426,33 +426,6 @@ functions refer to its value."
                        (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 @@ When COL is omitted, CELL=ROW is a cell object.  When COL is
 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)
diff --git a/lisp/subr.el b/lisp/subr.el
index 2bbc01d4533..581e52e8f9d 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -555,6 +555,15 @@ Elements of ALIST that are not conses are ignored."
         (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'."
diff --git a/lisp/tempo.el b/lisp/tempo.el
index 9b6cd75b313..15be01dcdf9 100644
--- a/lisp/tempo.el
+++ b/lisp/tempo.el
@@ -611,11 +611,7 @@ function or string that is used by `\\[tempo-complete-tag]' to find a
 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))
diff --git a/lisp/tooltip.el b/lisp/tooltip.el
index 9d0954fc5dc..26cce418e45 100644
--- a/lisp/tooltip.el
+++ b/lisp/tooltip.el
@@ -215,11 +215,9 @@ This might return nil if the event did not occur over a buffer."
   "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 @@ in echo area."
               (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
diff --git a/lisp/winner.el b/lisp/winner.el
index 1e32a7f4085..c202402a6e9 100644
--- a/lisp/winner.el
+++ b/lisp/winner.el
@@ -112,10 +112,7 @@ You may want to include buffer names such as *Help*, *Apropos*,
 ;; 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)