Mercurial > hg > xemacs-beta
diff lisp/behavior.el @ 800:a5954632b187
[xemacs-hg @ 2002-03-31 08:27:14 by ben]
more fixes, first crack at finishing behavior implementation
TODO.ben-mule-21-5: Update.
configure.in: Fix for new error-checking types.
make-mswin-unicode.pl: Don't be fucked up by CRLF. Output code
to force errors when nonintercepted Windows calls issued.
behavior.el, dumped-lisp.el, menubar-items.el: Add support for saving using custom. Load into a dumped XEmacs.
Correct :title to :short-doc in accordance with behavior-defs.el.
Add a submenu under Options for turning on/off behaviors.
cl-macs.el: Properly document `loop'. Fix a minor bug in keymap iteration and
add support for bit-vector iteration.
lisp-mode.el: Rearrange and add items for macro expanding.
menubar-items.el: Document connection between these two functions.
window.el: Port stuff from GNU 21.1.
config.inc.samp, xemacs.mak: Separate out and add new variable for controlling error-checking.
s/windowsnt.h: Use new ERROR_CHECK_ALL; not related to DEBUG_XEMACS.
alloc.c, backtrace.h, buffer.c, buffer.h, bytecode.c, callproc.c, casetab.c, charset.h, chartab.c, cmdloop.c, config.h.in, console-msw.c, console-stream.c, console-tty.c, console.c, console.h, data.c, device-msw.c, device.c, device.h, dired-msw.c, dired.c, dumper.c, editfns.c, eldap.c, elhash.c, emacs.c, eval.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, events.c, extents.c, faces.c, file-coding.c, file-coding.h, fileio.c, frame-msw.c, frame.c, frame.h, glyphs-gtk.c, glyphs-msw.c, glyphs-shared.c, glyphs-widget.c, glyphs-x.c, glyphs.c, glyphs.h, insdel.c, intl-auto-encap-win32.c, intl-auto-encap-win32.h, intl-encap-win32.c, intl-win32.c, keymap.c, lisp-union.h, lisp.h, lread.c, lrecord.h, lstream.c, lstream.h, macros.c, marker.c, md5.c, menubar-x.c, menubar.c, mule-coding.c, ntproc.c, objects-gtk.c, objects-msw.c, objects-x.c, objects.c, opaque.c, print.c, process-nt.c, process-unix.c, process.c, rangetab.c, redisplay-msw.c, redisplay-output.c, redisplay.c, regex.c, scrollbar-msw.c, select-msw.c, signal.c, specifier.c, specifier.h, symbols.c, sysdep.c, syswindows.h, text.c, text.h, toolbar-msw.c, tooltalk.c, ui-gtk.c, unicode.c, window.c: Redo error-checking macros: ERROR_CHECK_TYPECHECK ->
ERROR_CHECK_TYPES, ERROR_CHECK_CHARBPOS -> ERROR_CHECK_TEXT, add
ERROR_CHECK_DISPLAY, ERROR_CHECK_STRUCTURES. Document these in
config.h.in. Fix code to follow docs. Fix *_checking_assert()
in accordance with new names.
Attempt to fix periodic redisplay crash freeing display line
structures. Add first implementation of sledgehammer redisplay
check.
Redo print_*() to use write_fmt_string(), write_fmt_string_lisp().
Fix bug in md5 handling.
Rename character-to-unicode to char-to-unicode; same for
unicode-to-char{acter}.
Move chartab documentation to `make-char-table'.
Some header cleanup.
Clean up remaining places where nonintercepted Windows calls are
being used.
automated/mule-tests.el: Fix for new Unicode support.
| author | ben |
|---|---|
| date | Sun, 31 Mar 2002 08:30:17 +0000 |
| parents | 7039e6323819 |
| children | 7da79fbe37bb |
line wrap: on
line diff
--- a/lisp/behavior.el Sat Mar 30 04:46:48 2002 +0000 +++ b/lisp/behavior.el Sun Mar 31 08:30:17 2002 +0000 @@ -1,6 +1,6 @@ ;;; behavior.el --- consistent interface onto behaviors -;; Copyright (C) 2000, 2001 Ben Wing. +;; Copyright (C) 2000, 2001, 2002 Ben Wing. ;; Author: Ben Wing ;; Maintainer: XEmacs Development Team @@ -35,7 +35,34 @@ ;;; Code: -(defvar behavior-hash-table (make-hash-table)) +;; Hash table mapping behavior names to property lists, with entries for +;; :short-doc, :require, :enable, and :disable. +(defconst behavior-hash-table (make-hash-table)) + +(defvar within-behavior-enabling-disabling nil) + +(defgroup behaviors nil + "Behaviors -- high-level functionality interface.") + +;; List of enabled behaviors. +(defcustom enabled-behavior-list nil + "List of currently enabled behaviors. +Normally, don't set it directly; use `enable-behavior' or `disable-behavior'." + :initialize #'set-default + :set #'(lambda (sym val) + (if within-behavior-enabling-disabling + (set sym val) + (let* ((old-val enabled-behavior-list) + (disable-list (set-difference old-val val)) + (enable-list (set-difference val old-val))) + (dolist (b disable-list) + (disable-behavior b t)) + (dolist (b enable-list) + (enable-behavior b t)) + (assert (equal enabled-behavior-list val))))) + :type '(repeat (symbol :tag "Behavior")) + :group 'behaviors) + (defvar behavior-history nil "History of entered behaviors.") @@ -46,12 +73,12 @@ when it's enabled and how to further control it (typically through custom variables). Accepted keywords are -:title A \"pretty\" version of the name, for use in menus. If omitted - a prettified name will be generated. -:require A single symbol or a list of such symbols, which need to be - present at enable time, or will be loaded using `require'. -:enable A function of no variables, which turns the behavior on. -:disable A function of no variables, which turns the behavior off. +:short-doc A \"pretty\" version of the name, for use in menus. If omitted + a prettified name will be generated. +:require A single symbol or a list of such symbols, which need to be + present at enable time, or will be loaded using `require'. +:enable A function of no variables, which turns the behavior on. +:disable A function of no variables, which turns the behavior off. Behaviors are assumed to be global, and to take effect immediately; if the underlying package is per-buffer, it may have to scan all existing @@ -62,13 +89,13 @@ practice. In such a case, attempting to disable the behavior will signal an error unless you use the `force' option." (cl-parsing-keywords - ((:title (capitalize-string-as-title (replace-in-string - (symbol-name name) "-" " "))) + ((:short-doc (capitalize-string-as-title (replace-in-string + (symbol-name name) "-" " "))) :require :enable :disable) () - (let ((entry (list :title cl-title :require cl-require + (let ((entry (list :short-doc cl-short-doc :require cl-require :enable cl-enable :disable cl-disable))) (puthash name entry behavior-hash-table)))) @@ -102,13 +129,17 @@ (intern result) result))) -(defun behavior-enabled-p (name)) +(defun behavior-enabled-p (behavior) + "Non-nil if BEHAVIOR (a symbol) if currently enabled." + (memq behavior enabled-behavior-list)) (defun enable-behavior (behavior &optional force) "Enable the specified behavior." (interactive (list (read-behavior "Enable Behavior: " t) current-prefix-arg)) (let ((plist (gethash behavior behavior-hash-table))) (or plist (error 'invalid-argument "Not a behavior" behavior)) + (or force (not (memq behavior enabled-behavior-list)) + (error 'invalid-change "Behavior already enabled" behavior)) (let ((require (getf plist :require)) (enable (getf plist :enable))) (cond ((listp require) @@ -117,7 +148,12 @@ (require require)) ((null require)) (t (error 'invalid-argument "Invalid :require spec" require))) - (if enable (funcall enable))))) + (message "Enabling behavior %s..." behavior) + (if enable (funcall enable)) + (message "Enabling behavior %s...done" behavior) + (let ((within-behavior-enabling-disabling t)) + (customize-set-variable 'enabled-behavior-list + (cons behavior enabled-behavior-list)))))) (defun disable-behavior (behavior &optional force) "Disable the specified behavior." @@ -125,6 +161,8 @@ current-prefix-arg)) (let ((plist (gethash behavior behavior-hash-table))) (or plist (error 'invalid-argument "Not a behavior" behavior)) + (or force (memq behavior enabled-behavior-list) + (error 'invalid-change "Behavior not enabled" behavior)) (let ((require (getf plist :require)) (disable (getf plist :disable))) (cond ((listp require) @@ -133,7 +171,12 @@ (require require)) ((null require)) (t (error 'invalid-argument "Invalid :require spec" require))) - (if disable (funcall disable))))) + (message "Disabling behavior %s..." behavior) + (if disable (funcall disable)) + (message "Disabling behavior %s...done" behavior) + (let ((within-behavior-enabling-disabling t)) + (customize-set-variable 'enabled-behavior-list + (delq behavior enabled-behavior-list)))))) (provide 'behavior)