--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/symbols.el	Mon Aug 13 10:08:34 2007 +0200
@@ -0,0 +1,177 @@
+;;; symbols.el --- functions for working with symbols and symbol values
+
+;; Copyright (C) 1996 Ben Wing.
+
+;; Maintainer: XEmacs Development Team
+;; Keywords: internal
+
+;; This file is part of XEmacs.
+
+;; XEmacs 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 2, or (at your option)
+;; any later version.
+
+;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
+;; Free Software Foundation, 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Synched up with: Not in FSF.
+
+;;; Commentary:
+
+;; Not yet dumped into XEmacs.
+
+;; The idea behind magic variables is that you can specify arbitrary
+;; behavior to happen when setting or retrieving a variable's value.  The
+;; purpose of this is to make it possible to cleanly provide support for
+;; obsolete variables (e.g. unread-command-event, which is obsolete for
+;; unread-command-events) and variable compatibility
+;; (e.g. suggest-key-bindings, the FSF equivalent of
+;; teach-extended-commands-p and teach-extended-commands-timeout).
+
+;; There are a large number of functions pertaining to a variable's
+;; value:
+
+;; boundp
+;; globally-boundp
+;; makunbound
+;; symbol-value
+;; set / setq
+;; default-boundp
+;; default-value
+;; set-default / setq-default
+;; make-variable-buffer-local
+;; make-local-variable
+;; kill-local-variable
+;; kill-console-local-variable
+;; symbol-value-in-buffer
+;; symbol-value-in-console
+;; local-variable-p / local-variable-if-set-p
+
+;; Plus some "meta-functions":
+
+;; defvaralias
+;; variable-alias
+;; indirect-variable
+
+;; I wanted an implementation that:
+
+;; -- would work with all the above functions, but (a) didn't require
+;;    a separate handler for every function, and (b) would work OK
+;;    even if more functions are added (e.g. `set-symbol-value-in-buffer'
+;;    or `makunbound-default') or if more arguments are added to a
+;;    function.
+;; -- avoided consing if at all possible.
+;; -- didn't slow down operations on non-magic variables (therefore,
+;;    storing the magic information using `put' is ruled out).
+;; 
+
+;;; Code:
+
+;; perhaps this should check whether the functions are bound, so that
+;; some handlers can be unspecified.  That requires that all functions
+;; are defined before `define-magic-variable-handlers' is called,
+;; though.
+
+;; perhaps there should be something that combines
+;; `define-magic-variable-handlers' with `defvaralias'.
+
+(defun define-magic-variable-handlers (variable handler-class harg)
+  "Set the magic variable handles for VARIABLE to those in HANDLER-CLASS.
+HANDLER-CLASS should be a symbol.  The handlers are constructed by adding
+the handler type to HANDLER-CLASS.  HARG is passed as the HARG value for
+each of the handlers."
+  (mapcar
+   #'(lambda (htype)
+       (set-magic-variable-handler variable htype
+				   (intern (concat (symbol-value handler-class)
+						   "-"
+						   (symbol-value htype)))
+				   harg))
+   '(get-value set-value other-predicate other-action)))
+
+;; unread-command-event
+
+(defun mvh-first-of-list-get-value (sym fun args harg)
+  (car (apply fun harg args)))
+
+(defun mvh-first-of-list-set-value (sym value setfun getfun args harg)
+  (apply setfun harg (cons value (apply getfun harg args)) args))
+
+(defun mvh-first-of-list-other-predicate (sym fun args harg)
+  (apply fun harg args))
+
+(defun mvh-first-of-list-other-action (sym fun args harg)
+  (apply fun harg args))
+
+(define-magic-variable-handlers 'unread-command-event
+  'mvh-first-of-list
+  'unread-command-events)
+
+;; last-command-char, last-input-char, unread-command-char
+
+(defun mvh-char-to-event-get-value (sym fun args harg)
+  (event-to-character (apply fun harg args)))
+
+(defun mvh-char-to-event-set-value (sym value setfun getfun args harg)
+  (let ((event (apply getfun harg args)))
+       (if (event-live-p event)
+	   nil
+	 (setq event (allocate-event))
+	 (apply setfun harg event args))
+       (character-to-event value event)))
+
+(defun mvh-char-to-event-other-predicate (sym fun args harg)
+  (apply fun harg args))
+
+(defun mvh-char-to-event-other-action (sym fun args harg)
+  (apply fun harg args))
+
+(define-magic-variable-handlers 'last-command-char
+  'mvh-char-to-event
+  'last-command-event)
+
+(define-magic-variable-handlers 'last-input-char
+  'mvh-char-to-event
+  'last-input-event)
+
+(define-magic-variable-handlers 'unread-command-char
+  'mvh-char-to-event
+  'unread-command-event)
+
+;; suggest-key-bindings
+
+(set-magic-variable-handler
+ 'suggest-key-bindings 'get-value
+ #'(lambda (sym fun args harg)
+     (and (apply fun 'teach-extended-commands-p args)
+	  (apply fun 'teach-extended-commands-timeout args))))
+
+(set-magic-variable-handler
+ 'suggest-key-bindings 'set-value
+ #'(lambda (sym value setfun getfun args harg)
+     (apply setfun 'teach-extended-commands-p (not (null value)) args)
+     (if value
+	 (apply 'teach-extended-commands-timeout
+	       (if (numberp value) value 2) args))))
+
+(set-magic-variable-handler
+ 'suggest-key-bindings 'other-action
+ #'(lambda (sym fun args harg)
+     (apply fun 'teach-extended-commands-p args)
+     (apply fun 'teach-extended-commands-timeout args)))
+
+(set-magic-variable-handler 
+ 'suggest-key-bindings 'other-predicate
+ #'(lambda (sym fun args harg)
+     (and (apply fun 'teach-extended-commands-p args)
+	  (apply fun 'teach-extended-commands-timeout args))))
+
+;;; symbols.el ends here