1 ;;; symbols.el --- functions for working with symbols and symbol values
3 ;; Copyright (C) 1996 Ben Wing.
5 ;; Maintainer: SXEmacs Development Team
8 ;; This file is part of SXEmacs.
10 ;; SXEmacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; SXEmacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
23 ;;; Synched up with: Not in FSF.
27 ;; Not yet dumped into SXEmacs.
29 ;; The idea behind magic variables is that you can specify arbitrary
30 ;; behavior to happen when setting or retrieving a variable's value. The
31 ;; purpose of this is to make it possible to cleanly provide support for
32 ;; obsolete variables (e.g. unread-command-event, which is obsolete for
33 ;; unread-command-events) and variable compatibility
34 ;; (e.g. suggest-key-bindings, the FSF equivalent of
35 ;; teach-extended-commands-p and teach-extended-commands-timeout).
37 ;; There are a large number of functions pertaining to a variable's
47 ;; set-default / setq-default
48 ;; make-variable-buffer-local
49 ;; make-local-variable
50 ;; kill-local-variable
51 ;; kill-console-local-variable
52 ;; symbol-value-in-buffer
53 ;; symbol-value-in-console
54 ;; local-variable-p / local-variable-if-set-p
56 ;; Plus some "meta-functions":
62 ;; I wanted an implementation that:
64 ;; -- would work with all the above functions, but (a) didn't require
65 ;; a separate handler for every function, and (b) would work OK
66 ;; even if more functions are added (e.g. `set-symbol-value-in-buffer'
67 ;; or `makunbound-default') or if more arguments are added to a
69 ;; -- avoided consing if at all possible.
70 ;; -- didn't slow down operations on non-magic variables (therefore,
71 ;; storing the magic information using `put' is ruled out).
76 ;; perhaps this should check whether the functions are bound, so that
77 ;; some handlers can be unspecified. That requires that all functions
78 ;; are defined before `define-magic-variable-handlers' is called,
81 ;; perhaps there should be something that combines
82 ;; `define-magic-variable-handlers' with `defvaralias'.
84 (globally-declare-fboundp
85 '(set-magic-variable-handler))
87 (defun define-magic-variable-handlers (variable handler-class harg)
88 "Set the magic variable handles for VARIABLE to those in HANDLER-CLASS.
89 HANDLER-CLASS should be a symbol. The handlers are constructed by adding
90 the handler type to HANDLER-CLASS. HARG is passed as the HARG value for
91 each of the handlers."
94 (set-magic-variable-handler variable htype
95 (intern (concat (symbol-value handler-class)
97 (symbol-value htype)))
99 '(get-value set-value other-predicate other-action)))
101 ;; unread-command-event
103 (defun mvh-first-of-list-get-value (sym fun args harg)
104 (car (apply fun harg args)))
106 (defun mvh-first-of-list-set-value (sym value setfun getfun args harg)
107 (apply setfun harg (cons value (apply getfun harg args)) args))
109 (defun mvh-first-of-list-other-predicate (sym fun args harg)
110 (apply fun harg args))
112 (defun mvh-first-of-list-other-action (sym fun args harg)
113 (apply fun harg args))
115 (define-magic-variable-handlers 'unread-command-event
117 'unread-command-events)
119 ;; last-command-char, last-input-char, unread-command-char
121 (defun mvh-char-to-event-get-value (sym fun args harg)
122 (event-to-character (apply fun harg args)))
124 (defun mvh-char-to-event-set-value (sym value setfun getfun args harg)
125 (let ((event (apply getfun harg args)))
126 (if (event-live-p event)
128 (setq event (make-event))
129 (apply setfun harg event args))
130 (character-to-event value event)))
132 (defun mvh-char-to-event-other-predicate (sym fun args harg)
133 (apply fun harg args))
135 (defun mvh-char-to-event-other-action (sym fun args harg)
136 (apply fun harg args))
138 (define-magic-variable-handlers 'last-command-char
142 (define-magic-variable-handlers 'last-input-char
146 (define-magic-variable-handlers 'unread-command-char
148 'unread-command-event)
150 ;; suggest-key-bindings
152 (set-magic-variable-handler
153 'suggest-key-bindings 'get-value
154 #'(lambda (sym fun args harg)
155 (and (apply fun 'teach-extended-commands-p args)
156 (apply fun 'teach-extended-commands-timeout args))))
158 (set-magic-variable-handler
159 'suggest-key-bindings 'set-value
160 #'(lambda (sym value setfun getfun args harg)
161 (apply setfun 'teach-extended-commands-p (not (null value)) args)
163 (apply 'teach-extended-commands-timeout
164 (if (numberp value) value 2) args))))
166 (set-magic-variable-handler
167 'suggest-key-bindings 'other-action
168 #'(lambda (sym fun args harg)
169 (apply fun 'teach-extended-commands-p args)
170 (apply fun 'teach-extended-commands-timeout args)))
172 (set-magic-variable-handler
173 'suggest-key-bindings 'other-predicate
174 #'(lambda (sym fun args harg)
175 (and (apply fun 'teach-extended-commands-p args)
176 (apply fun 'teach-extended-commands-timeout args))))
178 ;;; symbols.el ends here