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