* 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.
+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
;; 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.
(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)))))
*** 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.
+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
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
"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))))))))
(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)))))))
(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))))))))
"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,
(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,
;; … => (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
* 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.
;; 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))
\f
(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
([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.
(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)))
"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)
(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:
;;; Code:
+;; FIXME: Clean up namespace usage!
+
(cl-defstruct
(registerv (:constructor nil)
(:constructor registerv--make (&optional data print-func
(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."
(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
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)
(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'."
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))
"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))
(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
;; 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)
projects / emacs.git / commitdiff