|
217
|
1 ;;; symbols.el --- functions for working with symbols and symbol values
|
|
|
2
|
|
|
3 ;; Copyright (C) 1996 Ben Wing.
|
|
|
4
|
|
|
5 ;; Maintainer: XEmacs Development Team
|
|
|
6 ;; Keywords: internal
|
|
|
7
|
|
|
8 ;; This file is part of XEmacs.
|
|
|
9
|
|
|
10 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
11 ;; under the terms of the GNU General Public License as published by
|
|
|
12 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
13 ;; any later version.
|
|
|
14
|
|
|
15 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
18 ;; General Public License for more details.
|
|
|
19
|
|
|
20 ;; You should have received a copy of the GNU General Public License
|
|
|
21 ;; along with XEmacs; see the file COPYING. If not, write to the
|
|
|
22 ;; Free Software Foundation, 59 Temple Place - Suite 330,
|
|
|
23 ;; Boston, MA 02111-1307, USA.
|
|
|
24
|
|
|
25 ;;; Synched up with: Not in FSF.
|
|
|
26
|
|
|
27 ;;; Commentary:
|
|
|
28
|
|
|
29 ;; Not yet dumped into XEmacs.
|
|
|
30
|
|
|
31 ;; The idea behind magic variables is that you can specify arbitrary
|
|
|
32 ;; behavior to happen when setting or retrieving a variable's value. The
|
|
|
33 ;; purpose of this is to make it possible to cleanly provide support for
|
|
|
34 ;; obsolete variables (e.g. unread-command-event, which is obsolete for
|
|
|
35 ;; unread-command-events) and variable compatibility
|
|
|
36 ;; (e.g. suggest-key-bindings, the FSF equivalent of
|
|
|
37 ;; teach-extended-commands-p and teach-extended-commands-timeout).
|
|
|
38
|
|
|
39 ;; There are a large number of functions pertaining to a variable's
|
|
|
40 ;; value:
|
|
|
41
|
|
|
42 ;; boundp
|
|
|
43 ;; globally-boundp
|
|
|
44 ;; makunbound
|
|
|
45 ;; symbol-value
|
|
|
46 ;; set / setq
|
|
|
47 ;; default-boundp
|
|
|
48 ;; default-value
|
|
|
49 ;; set-default / setq-default
|
|
|
50 ;; make-variable-buffer-local
|
|
|
51 ;; make-local-variable
|
|
|
52 ;; kill-local-variable
|
|
|
53 ;; kill-console-local-variable
|
|
|
54 ;; symbol-value-in-buffer
|
|
|
55 ;; symbol-value-in-console
|
|
|
56 ;; local-variable-p / local-variable-if-set-p
|
|
|
57
|
|
|
58 ;; Plus some "meta-functions":
|
|
|
59
|
|
|
60 ;; defvaralias
|
|
|
61 ;; variable-alias
|
|
|
62 ;; indirect-variable
|
|
|
63
|
|
|
64 ;; I wanted an implementation that:
|
|
|
65
|
|
|
66 ;; -- would work with all the above functions, but (a) didn't require
|
|
|
67 ;; a separate handler for every function, and (b) would work OK
|
|
|
68 ;; even if more functions are added (e.g. `set-symbol-value-in-buffer'
|
|
|
69 ;; or `makunbound-default') or if more arguments are added to a
|
|
|
70 ;; function.
|
|
|
71 ;; -- avoided consing if at all possible.
|
|
|
72 ;; -- didn't slow down operations on non-magic variables (therefore,
|
|
|
73 ;; storing the magic information using `put' is ruled out).
|
|
|
74 ;;
|
|
|
75
|
|
|
76 ;;; Code:
|
|
|
77
|
|
|
78 ;; perhaps this should check whether the functions are bound, so that
|
|
|
79 ;; some handlers can be unspecified. That requires that all functions
|
|
|
80 ;; are defined before `define-magic-variable-handlers' is called,
|
|
|
81 ;; though.
|
|
|
82
|
|
|
83 ;; perhaps there should be something that combines
|
|
|
84 ;; `define-magic-variable-handlers' with `defvaralias'.
|
|
|
85
|
|
502
|
86 (globally-declare-fboundp
|
|
|
87 '(set-magic-variable-handler))
|
|
|
88
|
|
217
|
89 (defun define-magic-variable-handlers (variable handler-class harg)
|
|
|
90 "Set the magic variable handles for VARIABLE to those in HANDLER-CLASS.
|
|
|
91 HANDLER-CLASS should be a symbol. The handlers are constructed by adding
|
|
|
92 the handler type to HANDLER-CLASS. HARG is passed as the HARG value for
|
|
|
93 each of the handlers."
|
|
|
94 (mapcar
|
|
|
95 #'(lambda (htype)
|
|
|
96 (set-magic-variable-handler variable htype
|
|
|
97 (intern (concat (symbol-value handler-class)
|
|
|
98 "-"
|
|
|
99 (symbol-value htype)))
|
|
|
100 harg))
|
|
|
101 '(get-value set-value other-predicate other-action)))
|
|
|
102
|
|
|
103 ;; unread-command-event
|
|
|
104
|
|
|
105 (defun mvh-first-of-list-get-value (sym fun args harg)
|
|
|
106 (car (apply fun harg args)))
|
|
|
107
|
|
|
108 (defun mvh-first-of-list-set-value (sym value setfun getfun args harg)
|
|
|
109 (apply setfun harg (cons value (apply getfun harg args)) args))
|
|
|
110
|
|
|
111 (defun mvh-first-of-list-other-predicate (sym fun args harg)
|
|
|
112 (apply fun harg args))
|
|
|
113
|
|
|
114 (defun mvh-first-of-list-other-action (sym fun args harg)
|
|
|
115 (apply fun harg args))
|
|
|
116
|
|
|
117 (define-magic-variable-handlers 'unread-command-event
|
|
|
118 'mvh-first-of-list
|
|
|
119 'unread-command-events)
|
|
|
120
|
|
|
121 ;; last-command-char, last-input-char, unread-command-char
|
|
|
122
|
|
|
123 (defun mvh-char-to-event-get-value (sym fun args harg)
|
|
|
124 (event-to-character (apply fun harg args)))
|
|
|
125
|
|
|
126 (defun mvh-char-to-event-set-value (sym value setfun getfun args harg)
|
|
|
127 (let ((event (apply getfun harg args)))
|
|
|
128 (if (event-live-p event)
|
|
|
129 nil
|
|
398
|
130 (setq event (make-event))
|
|
217
|
131 (apply setfun harg event args))
|
|
|
132 (character-to-event value event)))
|
|
|
133
|
|
|
134 (defun mvh-char-to-event-other-predicate (sym fun args harg)
|
|
|
135 (apply fun harg args))
|
|
|
136
|
|
|
137 (defun mvh-char-to-event-other-action (sym fun args harg)
|
|
|
138 (apply fun harg args))
|
|
|
139
|
|
|
140 (define-magic-variable-handlers 'last-command-char
|
|
|
141 'mvh-char-to-event
|
|
|
142 'last-command-event)
|
|
|
143
|
|
|
144 (define-magic-variable-handlers 'last-input-char
|
|
|
145 'mvh-char-to-event
|
|
|
146 'last-input-event)
|
|
|
147
|
|
|
148 (define-magic-variable-handlers 'unread-command-char
|
|
|
149 'mvh-char-to-event
|
|
|
150 'unread-command-event)
|
|
|
151
|
|
|
152 ;; suggest-key-bindings
|
|
|
153
|
|
|
154 (set-magic-variable-handler
|
|
|
155 'suggest-key-bindings 'get-value
|
|
|
156 #'(lambda (sym fun args harg)
|
|
|
157 (and (apply fun 'teach-extended-commands-p args)
|
|
|
158 (apply fun 'teach-extended-commands-timeout args))))
|
|
|
159
|
|
|
160 (set-magic-variable-handler
|
|
|
161 'suggest-key-bindings 'set-value
|
|
|
162 #'(lambda (sym value setfun getfun args harg)
|
|
|
163 (apply setfun 'teach-extended-commands-p (not (null value)) args)
|
|
|
164 (if value
|
|
|
165 (apply 'teach-extended-commands-timeout
|
|
|
166 (if (numberp value) value 2) args))))
|
|
|
167
|
|
|
168 (set-magic-variable-handler
|
|
|
169 'suggest-key-bindings 'other-action
|
|
|
170 #'(lambda (sym fun args harg)
|
|
|
171 (apply fun 'teach-extended-commands-p args)
|
|
|
172 (apply fun 'teach-extended-commands-timeout args)))
|
|
|
173
|
|
|
174 (set-magic-variable-handler
|
|
|
175 'suggest-key-bindings 'other-predicate
|
|
|
176 #'(lambda (sym fun args harg)
|
|
|
177 (and (apply fun 'teach-extended-commands-p args)
|
|
|
178 (apply fun 'teach-extended-commands-timeout args))))
|
|
|
179
|
|
|
180 ;;; symbols.el ends here
|
