mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-06 22:41:06 -08:00
This reverts almost all my recent changes to use curved quotes in docstrings and/or strings used for error diagnostics. There are a few exceptions, e.g., Bahá’í proper names. * admin/unidata/unidata-gen.el (unidata-gen-table): * lisp/abbrev.el (expand-region-abbrevs): * lisp/align.el (align-region): * lisp/allout.el (allout-mode, allout-solicit-alternate-bullet) (outlineify-sticky): * lisp/apropos.el (apropos-library): * lisp/bookmark.el (bookmark-default-annotation-text): * lisp/button.el (button-category-symbol, button-put) (make-text-button): * lisp/calc/calc-aent.el (math-read-if, math-read-factor): * lisp/calc/calc-embed.el (calc-do-embedded): * lisp/calc/calc-ext.el (calc-user-function-list): * lisp/calc/calc-graph.el (calc-graph-show-dumb): * lisp/calc/calc-help.el (calc-describe-key) (calc-describe-thing, calc-full-help): * lisp/calc/calc-lang.el (calc-c-language) (math-parse-fortran-vector-end, math-parse-tex-sum) (math-parse-eqn-matrix, math-parse-eqn-prime) (calc-yacas-language, calc-maxima-language, calc-giac-language) (math-read-giac-subscr, math-read-math-subscr) (math-read-big-rec, math-read-big-balance): * lisp/calc/calc-misc.el (calc-help, report-calc-bug): * lisp/calc/calc-mode.el (calc-auto-why, calc-save-modes) (calc-auto-recompute): * lisp/calc/calc-prog.el (calc-fix-token-name) (calc-read-parse-table-part, calc-user-define-invocation) (math-do-arg-check): * lisp/calc/calc-store.el (calc-edit-variable): * lisp/calc/calc-units.el (math-build-units-table-buffer): * lisp/calc/calc-vec.el (math-read-brackets): * lisp/calc/calc-yank.el (calc-edit-mode): * lisp/calc/calc.el (calc, calc-do, calc-user-invocation): * lisp/calendar/appt.el (appt-display-message): * lisp/calendar/diary-lib.el (diary-check-diary-file) (diary-mail-entries, diary-from-outlook): * lisp/calendar/icalendar.el (icalendar-export-region) (icalendar--convert-float-to-ical) (icalendar--convert-date-to-ical) (icalendar--convert-ical-to-diary) (icalendar--convert-recurring-to-diary) (icalendar--add-diary-entry): * lisp/calendar/time-date.el (format-seconds): * lisp/calendar/timeclock.el (timeclock-mode-line-display) (timeclock-make-hours-explicit, timeclock-log-data): * lisp/calendar/todo-mode.el (todo-prefix, todo-delete-category) (todo-item-mark, todo-check-format) (todo-insert-item--next-param, todo-edit-item--next-key) (todo-mode): * lisp/cedet/ede/pmake.el (ede-proj-makefile-insert-dist-rules): * lisp/cedet/mode-local.el (describe-mode-local-overload) (mode-local-print-binding, mode-local-describe-bindings-2): * lisp/cedet/semantic/complete.el (semantic-displayor-show-request): * lisp/cedet/srecode/srt-mode.el (srecode-macro-help): * lisp/cus-start.el (standard): * lisp/cus-theme.el (describe-theme-1): * lisp/custom.el (custom-add-dependencies, custom-check-theme) (custom--sort-vars-1, load-theme): * lisp/descr-text.el (describe-text-properties-1, describe-char): * lisp/dired-x.el (dired-do-run-mail): * lisp/dired.el (dired-log): * lisp/emacs-lisp/advice.el (ad-read-advised-function) (ad-read-advice-class, ad-read-advice-name, ad-enable-advice) (ad-disable-advice, ad-remove-advice, ad-set-argument) (ad-set-arguments, ad--defalias-fset, ad-activate) (ad-deactivate): * lisp/emacs-lisp/byte-opt.el (byte-compile-inline-expand) (byte-compile-unfold-lambda, byte-optimize-form-code-walker) (byte-optimize-while, byte-optimize-apply): * lisp/emacs-lisp/byte-run.el (defun, defsubst): * lisp/emacs-lisp/bytecomp.el (byte-compile-lapcode) (byte-compile-log-file, byte-compile-format-warn) (byte-compile-nogroup-warn, byte-compile-arglist-warn) (byte-compile-cl-warn) (byte-compile-warn-about-unresolved-functions) (byte-compile-file, byte-compile--declare-var) (byte-compile-file-form-defmumble, byte-compile-form) (byte-compile-normal-call, byte-compile-check-variable) (byte-compile-variable-ref, byte-compile-variable-set) (byte-compile-subr-wrong-args, byte-compile-setq-default) (byte-compile-negation-optimizer) (byte-compile-condition-case--old) (byte-compile-condition-case--new, byte-compile-save-excursion) (byte-compile-defvar, byte-compile-autoload) (byte-compile-lambda-form) (byte-compile-make-variable-buffer-local, display-call-tree) (batch-byte-compile): * lisp/emacs-lisp/cconv.el (cconv-convert, cconv--analyze-use): * lisp/emacs-lisp/chart.el (chart-space-usage): * lisp/emacs-lisp/check-declare.el (check-declare-scan) (check-declare-warn, check-declare-file) (check-declare-directory): * lisp/emacs-lisp/checkdoc.el (checkdoc-this-string-valid-engine) (checkdoc-message-text-engine): * lisp/emacs-lisp/cl-extra.el (cl-parse-integer) (cl--describe-class): * lisp/emacs-lisp/cl-generic.el (cl-defgeneric) (cl--generic-describe, cl-generic-generalizers): * lisp/emacs-lisp/cl-macs.el (cl--parse-loop-clause, cl-tagbody) (cl-symbol-macrolet): * lisp/emacs-lisp/cl.el (cl-unload-function, flet): * lisp/emacs-lisp/copyright.el (copyright) (copyright-update-directory): * lisp/emacs-lisp/edebug.el (edebug-read-list): * lisp/emacs-lisp/eieio-base.el (eieio-persistent-read): * lisp/emacs-lisp/eieio-core.el (eieio--slot-override) (eieio-oref): * lisp/emacs-lisp/eieio-opt.el (eieio-help-constructor): * lisp/emacs-lisp/eieio-speedbar.el: (eieio-speedbar-child-make-tag-lines) (eieio-speedbar-child-description): * lisp/emacs-lisp/eieio.el (defclass, change-class): * lisp/emacs-lisp/elint.el (elint-file, elint-get-top-forms) (elint-init-form, elint-check-defalias-form) (elint-check-let-form): * lisp/emacs-lisp/ert.el (ert-get-test, ert-results-mode-menu) (ert-results-pop-to-backtrace-for-test-at-point) (ert-results-pop-to-messages-for-test-at-point) (ert-results-pop-to-should-forms-for-test-at-point) (ert-describe-test): * lisp/emacs-lisp/find-func.el (find-function-search-for-symbol) (find-function-library): * lisp/emacs-lisp/generator.el (iter-yield): * lisp/emacs-lisp/gv.el (gv-define-simple-setter): * lisp/emacs-lisp/lisp-mnt.el (lm-verify): * lisp/emacs-lisp/macroexp.el (macroexp--obsolete-warning): * lisp/emacs-lisp/map-ynp.el (map-y-or-n-p): * lisp/emacs-lisp/nadvice.el (advice--make-docstring) (advice--make, define-advice): * lisp/emacs-lisp/package-x.el (package-upload-file): * lisp/emacs-lisp/package.el (package-version-join) (package-disabled-p, package-activate-1, package-activate) (package--download-one-archive) (package--download-and-read-archives) (package-compute-transaction, package-install-from-archive) (package-install, package-install-selected-packages) (package-delete, package-autoremove, describe-package-1) (package-install-button-action, package-delete-button-action) (package-menu-hide-package, package-menu--list-to-prompt) (package-menu--perform-transaction) (package-menu--find-and-notify-upgrades): * lisp/emacs-lisp/pcase.el (pcase-exhaustive, pcase--u1): * lisp/emacs-lisp/re-builder.el (reb-enter-subexp-mode): * lisp/emacs-lisp/ring.el (ring-previous, ring-next): * lisp/emacs-lisp/rx.el (rx-check, rx-anything) (rx-check-any-string, rx-check-any, rx-check-not, rx-=) (rx-repeat, rx-check-backref, rx-syntax, rx-check-category) (rx-form): * lisp/emacs-lisp/smie.el (smie-config-save): * lisp/emacs-lisp/subr-x.el (internal--check-binding): * lisp/emacs-lisp/tabulated-list.el (tabulated-list-put-tag): * lisp/emacs-lisp/testcover.el (testcover-1value): * lisp/emacs-lisp/timer.el (timer-event-handler): * lisp/emulation/viper-cmd.el (viper-toggle-parse-sexp-ignore-comments) (viper-toggle-search-style, viper-kill-buffer) (viper-brac-function): * lisp/emulation/viper-macs.el (viper-record-kbd-macro): * lisp/env.el (setenv): * lisp/erc/erc-button.el (erc-nick-popup): * lisp/erc/erc.el (erc-cmd-LOAD, erc-handle-login, english): * lisp/eshell/em-dirs.el (eshell/cd): * lisp/eshell/em-glob.el (eshell-glob-regexp) (eshell-glob-entries): * lisp/eshell/em-pred.el (eshell-parse-modifiers): * lisp/eshell/esh-opt.el (eshell-show-usage): * lisp/facemenu.el (facemenu-add-new-face) (facemenu-add-new-color): * lisp/faces.el (read-face-name, read-face-font, describe-face) (x-resolve-font-name): * lisp/files-x.el (modify-file-local-variable): * lisp/files.el (locate-user-emacs-file, find-alternate-file) (set-auto-mode, hack-one-local-variable--obsolete) (dir-locals-set-directory-class, write-file, basic-save-buffer) (delete-directory, copy-directory, recover-session) (recover-session-finish, insert-directory) (file-modes-char-to-who, file-modes-symbolic-to-number) (move-file-to-trash): * lisp/filesets.el (filesets-add-buffer, filesets-remove-buffer): * lisp/find-cmd.el (find-generic, find-to-string): * lisp/finder.el (finder-commentary): * lisp/font-lock.el (font-lock-fontify-buffer): * lisp/format.el (format-write-file, format-find-file) (format-insert-file): * lisp/frame.el (get-device-terminal, select-frame-by-name): * lisp/fringe.el (fringe--check-style): * lisp/gnus/nnmairix.el (nnmairix-widget-create-query): * lisp/help-fns.el (help-fns--key-bindings) (help-fns--compiler-macro, help-fns--parent-mode) (help-fns--obsolete, help-fns--interactive-only) (describe-function-1, describe-variable): * lisp/help.el (describe-mode) (describe-minor-mode-from-indicator): * lisp/image.el (image-type): * lisp/international/ccl.el (ccl-dump): * lisp/international/fontset.el (x-must-resolve-font-name): * lisp/international/mule-cmds.el (prefer-coding-system) (select-safe-coding-system-interactively) (select-safe-coding-system, activate-input-method) (toggle-input-method, describe-current-input-method) (describe-language-environment): * lisp/international/mule-conf.el (code-offset): * lisp/international/mule-diag.el (describe-character-set) (list-input-methods-1): * lisp/mail/feedmail.el (feedmail-run-the-queue): * lisp/mouse.el (minor-mode-menu-from-indicator): * lisp/mpc.el (mpc-playlist-rename): * lisp/msb.el (msb--choose-menu): * lisp/net/ange-ftp.el (ange-ftp-shell-command): * lisp/net/imap.el (imap-interactive-login): * lisp/net/mairix.el (mairix-widget-create-query): * lisp/net/newst-backend.el (newsticker--sentinel-work): * lisp/net/newst-treeview.el (newsticker--treeview-load): * lisp/net/rlogin.el (rlogin): * lisp/obsolete/iswitchb.el (iswitchb-possible-new-buffer): * lisp/obsolete/otodo-mode.el (todo-more-important-p): * lisp/obsolete/pgg-gpg.el (pgg-gpg-process-region): * lisp/obsolete/pgg-pgp.el (pgg-pgp-process-region): * lisp/obsolete/pgg-pgp5.el (pgg-pgp5-process-region): * lisp/org/ob-core.el (org-babel-goto-named-src-block) (org-babel-goto-named-result): * lisp/org/ob-fortran.el (org-babel-fortran-ensure-main-wrap): * lisp/org/ob-ref.el (org-babel-ref-resolve): * lisp/org/org-agenda.el (org-agenda-prepare): * lisp/org/org-clock.el (org-clock-notify-once-if-expired) (org-clock-resolve): * lisp/org/org-ctags.el (org-ctags-ask-rebuild-tags-file-then-find-tag): * lisp/org/org-feed.el (org-feed-parse-atom-entry): * lisp/org/org-habit.el (org-habit-parse-todo): * lisp/org/org-mouse.el (org-mouse-popup-global-menu) (org-mouse-context-menu): * lisp/org/org-table.el (org-table-edit-formulas): * lisp/org/ox.el (org-export-async-start): * lisp/proced.el (proced-log): * lisp/progmodes/ada-mode.el (ada-get-indent-case) (ada-check-matching-start, ada-goto-matching-start): * lisp/progmodes/ada-prj.el (ada-prj-display-page): * lisp/progmodes/ada-xref.el (ada-find-executable): * lisp/progmodes/ebrowse.el (ebrowse-tags-apropos): * lisp/progmodes/etags.el (etags-tags-apropos-additional): * lisp/progmodes/flymake.el (flymake-parse-err-lines) (flymake-start-syntax-check-process): * lisp/progmodes/python.el (python-shell-get-process-or-error) (python-define-auxiliary-skeleton): * lisp/progmodes/sql.el (sql-comint): * lisp/progmodes/verilog-mode.el (verilog-load-file-at-point): * lisp/progmodes/vhdl-mode.el (vhdl-widget-directory-validate): * lisp/recentf.el (recentf-open-files): * lisp/replace.el (query-replace-read-from) (occur-after-change-function, occur-1): * lisp/scroll-bar.el (scroll-bar-columns): * lisp/server.el (server-get-auth-key): * lisp/simple.el (execute-extended-command) (undo-outer-limit-truncate, list-processes--refresh) (compose-mail, set-variable, choose-completion-string) (define-alternatives): * lisp/startup.el (site-run-file, tty-handle-args, command-line) (command-line-1): * lisp/subr.el (noreturn, define-error, add-to-list) (read-char-choice, version-to-list): * lisp/term/common-win.el (x-handle-xrm-switch) (x-handle-name-switch, x-handle-args): * lisp/term/x-win.el (x-handle-parent-id, x-handle-smid): * lisp/textmodes/reftex-ref.el (reftex-label): * lisp/textmodes/reftex-toc.el (reftex-toc-rename-label): * lisp/textmodes/two-column.el (2C-split): * lisp/tutorial.el (tutorial--describe-nonstandard-key) (tutorial--find-changed-keys): * lisp/type-break.el (type-break-noninteractive-query): * lisp/wdired.el (wdired-do-renames, wdired-do-symlink-changes) (wdired-do-perm-changes): * lisp/whitespace.el (whitespace-report-region): Prefer grave quoting in source-code strings used to generate help and diagnostics. * lisp/faces.el (face-documentation): No need to convert quotes, since the result is a docstring. * lisp/info.el (Info-virtual-index-find-node) (Info-virtual-index, info-apropos): Simplify by generating only curved quotes, since info files are typically that ways nowadays anyway. * lisp/international/mule-diag.el (list-input-methods): Don’t assume text quoting style is curved. * lisp/org/org-bibtex.el (org-bibtex-fields): Revert my recent changes, going back to the old quoting style.
573 lines
25 KiB
EmacsLisp
573 lines
25 KiB
EmacsLisp
;;; gv.el --- generalized variables -*- lexical-binding: t -*-
|
|
|
|
;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
|
|
|
|
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
|
|
;; Keywords: extensions
|
|
;; Package: emacs
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; This is a re-implementation of the setf machinery using a different
|
|
;; underlying approach than the one used earlier in CL, which was based on
|
|
;; define-setf-expander.
|
|
;; `define-setf-expander' makes every "place-expander" return a 5-tuple
|
|
;; (VARS VALUES STORES GETTER SETTER)
|
|
;; where STORES is a list with a single variable (Common-Lisp allows multiple
|
|
;; variables for use with multiple-return-values, but this is rarely used and
|
|
;; not applicable to Elisp).
|
|
;; It basically says that GETTER is an expression that returns the place's
|
|
;; value, and (lambda STORES SETTER) is an expression that assigns the value(s)
|
|
;; passed to that function to the place, and that you need to wrap the whole
|
|
;; thing within a `(let* ,(zip VARS VALUES) ...).
|
|
;;
|
|
;; Instead, we use here a higher-order approach: instead
|
|
;; of a 5-tuple, a place-expander returns a function.
|
|
;; If you think about types, the old approach return things of type
|
|
;; {vars: List Var, values: List Exp,
|
|
;; stores: List Var, getter: Exp, setter: Exp}
|
|
;; whereas the new approach returns a function of type
|
|
;; (do: ((getter: Exp, setter: ((store: Exp) -> Exp)) -> Exp)) -> Exp.
|
|
;; You can get the new function from the old 5-tuple with something like:
|
|
;; (lambda (do)
|
|
;; `(let* ,(zip VARS VALUES)
|
|
;; (funcall do GETTER (lambda ,STORES ,SETTER))))
|
|
;; You can't easily do the reverse, because this new approach is more
|
|
;; expressive than the old one, so we can't provide a backward-compatible
|
|
;; get-setf-method.
|
|
;;
|
|
;; While it may seem intimidating for people not used to higher-order
|
|
;; functions, you will quickly see that its use (especially with the
|
|
;; `gv-letplace' macro) is actually much easier and more elegant than the old
|
|
;; approach which is clunky and often leads to unreadable code.
|
|
|
|
;; Food for thought: the syntax of places does not actually conflict with the
|
|
;; pcase patterns. The `cons' gv works just like a `(,a . ,b) pcase
|
|
;; pattern, and actually the `logand' gv is even closer since it should
|
|
;; arguably fail when trying to set a value outside of the mask.
|
|
;; Generally, places are used for destructors (gethash, aref, car, ...)
|
|
;; whereas pcase patterns are used for constructors (backquote, constants,
|
|
;; vectors, ...).
|
|
|
|
;;; Code:
|
|
|
|
(require 'macroexp)
|
|
|
|
;; What we call a "gvar" is basically a function of type "(getter * setter ->
|
|
;; code) -> code", where "getter" is code and setter is "code -> code".
|
|
|
|
;; (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.
|
|
PLACE must be a valid generalized variable.
|
|
DO must be a function; it will be called with 2 arguments: GETTER and SETTER,
|
|
where GETTER is a (copyable) Elisp expression that returns the value of PLACE,
|
|
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."
|
|
(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))
|
|
(let ((me (macroexpand-1 place
|
|
;; (append macroexpand-all-environment
|
|
;; gv--macro-environment)
|
|
macroexpand-all-environment)))
|
|
(if (and (eq me place) (get head 'compiler-macro))
|
|
;; Expand compiler macros: this takes care of all the accessors
|
|
;; defined via cl-defsubst, such as cXXXr and defstruct slots.
|
|
(setq me (apply (get head 'compiler-macro) place (cdr place))))
|
|
(if (and (eq me place) (fboundp head)
|
|
(symbolp (symbol-function head)))
|
|
;; Follow aliases.
|
|
(setq me (cons (symbol-function head) (cdr place))))
|
|
(if (eq me place)
|
|
(if (and (symbolp head) (get head 'setf-method))
|
|
(error "Incompatible place needs recompilation: %S" head)
|
|
(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)
|
|
"Build the code manipulating the generalized variable PLACE.
|
|
GETTER will be bound to a copyable expression that returns the value
|
|
of PLACE.
|
|
SETTER will be bound to a function that takes an expression V and returns
|
|
a new expression that sets PLACE to V.
|
|
BODY should return some Elisp expression E manipulating PLACE via GETTER
|
|
and SETTER.
|
|
The returned value will then be an Elisp expression that first evaluates
|
|
all the parts of PLACE that can be evaluated and then runs E.
|
|
|
|
\(fn (GETTER SETTER) PLACE &rest BODY)"
|
|
(declare (indent 2) (debug (sexp form body)))
|
|
`(gv-get ,place (lambda ,vars ,@body)))
|
|
|
|
;; Different ways to declare a generalized variable.
|
|
;;;###autoload
|
|
(defmacro gv-define-expander (name handler)
|
|
"Use HANDLER to handle NAME as a generalized var.
|
|
NAME is a symbol: the name of a function, macro, or special form.
|
|
HANDLER is a function which takes an argument DO followed by the same
|
|
arguments as NAME. DO is a function as defined in `gv-get'."
|
|
(declare (indent 1) (debug (sexp form)))
|
|
;; Use eval-and-compile so the method can be used in the same file as it
|
|
;; is defined.
|
|
;; FIXME: Just like byte-compile-macro-environment, we should have something
|
|
;; like byte-compile-symbolprop-environment so as to handle these things
|
|
;; cleanly without affecting the running Emacs.
|
|
`(eval-and-compile (put ',name 'gv-expander ,handler)))
|
|
|
|
;;;###autoload
|
|
(defun gv--defun-declaration (symbol name args handler &optional fix)
|
|
`(progn
|
|
;; No need to autoload this part, since gv-get will auto-load the
|
|
;; function's definition before checking the `gv-expander' property.
|
|
:autoload-end
|
|
,(pcase (cons symbol handler)
|
|
(`(gv-expander . (lambda (,do) . ,body))
|
|
`(gv-define-expander ,name (lambda (,do ,@args) ,@body)))
|
|
(`(gv-expander . ,(pred symbolp))
|
|
`(gv-define-expander ,name #',handler))
|
|
(`(gv-setter . (lambda (,store) . ,body))
|
|
`(gv-define-setter ,name (,store ,@args) ,@body))
|
|
(`(gv-setter . ,(pred symbolp))
|
|
`(gv-define-simple-setter ,name ,handler ,fix))
|
|
;; (`(expand ,expander) `(gv-define-expand ,name ,expander))
|
|
(_ (message "Unknown %s declaration %S" symbol handler) nil))))
|
|
|
|
;;;###autoload
|
|
(or (assq '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))
|
|
defun-declarations-alist))
|
|
|
|
;; (defmacro gv-define-expand (name expander)
|
|
;; "Use EXPANDER to handle NAME as a generalized var.
|
|
;; NAME is a symbol: the name of a function, macro, or special form.
|
|
;; EXPANDER is a function that will be called as a macro-expander to reduce
|
|
;; uses of NAME to some other generalized variable."
|
|
;; (declare (debug (sexp form)))
|
|
;; `(eval-and-compile
|
|
;; (if (not (boundp 'gv--macro-environment))
|
|
;; (setq gv--macro-environment nil))
|
|
;; (push (cons ',name ,expander) gv--macro-environment)))
|
|
|
|
(defun gv--defsetter (name setter do args &optional vars)
|
|
"Helper function used by code generated by `gv-define-setter'.
|
|
NAME is the name of the getter function.
|
|
SETTER is a function that generates the code for the setter.
|
|
NAME accept ARGS as arguments and SETTER accepts (NEWVAL . ARGS).
|
|
VARS is used internally for recursive calls."
|
|
(if (null args)
|
|
(let ((vars (nreverse vars)))
|
|
(funcall do `(,name ,@vars) (lambda (v) (apply setter v vars))))
|
|
;; FIXME: Often it would be OK to skip this `let', but in general,
|
|
;; `do' may have all kinds of side-effects.
|
|
(macroexp-let2 nil v (car args)
|
|
(gv--defsetter name setter do (cdr args) (cons v vars)))))
|
|
|
|
;;;###autoload
|
|
(defmacro gv-define-setter (name arglist &rest body)
|
|
"Define a setter method for generalized variable NAME.
|
|
This macro is an easy-to-use substitute for `gv-define-expander' that works
|
|
well for simple place forms.
|
|
Assignments of VAL to (NAME ARGS...) are expanded by binding the argument
|
|
forms (VAL ARGS...) according to ARGLIST, then executing BODY, which must
|
|
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))"
|
|
(declare (indent 2) (debug (&define name sexp body)))
|
|
`(gv-define-expander ,name
|
|
(lambda (do &rest args)
|
|
(gv--defsetter ',name (lambda ,arglist ,@body) do args))))
|
|
|
|
;;;###autoload
|
|
(defmacro gv-define-simple-setter (name setter &optional fix-return)
|
|
"Define a simple setter method for generalized variable NAME.
|
|
This macro is an easy-to-use substitute for `gv-define-expander' that works
|
|
well for simple place forms. Assignments of VAL to (NAME ARGS...) are
|
|
turned into calls of the form (SETTER ARGS... VAL).
|
|
|
|
If FIX-RETURN is non-nil, then SETTER is not assumed to return VAL and
|
|
instead the assignment is turned into something equivalent to
|
|
\(let ((temp VAL))
|
|
(SETTER ARGS... temp)
|
|
temp)
|
|
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))
|
|
`(gv-define-setter ,name (val &rest args)
|
|
,(if fix-return
|
|
`(macroexp-let2 nil v val
|
|
`(progn
|
|
(,',setter ,@args ,v)
|
|
,v))
|
|
``(,',setter ,@args ,val))))
|
|
|
|
;;; Typical operations on generalized variables.
|
|
|
|
;;;###autoload
|
|
(defmacro setf (&rest args)
|
|
"Set each PLACE to the value of its VAL.
|
|
This is a generalized version of `setq'; the PLACEs may be symbolic
|
|
references such as (car x) or (aref x i), as well as plain symbols.
|
|
For example, (setf (cadr x) y) is equivalent to (setcar (cdr x) y).
|
|
The return value is the last VAL in the list.
|
|
|
|
\(fn PLACE VAL PLACE VAL ...)"
|
|
(declare (debug (&rest [gv-place form])))
|
|
(if (and args (null (cddr args)))
|
|
(let ((place (pop args))
|
|
(val (car args)))
|
|
(gv-letplace (_getter setter) place
|
|
(funcall setter val)))
|
|
(let ((sets nil))
|
|
(while args (push `(setf ,(pop args) ,(pop args)) sets))
|
|
(cons 'progn (nreverse sets)))))
|
|
|
|
;; (defmacro gv-pushnew! (val place)
|
|
;; "Like `gv-push!' but only adds VAL if it's not yet in PLACE.
|
|
;; Presence is checked with `member'.
|
|
;; The return value is unspecified."
|
|
;; (declare (debug (form gv-place)))
|
|
;; (macroexp-let2 macroexp-copyable-p v val
|
|
;; (gv-letplace (getter setter) place
|
|
;; `(if (member ,v ,getter) nil
|
|
;; ,(funcall setter `(cons ,v ,getter))))))
|
|
|
|
;; (defmacro gv-inc! (place &optional val)
|
|
;; "Increment PLACE by VAL (default to 1)."
|
|
;; (declare (debug (gv-place &optional form)))
|
|
;; (gv-letplace (getter setter) place
|
|
;; (funcall setter `(+ ,getter ,(or val 1)))))
|
|
|
|
;; (defmacro gv-dec! (place &optional val)
|
|
;; "Decrement PLACE by VAL (default to 1)."
|
|
;; (declare (debug (gv-place &optional form)))
|
|
;; (gv-letplace (getter setter) place
|
|
;; (funcall setter `(- ,getter ,(or val 1)))))
|
|
|
|
;; For Edebug, the idea is to let Edebug instrument gv-places just like it does
|
|
;; for normal expressions, and then give it a gv-expander to DTRT.
|
|
;; Maybe this should really be in edebug.el rather than here.
|
|
|
|
;; Autoload this `put' since a user might use C-u C-M-x on an expression
|
|
;; 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
|
|
(funcall do `(edebug-after ,before ,index ,getter)
|
|
setter))))
|
|
|
|
;;; The common generalized variables.
|
|
|
|
(gv-define-simple-setter aref aset)
|
|
(gv-define-simple-setter car setcar)
|
|
(gv-define-simple-setter cdr setcdr)
|
|
;; FIXME: add compiler-macros for `cXXr' instead!
|
|
(gv-define-setter caar (val x) `(setcar (car ,x) ,val))
|
|
(gv-define-setter cadr (val x) `(setcar (cdr ,x) ,val))
|
|
(gv-define-setter cdar (val x) `(setcdr (car ,x) ,val))
|
|
(gv-define-setter cddr (val x) `(setcdr (cdr ,x) ,val))
|
|
(gv-define-setter elt (store seq n)
|
|
`(if (listp ,seq) (setcar (nthcdr ,n ,seq) ,store)
|
|
(aset ,seq ,n ,store)))
|
|
(gv-define-simple-setter get put)
|
|
(gv-define-setter gethash (val k h &optional _d) `(puthash ,k ,val ,h))
|
|
|
|
;; (gv-define-expand nth (lambda (idx list) `(car (nthcdr ,idx ,list))))
|
|
(put 'nth 'gv-expander
|
|
(lambda (do idx list)
|
|
(macroexp-let2 nil c `(nthcdr ,idx ,list)
|
|
(funcall do `(car ,c) (lambda (v) `(setcar ,c ,v))))))
|
|
(gv-define-simple-setter symbol-function fset)
|
|
(gv-define-simple-setter symbol-plist setplist)
|
|
(gv-define-simple-setter symbol-value set)
|
|
|
|
(put 'nthcdr 'gv-expander
|
|
(lambda (do n place)
|
|
(macroexp-let2 nil idx n
|
|
(gv-letplace (getter setter) place
|
|
(funcall do `(nthcdr ,idx ,getter)
|
|
(lambda (v) `(if (<= ,idx 0) ,(funcall setter v)
|
|
(setcdr (nthcdr (1- ,idx) ,getter) ,v))))))))
|
|
|
|
;;; Elisp-specific generalized variables.
|
|
|
|
(gv-define-simple-setter default-value set-default)
|
|
(gv-define-simple-setter frame-parameter set-frame-parameter 'fix)
|
|
(gv-define-simple-setter terminal-parameter set-terminal-parameter)
|
|
(gv-define-simple-setter keymap-parent set-keymap-parent)
|
|
(gv-define-simple-setter match-data set-match-data 'fix)
|
|
(gv-define-simple-setter overlay-get overlay-put)
|
|
(gv-define-setter overlay-start (store ov)
|
|
`(progn (move-overlay ,ov ,store (overlay-end ,ov)) ,store))
|
|
(gv-define-setter overlay-end (store ov)
|
|
`(progn (move-overlay ,ov (overlay-start ,ov) ,store) ,store))
|
|
(gv-define-simple-setter process-buffer set-process-buffer)
|
|
(gv-define-simple-setter process-filter set-process-filter)
|
|
(gv-define-simple-setter process-sentinel set-process-sentinel)
|
|
(gv-define-simple-setter process-get process-put)
|
|
(gv-define-simple-setter window-parameter set-window-parameter)
|
|
(gv-define-setter window-buffer (v &optional w)
|
|
(macroexp-let2 nil v v
|
|
`(progn (set-window-buffer ,w ,v) ,v)))
|
|
(gv-define-setter window-display-table (v &optional w)
|
|
(macroexp-let2 nil v v
|
|
`(progn (set-window-display-table ,w ,v) ,v)))
|
|
(gv-define-setter window-dedicated-p (v &optional w)
|
|
`(set-window-dedicated-p ,w ,v))
|
|
(gv-define-setter window-hscroll (v &optional w) `(set-window-hscroll ,w ,v))
|
|
(gv-define-setter window-point (v &optional w) `(set-window-point ,w ,v))
|
|
(gv-define-setter window-start (v &optional w) `(set-window-start ,w ,v))
|
|
|
|
(gv-define-setter buffer-local-value (val var buf)
|
|
(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,
|
|
;; they can show up as the output of the macro expansion of reasonable places,
|
|
;; such as struct-accessors.
|
|
|
|
(put 'progn 'gv-expander
|
|
(lambda (do &rest exps)
|
|
(let ((start (butlast exps))
|
|
(end (car (last exps))))
|
|
(if (null start) (gv-get end do)
|
|
`(progn ,@start ,(gv-get end do))))))
|
|
|
|
(let ((let-expander
|
|
(lambda (letsym)
|
|
(lambda (do bindings &rest body)
|
|
`(,letsym ,bindings
|
|
,@(macroexp-unprogn
|
|
(gv-get (macroexp-progn body) do)))))))
|
|
(put 'let 'gv-expander (funcall let-expander 'let))
|
|
(put 'let* 'gv-expander (funcall let-expander 'let*)))
|
|
|
|
(put 'if 'gv-expander
|
|
(lambda (do test then &rest else)
|
|
(if (or (not lexical-binding) ;The other code requires lexical-binding.
|
|
(macroexp-small-p (funcall do 'dummy (lambda (_) 'dummy))))
|
|
;; This duplicates the `do' code, which is a problem if that
|
|
;; code is large, but otherwise results in more efficient code.
|
|
`(if ,test ,(gv-get then do)
|
|
,@(macroexp-unprogn (gv-get (macroexp-progn else) do)))
|
|
(let ((v (make-symbol "v")))
|
|
(macroexp-let2 nil
|
|
gv `(if ,test ,(gv-letplace (getter setter) then
|
|
`(cons (lambda () ,getter)
|
|
(lambda (,v) ,(funcall setter v))))
|
|
,(gv-letplace (getter setter) (macroexp-progn else)
|
|
`(cons (lambda () ,getter)
|
|
(lambda (,v) ,(funcall setter v)))))
|
|
(funcall do `(funcall (car ,gv))
|
|
(lambda (v) `(funcall (cdr ,gv) ,v))))))))
|
|
|
|
(put 'cond 'gv-expander
|
|
(lambda (do &rest branches)
|
|
(if (or (not lexical-binding) ;The other code requires lexical-binding.
|
|
(macroexp-small-p (funcall do 'dummy (lambda (_) 'dummy))))
|
|
;; This duplicates the `do' code, which is a problem if that
|
|
;; code is large, but otherwise results in more efficient code.
|
|
`(cond
|
|
,@(mapcar (lambda (branch)
|
|
(if (cdr branch)
|
|
(cons (car branch)
|
|
(macroexp-unprogn
|
|
(gv-get (macroexp-progn (cdr branch)) do)))
|
|
(gv-get (car branch) do)))
|
|
branches))
|
|
(let ((v (make-symbol "v")))
|
|
(macroexp-let2 nil
|
|
gv `(cond
|
|
,@(mapcar
|
|
(lambda (branch)
|
|
(if (cdr branch)
|
|
`(,(car branch)
|
|
,@(macroexp-unprogn
|
|
(gv-letplace (getter setter)
|
|
(macroexp-progn (cdr branch))
|
|
`(cons (lambda () ,getter)
|
|
(lambda (,v) ,(funcall setter v))))))
|
|
(gv-letplace (getter setter)
|
|
(car branch)
|
|
`(cons (lambda () ,getter)
|
|
(lambda (,v) ,(funcall setter v))))))
|
|
branches))
|
|
(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
|
|
(lambda (do a d)
|
|
(gv-letplace (agetter asetter) a
|
|
(gv-letplace (dgetter dsetter) d
|
|
(funcall do
|
|
`(cons ,agetter ,dgetter)
|
|
(lambda (v) `(progn
|
|
,(funcall asetter `(car ,v))
|
|
,(funcall dsetter `(cdr ,v)))))))))
|
|
|
|
(put 'logand 'gv-expander
|
|
(lambda (do place &rest masks)
|
|
(gv-letplace (getter setter) place
|
|
(macroexp-let2 macroexp-copyable-p
|
|
mask (if (cdr masks) `(logand ,@masks) (car masks))
|
|
(funcall
|
|
do `(logand ,getter ,mask)
|
|
(lambda (v)
|
|
(funcall setter
|
|
`(logior (logand ,v ,mask)
|
|
(logand ,getter (lognot ,mask))))))))))
|
|
|
|
;;; References
|
|
|
|
;;;###autoload
|
|
(defmacro gv-ref (place)
|
|
"Return a reference to PLACE.
|
|
This is like the `&' operator of the C language.
|
|
Note: this only works reliably with lexical binding mode, except for very
|
|
simple PLACEs such as (function-symbol 'foo) which will also work in dynamic
|
|
binding mode."
|
|
(let ((code
|
|
(gv-letplace (getter setter) place
|
|
`(cons (lambda () ,getter)
|
|
(lambda (gv--val) ,(funcall setter 'gv--val))))))
|
|
(if (or lexical-binding
|
|
;; If `code' still starts with `cons' then presumably gv-letplace
|
|
;; did not add any new let-bindings, so the `lambda's don't capture
|
|
;; any new variables. As a consequence, the code probably works in
|
|
;; dynamic binding mode as well.
|
|
(eq (car-safe code) 'cons))
|
|
code
|
|
(macroexp--warn-and-return
|
|
"Use of gv-ref probably requires lexical-binding"
|
|
code))))
|
|
|
|
(defsubst gv-deref (ref)
|
|
"Dereference REF, returning the referenced value.
|
|
This is like the `*' operator of the C language.
|
|
REF must have been previously obtained with `gv-ref'."
|
|
(funcall (car ref)))
|
|
;; Don't use `declare' because it seems to introduce circularity problems:
|
|
;; Warning: Eager macro-expansion skipped due to cycle:
|
|
;; … => (load "gv.el") => (macroexpand-all (defsubst gv-deref …)) => (macroexpand (defun …)) => (load "gv.el")
|
|
(gv-define-setter gv-deref (v ref) `(funcall (cdr ,ref) ,v))
|
|
|
|
;; (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
|