chiark / gitweb /
dot/ercrc.el: Hack `mdw-pushnew-replace' for newer Emacsen.
authorMark Wooding <mdw@distorted.org.uk>
Tue, 1 Aug 2017 14:25:11 +0000 (15:25 +0100)
committerMark Wooding <mdw@distorted.org.uk>
Tue, 1 Aug 2017 14:28:37 +0000 (15:28 +0100)
Irritatingly, Emacs 24's `cl' has entirely different generalized-
variable support and it's not even slightly compatible.  Fortunately,
the new thing is much simpler.

Factor out the calculation into a function, and modify the macro to pick
the right way to do the plumbing.

dot/ercrc.el

index a5390103cd4baccc2482e7487bce061f4d6dc526..d035c64d4ec37ad5fc1ff2592d6d642edf19f591 100644 (file)
@@ -61,27 +61,30 @@ (defun mdw-remprop-nondestructive (indic plist)
        (cdr head))
     plist))
 
        (cdr head))
     plist))
 
-(defmacro* mdw-pushnew-replace
-    (item place &rest keys &key (key '#'identity) &allow-other-keys)
+(defun* mdw-cons-replace
+    (item list &rest keys &key (key '#'identity) &allow-other-keys)
+  "Return LIST, with ITEM at the start, replacing any existing matching item.
+Specifically, any item in the list satisfying the test are removed
+\(nondestructively), and then the new ITEM is added to the front."
+  (cons item (apply #'remove* (funcall key item) list :key key
+                   (mdw-remprop-nondestructive :key keys))))
+
+(defmacro* mdw-pushnew-replace (item place &rest keys)
   "Add ITEM to the list PLACE, replacing any existing matching item.
 Specifically, any item in the list satisfying the test are removed
 \(nondestructively), and then the new ITEM is added to the front.
 
 Evaluation order for the keywords is a bit screwy: don't rely on it."
   "Add ITEM to the list PLACE, replacing any existing matching item.
 Specifically, any item in the list satisfying the test are removed
 \(nondestructively), and then the new ITEM is added to the front.
 
 Evaluation order for the keywords is a bit screwy: don't rely on it."
-  ;; `cl-setf-do-modify' returns a list (LETS STORE FETCH).
-  (let ((setf-things (cl-setf-do-modify place (cons 'list keys)))
-       (keyfn (gensym "key"))
-       (itemvar (gensym "item")))
-    `(let ((,keyfn ,key)
-          (,itemvar ,item)
-          ,@(car setf-things))
-       ,(cl-setf-do-store (cadr setf-things)
-                         `(cons ,itemvar
-                                (remove* (funcall ,keyfn ,itemvar)
-                                         ,(caddr setf-things)
-                                         :key ,keyfn
-                                         ,@(mdw-remprop-nondestructive
-                                            :key keys)))))))
+  (cond ((fboundp 'cl-callf2)
+        `(cl-callf2 mdw-cons-replace ,item ,place ,@keys))
+       ((fboundp 'cl-setf-do-modify)
+        ;; `cl-setf-do-modify' returns a list (LETS STORE FETCH).
+        (let ((setf-things (cl-setf-do-modify place (cons 'list keys))))
+          `(let (,@(car setf-things))
+             ,(cl-setf-do-store (cadr setf-things)
+                                `(mdw-cons-replace ,item ,place
+                                                   ,@keys)))))
+       (t (error "Don't know how to hack places on this Emacs."))))
 
 (defun mdw-define-bot-greeting (server bot greeting)
   "Define a new bot greeting."
 
 (defun mdw-define-bot-greeting (server bot greeting)
   "Define a new bot greeting."