Escape ` and ' in doc

[gnu-emacs] / lisp / emacs-lisp / gv.el

diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index fae3bcb86f676b1521ff57766b512ee01da00a63..67609820a332e3e4350aa0fab059aea1e40fac1e 100644 (file)
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -74,6 +74,8 @@
 ;; (defvar gv--macro-environment nil
 ;;   "Macro expanders for generalized variables.")
 
+(define-error 'gv-invalid-place "%S is not a valid place expression")
+
 ;;;###autoload
 (defun gv-get (place do)
   "Build the code that applies DO to PLACE.
@@ -84,8 +86,10 @@ and SETTER is a function which returns the code to set PLACE when called
 with a (not necessarily copyable) Elisp expression that returns the value to
 set it to.
 DO must return an Elisp expression."
-  (if (symbolp place)
-      (funcall do place (lambda (v) `(setq ,place ,v)))
+  (cond
+   ((symbolp place) (funcall do place (lambda (v) `(setq ,place ,v))))
+   ((not (consp place)) (signal 'gv-invalid-place (list place)))
+   (t
     (let* ((head (car place))
            (gf (function-get head 'gv-expander 'autoload)))
       (if gf (apply gf do (cdr place))
@@ -104,8 +108,19 @@ DO must return an Elisp expression."
           (if (eq me place)
               (if (and (symbolp head) (get head 'setf-method))
                   (error "Incompatible place needs recompilation: %S" head)
-                (error "%S is not a valid place expression" place))
-            (gv-get me do)))))))
+                (let* ((setter (gv-setter head)))
+                  (gv--defsetter head (lambda (&rest args) `(,setter ,@args))
+                                 do (cdr place))))
+            (gv-get me do))))))))
+
+(defun gv-setter (name)
+  ;; The name taken from Scheme's SRFI-17.  Actually, for SRFI-17, the argument
+  ;; could/should be a function value rather than a symbol.
+  "Return the symbol where the (setf NAME) function should be placed."
+  (if (get name 'gv-expander)
+      (error "gv-expander conflicts with (setf %S)" name))
+  ;; FIXME: This is wrong if `name' is uninterned (or interned elsewhere).
+  (intern (format "(setf %s)" name)))
 
 ;;;###autoload
 (defmacro gv-letplace (vars place &rest body)
@@ -158,8 +173,10 @@ arguments as NAME.  DO is a function as defined in `gv-get'."
 
 ;;;###autoload
 (or (assq 'gv-expander defun-declarations-alist)
-    (push `(gv-expander ,(apply-partially #'gv--defun-declaration 'gv-expander))
-         defun-declarations-alist))
+    (let ((x `(gv-expander
+               ,(apply-partially #'gv--defun-declaration 'gv-expander))))
+      (push x macro-declarations-alist)
+      (push x defun-declarations-alist)))
 ;;;###autoload
 (or (assq 'gv-setter defun-declarations-alist)
     (push `(gv-setter ,(apply-partially #'gv--defun-declaration 'gv-setter))
@@ -201,7 +218,7 @@ return a Lisp form that does the assignment.
 The first arg in ARGLIST (the one that receives VAL) receives an expression
 which can do arbitrary things, whereas the other arguments are all guaranteed
 to be pure and copyable.  Example use:
-  (gv-define-setter aref (v a i) `(aset ,a ,i ,v))"
+  (gv-define-setter aref (v a i) \\=`(aset ,a ,i ,v))"
   (declare (indent 2) (debug (&define name sexp body)))
   `(gv-define-expander ,name
      (lambda (do &rest args)
@@ -222,7 +239,7 @@ instead the assignment is turned into something equivalent to
 so as to preserve the semantics of `setf'."
   (declare (debug (sexp (&or symbolp lambda-expr) &optional sexp)))
   (when (eq 'lambda (car-safe setter))
-    (message "Use `gv-define-setter' or name %s's setter function" name))
+    (message "Use ‘gv-define-setter’ or name %s's setter function" name))
   `(gv-define-setter ,name (val &rest args)
      ,(if fix-return
           `(macroexp-let2 nil v val
@@ -282,9 +299,9 @@ The return value is the last VAL in the list.
 ;; containing a non-trivial `push' even before gv.el was loaded.
 ;;;###autoload
 (put 'gv-place 'edebug-form-spec 'edebug-match-form)
+
 ;; CL did the equivalent of:
 ;;(gv-define-macroexpand edebug-after (lambda (before index place) place))
-
 (put 'edebug-after 'gv-expander
      (lambda (do before index place)
        (gv-letplace (getter setter) place
@@ -460,6 +477,32 @@ The return value is the last VAL in the list.
              (funcall do `(funcall (car ,gv))
                       (lambda (v) `(funcall (cdr ,gv) ,v))))))))
 
+(defmacro gv-synthetic-place (getter setter)
+  "Special place described by its setter and getter.
+GETTER and SETTER (typically obtained via `gv-letplace') get and
+set that place.  I.e. This macro allows you to do the \"reverse\" of what
+`gv-letplace' does.
+This macro only makes sense when used in a place."
+  (declare (gv-expander funcall))
+  (ignore setter)
+  getter)
+
+(defmacro gv-delay-error (place)
+  "Special place which delays the `gv-invalid-place' error to run-time.
+It behaves just like PLACE except that in case PLACE is not a valid place,
+the `gv-invalid-place' error will only be signaled at run-time when (and if)
+we try to use the setter.
+This macro only makes sense when used in a place."
+  (declare
+   (gv-expander
+    (lambda (do)
+      (condition-case err
+          (gv-get place do)
+        (gv-invalid-place
+         ;; Delay the error until we try to use the setter.
+         (funcall do place (lambda (_) `(signal ',(car err) ',(cdr err)))))))))
+  place)
+
 ;;; Even more debatable extensions.
 
 (put 'cons 'gv-expander