Mercurial > hg > xemacs-beta
changeset 2546:5d1743698fb3
[xemacs-hg @ 2005-02-03 05:26:39 by ben]
behavior ws #3: behavior updates
behavior.el: Major update. Add documentation of how it works.
behavior-defs.el: Only define the basic behavior groups here.
Move the definitions for particular packages to the
appropriate package files.
mwheel.el: Add define-behavior for mwheel.
| author | ben |
|---|---|
| date | Thu, 03 Feb 2005 05:26:41 +0000 |
| parents | 9caf26dd924f |
| children | a9527fcdf77f |
| files | lisp/ChangeLog lisp/behavior-defs.el lisp/behavior.el lisp/mwheel.el |
| diffstat | 4 files changed, 432 insertions(+), 539 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Thu Feb 03 05:03:45 2005 +0000 +++ b/lisp/ChangeLog Thu Feb 03 05:26:41 2005 +0000 @@ -1,3 +1,53 @@ +2005-02-02 Ben Wing <ben@xemacs.org> + + * behavior.el: + * behavior.el (behavior-group-hash-table): New. + * behavior.el (behavior-override-hash-table): New. + * behavior.el (define-behavior): Removed. + * behavior.el (behavior-group-p): New. + * behavior.el (check-behavior-group): New. + * behavior.el (override-behavior): + * behavior.el (define-behavior-group): + * behavior.el (read-behavior): + * behavior.el (compute-behavior-group-children): New. + * behavior.el (behavior-menu-filter-1): New. + * behavior.el (behavior-menu-filter): New. + Major update. Add documentation of how it works. + + * behavior-defs.el: + * behavior-defs.el (tty): + * behavior-defs.el ('scroll-in-place): Removed. + * behavior-defs.el ('mouse-avoidance): Removed. + * behavior-defs.el ('jka-compr): Removed. + * behavior-defs.el ('efs): Removed. + * behavior-defs.el ('resize-minibuffer): Removed. + * behavior-defs.el ('func-menu): Removed. + * behavior-defs.el ('mwheel): Removed. + * behavior-defs.el ('recent-files): Removed. + * behavior-defs.el ('filladapt): Removed. + * behavior-defs.el ('tty)): New. + * behavior-defs.el ('toolbars)): New. + * behavior-defs.el ('menus)): New. + * behavior-defs.el ('mouse)): New. + * behavior-defs.el ('editing)): New. + * behavior-defs.el ('keyboard)): New. + * behavior-defs.el ('files)): New. + * behavior-defs.el ('games)): New. + * behavior-defs.el ('processes)): New. + * behavior-defs.el ('display)): New. + * behavior-defs.el ('programming)): New. + * behavior-defs.el ('international)): New. + * behavior-defs.el ('buffers-and-windows)): New. + * behavior-defs.el ('internet)): New. + * behavior-defs.el ('compose-mail): New. + Only define the basic behavior groups here. + Move the definitions for particular packages to the + appropriate package files. + + * mwheel.el: + * mwheel.el ('mwheel): New. + Add define-behavior for mwheel. + 2005-02-02 Ben Wing <ben@xemacs.org> * easymenu.el (easy-menu-add): @@ -193,54 +243,6 @@ Major update. Sync with FSF 21.2. Create the ability to make custom-defines files. - * behavior-defs.el: - * behavior-defs.el (tty): - * behavior-defs.el ('scroll-in-place): Removed. - * behavior-defs.el ('mouse-avoidance): Removed. - * behavior-defs.el ('jka-compr): Removed. - * behavior-defs.el ('efs): Removed. - * behavior-defs.el ('resize-minibuffer): Removed. - * behavior-defs.el ('func-menu): Removed. - * behavior-defs.el ('mwheel): Removed. - * behavior-defs.el ('recent-files): Removed. - * behavior-defs.el ('filladapt): Removed. - * behavior-defs.el ('tty)): New. - * behavior-defs.el ('toolbars)): New. - * behavior-defs.el ('menus)): New. - * behavior-defs.el ('mouse)): New. - * behavior-defs.el ('editing)): New. - * behavior-defs.el ('keyboard)): New. - * behavior-defs.el ('files)): New. - * behavior-defs.el ('games)): New. - * behavior-defs.el ('processes)): New. - * behavior-defs.el ('display)): New. - * behavior-defs.el ('programming)): New. - * behavior-defs.el ('international)): New. - * behavior-defs.el ('buffers-and-windows)): New. - * behavior-defs.el ('internet)): New. - * behavior-defs.el ('compose-mail): New. - Only define the basic behavior groups here. - Move the definitions for particular packages to the - appropriate package files. - - * behavior.el: - * behavior.el (behavior-group-hash-table): New. - * behavior.el (behavior-override-hash-table): New. - * behavior.el (define-behavior): Removed. - * behavior.el (behavior-group-p): New. - * behavior.el (check-behavior-group): New. - * behavior.el (override-behavior): - * behavior.el (define-behavior-group): - * behavior.el (read-behavior): - * behavior.el (compute-behavior-group-children): New. - * behavior.el (behavior-menu-filter-1): New. - * behavior.el (behavior-menu-filter): New. - Major update. Add documentation of how it works. - - * mwheel.el: - * mwheel.el ('mwheel): New. - Add define-behavior for mwheel. - * paragraphs.el: * paragraphs.el (paragraphs): New. * paragraphs.el (use-hard-newlines): Removed.
--- a/lisp/behavior-defs.el Thu Feb 03 05:03:45 2005 +0000 +++ b/lisp/behavior-defs.el Thu Feb 03 05:26:41 2005 +0000 @@ -1,6 +1,6 @@ ;;; behavior-defs.el --- definitions of specific behaviors -;; Copyright (C) 2000, 2001, 2002 Ben Wing. +;; Copyright (C) 2000, 2001, 2002, 2003 Ben Wing. ;; Author: Ben Wing ;; Maintainer: XEmacs Development Team @@ -31,475 +31,27 @@ ;;; Commentary: -;; This file will be dumped with XEmacs. +;; This file is dumped with XEmacs. ;;; Code: -(require 'behavior) - -(define-behavior 'scroll-in-place -"This package provides improved vertical scrolling commands for XEmacs. -These new commands offer the following features: - -+ When a scrolling command is executed, XEmacs tries to keep point as - close as possible to its original window position (window line and - column). This is what \"scroll in place\" means: point stays \"in place\" - within the window. (There are times when point must be moved from its - original window position in order to execute the scroll; see below.) - - The variable `scroll-in-place', which is true by default, determines - whether or not the standard XEmacs scrolling commands (`scroll-down', - `scroll-up', `scroll-other-window-down', and `scroll-other-window') use - the \"in place\" features listed here. When `scroll-in-place' is `nil' - the standard XEmacs scrolling commands essentially just call the - original versions of themselves. (Note that even when `scroll-in-place' - is `nil' the new versions of `scroll-down' and `scroll-up' have slightly - different behavior when a minibuffer window is the selected window. See - below.) - - It is possible to turn off (or turn on) \"in place\" scrolling for certain - buffers by making buffer-local bindings of the variable `scroll-in- - place' for those buffers. The variable `scroll-in-place' is not usually - buffer-local, but you can make it so if you desire. - -+ Because the improved scrolling commands keep point at its original - window position, these scrolling commands are \"reversible.\" The - `scroll-up' command undoes the effect of the immediately previous - `scroll-down' command (if any) and vice versa. In other words, if you - scroll up and then immediately scroll back down, the window config- - uration is restored to its exact original state. This allows you to - browse through a buffer more easily, as you can always get back to the - original configuration. - - Note, however, that the improved scrolling commands are guaranteed to be - reversible only if there are no intervening non-scrolling commands. - Also, if you give a prefix argument to a scrolling command (in order to - specify the number of lines to scroll by), previous scrolling commands - may no longer be reversible. More specifically, if the new prefix - argument has a different magnitude than the previous scrolling distance, - then any previous scrolling commands are not reversible. The new prefix - argument takes precedence. - - You might find it useful to think of the scrolling commands as forming - \"chains.\" A scrolling command either starts or continues a chain. By - issuing a non-scrolling command or by changing the number of lines to be - scrolled, you break the chain. (Note that simply changing the scrolling - direction won't break the chain; changing the absolute number of lines - to be scrolled is what breaks the chain.) Scrolling commands are - guaranteed to be reversible only within the current chain. Hopefully - that's clear enough. - -+ When a scrolling command is given a prefix argument (which specifies the - number of lines to scroll by), then that argument becomes the default - scrolling distance for all immediately subsequent scrolling commands. - This means that you can easily set the scrolling distance for a chain - of scrolling commands. Note that a new prefix argument or any non- - scrolling command breaks the chain (as described above), and any further - scrolling commands will use the usual defaults (or the prefix argument - you specify at that time, of course). - - However, there are cases in which one doesn't want the current scrolling - command to use the default scrolling distance that was set by the - previous scrolling command. For example, suppose that you had special - commands that scrolled one line up and one line down. When you invoke - one of these commands, the \"in place\" scrolling routines set the default - scrolling distance to be just one line. Now suppose that you use one of - your special commands and then immediately invoke `scroll-up' (`C-v'), - expecting it to scroll by a near windowful of text. You would be - disappointed --- because the previous command set the default scrolling - distance to be just one line, `scroll-up' just scrolls by one line. - - To solve this problem, \"scroll-in-place\" allows you to divide scrolling - commands into separate \"groups.\" Commands in a group can only form - chains with (and therefore, inherit defaults from) commands in the same - group. (Note that no command can be in more than one group.) If you - invoke a scrolling command that is not in the same group as that of the - immediately previous scrolling command, then the previous chain is - broken and you start a new chain --- with a new set of defaults. - - So to solve the problem described above, you could put your one-line - scrolling commands in their own group. Once that is done, the standard - scrolling commands will not form chains with your one-line scrolling - commands, and therefore will not use the default scrolling distance set - by those commands. Problem solved! - - By default, all \"in place\" scrolling commands are in a single group. If - you want to partition some commands into separate groups, you must do - that yourself *before* any \"in place\" commands are invoked. For more - information about grouping commands, see the documentation for the - variables `scroll-command-groups' and `scroll-default-command-group'. - -+ The improved scrolling commands will avoid displaying empty lines past - the end of the buffer when possible. In other words, just as you can't - see \"dead space\" before the beginning of the buffer text, the new - scrolling commands try to avoid displaying \"dead space\" past the end of - the buffer text. This behavior is somewhat configurable; see the - documentation for the variable `scroll-allow-blank-lines-past-eob'. - - Dead space will be displayed if it is necessary in order to make a - previous scrolling action reversible, however. - -+ If the scrolling commands cannot keep point at its initial window - position (because a buffer boundary is on screen and the window can't be - scrolled as far as necessary to keep point at the right place), point is - allowed to temporarily stray from its initial window position. That is, - point moves the correct number of window lines, even if it means that it - has to stray from its desired window position. This straying is undone - when (and if) the scrolling action is reversed. - -+ If a scrolling command tries to move point past a buffer boundary, point - is instead moved to the boundary (the beginning or the end of the buffer - as appropriate) and an appropriate message is displayed. This motion is - reversible, of course. - - However, if point was already at the buffer boundary when the scrolling - command was invoked, the command signals an appropriate error instead. - -+ When a minibuffer window is the selected window, the new versions of - `scroll-up' and `scroll-down' either scroll the window in the variable - `minibuffer-scroll-window' (which is usually the window of completions) - or the `next-window' if there is no `minibuffer-scroll-window'. This is - usually much more useful than scrolling the minibuffer itself. (Note - that this feature is available even when the variable `scroll-in-place' - is `nil'.) - -+ When a scrolling command is scrolling a window other than the selected - window, it will signal an appropriate buffer boundary error if the - window cannot be scrolled (because the appropriate buffer boundary is - already visible). This means that an error is signalled even in cases - that would be allowed (by \"straying\" point or by moving it to the buffer - boundary) if the window were selected. - - (If an error were not signalled in these cases, then there would be many - cases in which the last scroll in a particular direction would appear to - do nothing because only the point position would change --- the - displayed text would stay the same! To avoid these cases the scrolling - commands signal boundary errors \"prematurely\" when the window to be - scrolled is not selected.)" - :short-doc "Keep cursor on same line when scrolling" - :require 'scroll-in-place - :enable #'turn-on-scroll-in-place - :disable #'turn-off-scroll-in-place) - -(define-behavior 'mouse-avoidance -"For those who are annoyed by the mouse pointer obscuring text, -this mode moves the mouse pointer - either just a little out of -the way, or all the way to the corner of the frame. - -Customize `mouse-avoidance-mode' to one of the symbols `banish', -`exile', `jump', `animate', `cat-and-mouse', `proteus', or `none'. - -Effects of the different modes: - * banish: Move the mouse to the upper-right corner on any keypress. - * exile: Move the mouse to the corner only if the cursor gets too close, - and allow it to return once the cursor is out of the way. - * jump: If the cursor gets too close to the mouse, displace the mouse - a random distance & direction. - * animate: As `jump', but shows steps along the way for illusion of motion. - * cat-and-mouse: Same as `animate'. - * proteus: As `animate', but changes the shape of the mouse pointer too. - -Whenever the mouse is moved, the frame is also raised. - -\(see `mouse-avoidance-threshold' for definition of \"too close\", -and `mouse-avoidance-nudge-dist' and `mouse-avoidance-nudge-var' for -definition of \"random distance\".)" - :short-doc "Keep mouse away from cursor" - :enable #'(lambda () - (mouse-avoidance-mode 'animate)) - :disable #'(lambda () - (mouse-avoidance-mode 'none))) - -(define-behavior 'jka-compr - "This package implements low-level support for reading, writing, -and loading compressed files. It hooks into the low-level file -I/O functions (including write-region and insert-file-contents) so -that they automatically compress or uncompress a file if the file -appears to need it (based on the extension of the file name). -Packages like Rmail, VM, GNUS, and Info should be able to work -with compressed files without modification." - :short-doc "Transparently handle compressed files" - :enable #'jka-compr-install - :disable #'jka-compr-uninstall) - -(define-behavior 'efs -"EFS is a system for transparent file-transfer between remote VMS, CMS, -MTS, MVS, Twenex, Explorer (the last two are Lisp machines), TOPS-20, -DOS (running the Distinct, Novell, FTP software, NCSA, Microsoft in both -unix and DOS mode, Super TCP, and Hellsoft FTP servers), Windows NT -\(running the Microsoft or Hummingbird ftp servers), Unix descriptive -listings (dl), KA9Q, OS/2 hosts using FTP. This means that you can edit, -copy and otherwise manipulate files on any machine you have access to -from within Emacs as if it were a local file. EFS works by introducing -an extended filename syntax, and overloading functions such as -`insert-file-contents' so that accessing a remote file causes -appropriate commands to be sent to an FTP process. - -The syntax to use is like this: - -\(for anonymous:) /ftp.xemacs.org:/pub/xemacs/ -\(for non-anonymous:) /ben@gwyn.tux.org:/etc/mail/xemacs/aliases-xemacs - -You can specify either a file or a directory (in the latter case, -Dired will be brought up). All operations in XEmacs on such files -should work exactly as on any other files, modulo the additional -slowness." - :short-doc "Transparent file access over FTP" - :require 'efs-auto - :enable #'ignore - ;; can't :disable - ) - - -(define-behavior 'resize-minibuffer - "When this behavior is enabled, the minibuffer is dynamically resized to -contain the entire region of text put in it as you type. - -The maximum height to which the minibuffer can grow is controlled by the -variable `resize-minibuffer-window-max-height'. - -The variable `resize-minibuffer-window-exactly' determines whether the -minibuffer window should ever be shrunk to make it no larger than needed to -display its contents. +(define-behavior-group 'tty) +(define-behavior-group 'toolbars) +(define-behavior-group 'menus) +(define-behavior-group 'mouse) +(define-behavior-group 'editing) +(define-behavior-group 'keyboard) +(define-behavior-group 'files) +(define-behavior-group 'games) +(define-behavior-group 'processes) +(define-behavior-group 'display) +(define-behavior-group 'programming) +(define-behavior-group 'international) +(define-behavior-group 'buffers-and-windows) +(define-behavior-group 'internet) -When using a window system, it is possible for a minibuffer to be the sole -window in a frame. Since that window is already its maximum size, the only -way to make more text visible at once is to increase the size of the frame. -The variable `resize-minibuffer-frame' controls whether this should be -done. The variables `resize-minibuffer-frame-max-height' and -`resize-minibuffer-frame-exactly' are analogous to their window -counterparts." - :short-doc "Resize minibuffer automatically" - :enable #'(lambda () - (resize-minibuffer-mode 1)) - :disable #'(lambda () - (resize-minibuffer-mode -1))) - -(define-behavior 'func-menu - "Suppose you have a file with a lot of functions in it. Well, this -package makes it easy to jump to any of those functions. The names of -the functions in the current buffer are automatically put into menubar -menu, you select one of the function-names and the point is moved to -that very function. The mark is pushed on the mark-ring, so you can -easily go back to where you were. Alternatively, you can use enter the -name of the desired function via the minibuffer which offers -completing read input. In addition, the name of the function before -point is optionally displayed in the modeline." - :short-doc "Add a menu of defined functions" - :require 'func-menu - :enable #'(lambda () - (add-hook 'find-file-hooks 'fume-add-menubar-entry) - (mapc #'(lambda (buffer) - (with-current-buffer buffer - (setq fume-display-in-modeline-p t) - (fume-add-menubar-entry))) - (buffer-list))) - :disable #'(lambda () - (remove-hook 'find-file-hooks 'fume-add-menubar-entry) - (fset 'widen (symbol-function 'fume-widen)) - (fset 'narrow-to-region (symbol-function 'narrow-to-region)) - (mapc #'(lambda (buffer) - (with-current-buffer buffer - (fume-remove-menubar-entry) - (setq fume-display-in-modeline-p nil) - (fume-remove-post-command-hook - 'fume-tickle-modeline) - (fume-remove-post-command-hook - 'fume-maybe-install-modeline-feature) - (fume-remove-post-command-hook - 'fume-rescan-buffer-trigger))) - (buffer-list)))) - -(define-behavior 'mwheel - "This code enables the use of the infamous 'wheel' on the new -crop of mice. Under XFree86 and the XSuSE X Servers, the wheel -events are sent as button4/button5 events, which are automatically -set up to do scrolling in the expected way. The actual way that the -scrolling works can be controlled by `mwheel-scroll-amount' and -`mwheel-follow-mouse'." - :short-doc "Mouse wheel support for X Windows" - :enable 'mwheel-install) - -(define-behavior 'recent-files -"Recent-files adds the menu \"Recent Files\" (or whatever name you -choose, see \"Customization:\" below) to Emacs's menubar. Its -entries are the files (and directories) that have recently been -opened by Emacs. You can open one of these files again by -selecting its entry in the \"Recent Files\" menu. The list of file -entries in this menu is preserved from one Emacs session to -another. You can prevent Emacs from saving this list by selecting -\"Don't save recent-files list on exit\" from the menu. If you have -disabled saving, you can re-enable it by selecting \"Save -recent-files list on exit\". - -The menu has permanent and non-permanent entries. Permanent -entries are marked with an asterisk in front of the filename. The -non-permanent entries are hidden in a submenu. - -Each time you open a file in Emacs, it is added as a non-permanent -entry to the menu. The value of `recent-files-number-of-entries' -determines how many non-permanent entries are held in the -menu. When the number of non-permanent entries reaches this value, -the least recently added non-permanent entry is removed from the -menu when another non-permanent entry is added. It is not removed -from the list, though; it may reappear when entries are deleted -from the list. The number of entries saved to disk is the value of -the variable `recent-files-number-of-saved-entries'. - -Permanent entries are not removed from the menu. You can make a -file entry permanent by selecting \"Make <buffer> permanent\" (where -<buffer> is the name of the current buffer) when the current -buffer holds this file. \"Make <buffer> non-permanent\" makes the -file entry of the current buffer non-permanent. - -The command \"Kill buffer <buffer> and delete entry\" is handy when -you have accidently opened a file but want to keep neither the -buffer nor the entry. - -You can erase the list of non-permanent entries by selecting -\"Erase non-permanent entries\" from the menu. - -Customization: - -There are lots of variables to control the behaviour of -recent-files. You do not have to change any of them if you like it -as it comes out of the box. However, you may want to look at these -options to make it behave different. - -`recent-files-number-of-entries' - Controls how many non-permanent entries are shown in the - recent-files list. The default is 15. - -`recent-files-number-of-saved-entries' - Controls how many non-permanent entries are saved to disk when - Emacs exits or recent-files-save-the-list is called. The - default is 50. - -`recent-files-save-file' - The name of the file where the recent-files list is saved - between Emacs session. You probably don't need to change this. - The default is \".recent-files.el\" in your home directory. - -`recent-files-dont-include' - A list of regular expressions for files that should not be - included into the recent-files list. This list is empty by - default. For instance, a list to exclude all .newsrc - files, all auto-save-files, and all files in the /tmp - directory (but not the /tmp directory itself) would look - like this: - (setq recent-files-dont-include - '(\"/\\.newsrc\" \"~$\" \"^/tmp/.\")) - The default is empty. - -`recent-files-use-full-names' - If the value of this variable is non-nil, the full pathnames of - the files are shown in the recent-files menu. Otherwise only - the filename part (or the last name component if it is a - directory) is shown in the menu. The default it t, i.e. show - full names. - -`recent-files-filename-replacements' - This is a list of pairs of regular expressions and replacement - strings. If a filename matches one of the regular expressions, - the matching part is replaced by the replacement string for - display in the recent-files menu. - Example: My home directory is \"/users/mmc/nickel/\". I want to - replace it with \"~/\". I also want to replace the directory - \"/imports/teleservices/mmc/avc2/\", where I work a lot, with - \".../avc2/\". The list then looks like - (setq recent-files-filename-replacements - '((\"/users/mmc/nickel/\" . \"~/\") - (\"/imports/teleservices/mmc/avc2/\" . \".../avc2/\"))) - Only the first match is replaced. So, if you have several - entries in this list that may match a filename simultaneously, - put the one you want to match (usually the most special) in - front of the others. The default is to replace the home - directory with \"~\". - -`recent-files-sort-function' - Contains a function symbol to sort the display of filenames in - the recent-files menu. Supplied are two functions, - 'recent-files-dont-sort and 'recent-files-sort-alphabetically. - The first, which is the default, preserves the order of \"most - recent on top\". - -`recent-files-permanent-submenu' - If this variable is non-nil, the permanent entries are put into - a separate submenu of the recent-files menu. The default is - nil. - -`recent-files-non-permanent-submenu' - If this variable is non-nil, the non-permanent entries are put - into a separate submenu of the recent-files menu. The default - is nil. (You can set both `recent-files-permanent-submenu' and - `recent-files-non-permanent-submenu' to t to have both lists in - separate submenus.) - -`recent-files-commands-submenu' - If this variable is non-nil, the commands if recent-files are - placed in a submenu of the recent-files menu. The default is - nil. - -`recent-files-commands-submenu-title' - If the commands are placed in a submenu, this string is used as - the title of the submenu. The default is \"Commands...\". - -`recent-files-actions-on-top' - If this variable is non-nil, the \"action\" menu entries (\"Make - <buffer> permanent\" etc.) are put on top of the menu. Otherwise - they appear below the file entries or submenus. The default is - nil. - -`recent-files-permanent-first' - If this variable is t, the permanent entries are put first in - the recent-files menu, i.e. above the non-permanent entries. If - the value is nil, non-permanent entries appear first. If the - value is neither t nor nil, the entries are sorted according to - recent-files-sort-function. The default is 'sort. - -`recent-files-find-file-command' - This variable contains to commandto execute when a file entry - is selected from the menu. Usually this will be `find-file', - which is the default. - -KNOWN BUG: - - recent-files overwrites the recent-files-save-file - unconditionally when Emacs exits. If you have two Emacs - processes running, the one exiting later will overwrite the - file without merging in the new entries from the other Emacs - process. This can be avoided by disabling the save on exit from - the menu." - :short-doc "`Recent Files' menu" - :enable 'recent-files-initialize) - -(define-behavior 'filladapt - "These functions enhance the default behavior of Emacs' Auto Fill -mode and the commands `fill-paragraph', `lisp-fill-paragraph', -`fill-region-as-paragraph' and `fill-region'. - -The chief improvement is that the beginning of a line to be -filled is examined and, based on information gathered, an -appropriate value for fill-prefix is constructed. Also the -boundaries of the current paragraph are located. This occurs -only if the fill prefix is not already non-nil. - -The net result of this is that blurbs of text that are offset -from left margin by asterisks, dashes, and/or spaces, numbered -examples, included text from USENET news articles, etc. are -generally filled correctly with no fuss." - :short-doc "Adaptive (smart) filling" - :require 'filladapt - :enable #'(lambda () - (setq-default filladapt-mode t) - (mapc #'(lambda (buffer) - (with-current-buffer buffer - (unless filladapt-mode - (filladapt-mode 1)))) - (buffer-list))) - :disable #'(lambda () - (setq-default filladapt-mode nil) - (mapc #'(lambda (buffer) - (with-current-buffer buffer - (when filladapt-mode - (filladapt-mode -1)))) - (buffer-list)))) +(define-behavior 'compose-mail + "Not documented." + :group 'internet + :commands + '(["Send %_Mail..." compose-mail]))
--- a/lisp/behavior.el Thu Feb 03 05:03:45 2005 +0000 +++ b/lisp/behavior.el Thu Feb 03 05:26:41 2005 +0000 @@ -1,6 +1,6 @@ -;;; behavior.el --- consistent interface onto behaviors +;;; behavior.el --- consistent interface onto packages -;; Copyright (C) 2000, 2001, 2002 Ben Wing. +;; Copyright (C) 2000, 2001, 2002, 2003 Ben Wing. ;; Author: Ben Wing ;; Maintainer: XEmacs Development Team @@ -31,13 +31,152 @@ ;;; Commentary: -;; This file will be dumped with XEmacs. +;; This file is dumped with XEmacs. + +;; This file is part of the "Behaviors" project and is a work in progress. +;; The purpose of the project is to provide (a) a consistent interface (at +;; the API level) onto the functionality provided by packages, and (b) an +;; easy-to-use user interface for this functionality, something that +;; *really works*. +;; +;; First, what characteristics do/should packages have? (NOTE: In this +;; discussion below, `package' and `behavior' are being used more or less +;; interchangeably. Eventually this will get resolved.) + +;; 1) A file, or one or more file, containing the code of the package. In +;; addition, a "head" file in the case that the package needs to be +;; loaded in order to get its functionality (e.g. "load-to-enable" +;; packages -- an abomination that is tolerated only with severe +;; displeasure). +;; 2) A Lisp name -- a fairly short symbol (2-3 words max), uncapitalized, +;; without use of excessive abbreviation and with words set off by +;; dashes. This should be the same as the name of the topmost custom +;; group associated with the package (see next item), and preferably the +;; same as the common prefix used for variables defined by your package +;; and the name of the head file of the package. +;; 3) Associated custom group listing the settings associated with the package. +;; 4) Enable and disable methods for turning on or off the functionality of +;; the package, if it's amenable to such a model. Most packages are of two +;; types: +;; +;; (a) They add some functionality to XEmacs, which is incorporated +;; into and makes changes to the normal functionality of XEmacs. Once the +;; package is enabled, the user doesn't have to do anything specific for +;; the package to do its thing -- it happens automatically if the user is +;; using the area whose behavior has been changed. These include packages +;; such as `avoid' (which makes the mouse poointer move when the cursor +;; gets too close), EFS (which adds the ability to treat an FTP site as +;; part of the local file system), the packages that supply the +;; mode-specific handling for various files, etc +;; +;; (b) They provide functionality in the form of specific command to be +;; invoked. This can be as simple as the `hippie-expand' command (tries +;; lots of different expansion methods for the text before point, to +;; try and get a result) and as complicated as GNUS or VM. +;; +;; Some packages might provide both -- you can enable them and they +;; incorporate some functionality into the XEmacs base, but while +;; they're enabled they provide certain commands. #### We need some +;; thought here, and case-by-case analysis, to determine if this really +;; makes sense -- can the enable/disable be removed and whatever needs +;; to happen incorporated as part of the command? can the +;; enable/disable just added to the commands? +;; +;; 5) Packages of type (b) just above will have a list of commands that can be +;; run. They should be in standard menubar format -- i.e. just like a +;; submenu, but without the initial string indidicating the name of the +;; menu. +;; 6) Short doc string, for use in a menu item. *NOT* necessarily the same +;; as the documentation for the Custom group, which is often too long. +;; 7) Long documentation. +;; +;; Good package etiquette: +;; +;; +;; -- Never mess with the menu yourself, or try to "cheat" by putting yourself +;; high up in the hierarchy, e.g. at the top-level or directly off a +;; top-level group that expects to contain only groups of groups, not +;; end-level groups. +;; +;; -- Never use the `override-behavior' commands or the like for specifying +;; (in an overriding fashion) the exact appearance of the hierarchies. +;; +;; -- For type (a), with enable/disable methods: +;; +;; (a) Loading the file should NOT DO ANYTHING. Not enable, not add hooks, +;; nothing. +;; (b) Both enable and disable hooks must exist. The disable hook must +;; completely reset the environment to how it was before the package +;; was enabled. This includes restoring the prior bindings for +;; modified key bindings. #### We need some helper function to assist +;; with remembering the old key bindings and putting them back only +;; when new key bindings haven't been made -- but recognize when those +;; new key bondings were attached as a result of loading another +;; package, so that after any order of loading and unloading a series +;; of packages, the original bindings will eventually occur. (Something +;; like `advice' for key definitions.) Replacement of functions should +;; happen through `advice'. +;; +;; We recognize that many packages out there don't follow these precepts at +;; all. Many or most of them are install-only, often happening +;; automatically when the file is loaded. Converting these will be a step +;; at a time: First, redo the latter type so that the initialization code +;; is put into a function and not run automatically upon load. Next step, +;; try to provide some sort of disable. Third step, work on making sure +;; that disable removes *everything* and enable puts it all back. Fourth +;; step, work on properly advising keys and functions. +;; + +;; Comparison/Integration with Custom: + +;; Custom only handles variable settings, and has no concept of standard +;; enable/disable methods for a package, a standard way of specifying +;; package documentation, or a list of commands associated with a package. +;; Also, its groups do not always map very well onto packages and the +;; resulting hierarchy is too big, confusing, difficult-to-navigate, and +;; incoherent. More generally it does not address at all the basic problem +;; that a hierarchy created in a decentralized fashion -- and by a large +;; number of authors, some more competent than others -- will inevitably be +;; incoherent when put together. +;; + +;; In general, ease-of-use was not the overarching goal of Custom. The +;; primary goal of Custom seems to have been to provide a consistent interface +;; and get all the packages to use it. Ease-of-use -- or even following +;; established user-interface standards -- has taken a far-distant second, and +;; appears in many respects to be an afterthought that never had any serious +;; effort investigated into it. +;; +;; The eventual intent of this project is to integrate with custom. The final +;; intent of integration is that this project subsumes Custom completely, +;; making Custom the unified, user-friendly means of controlling XEmacs that +;; has never properly existed. However, that will take a lot of work. For +;; the meantime, the plan is to develop the Behavior subsystem independent of +;; Custom, with ease-of-use as the primary goal, and get it to the point where +;; it encompasses most packages out there, has stabilized its interface, and +;; works well. At that point, we will consider integration with Custom. (Note +;; that the hard part of the Behavior work is not actually behaviorizing the +;; packages, but developing the interface itself.) +;; +;; As for integrating with Custom -- ideally that would mean simply extending +;; defgroup, but that is not really possible given that backward-compatibility +;; would not work -- existing versions of `defgroup' give an error when +;; presented with an unknown keyword. In practice, then, this might mean that +;; a separate `define-behavior' command (or `defpackage', or the like) will +;; still exist. ;;; Code: ;; Hash table mapping behavior names to property lists, with entries for -;; :short-doc, :require, :enable, and :disable. +;; :group, :custom-group, :short-doc, :require, :enable, :disable, +;; and :commands. (defconst behavior-hash-table (make-hash-table)) +;; Hash table mapping groups to property lists (entries for :group, :children, +;; :short-doc). +(defconst behavior-group-hash-table (make-hash-table)) +;; Hash table with override information for groups. +;; :short-doc). +(defconst behavior-override-hash-table (make-hash-table)) (defvar within-behavior-enabling-disabling nil) @@ -68,40 +207,137 @@ (defvar behavior-history nil "History of entered behaviors.") -(defun define-behavior (name doc-string &rest cl-keys) +(defun behavior-group-p (group) + "Non-nil if GROUP is the name of a valid behavior group." + (not (null (gethash group behavior-group-hash-table)))) + +(defun check-behavior-group (group) + "Verify that GROUP is a valid behavior group, or nil. +Return GROUP if so." + (or (behavior-group-p group) + (error 'invalid-argument "Invalid behavior group" group)) + group) + +(defun* define-behavior (name doc-string &key + group custom-group + (short-doc + (capitalize-string-as-title + (replace-in-string (symbol-name name) "-" " "))) + require enable disable commands + &allow-other-keys) + ;; We allow other keys to allow for the possibility of extensions by + ;; later versions of XEmacs. Packages should be able to support those + ;; extensions without worrying about causing problems with older versions + ;; of XEmacs. "Define a behavior named NAME. DOC-STRING must be specified, a description of what the behavior does when it's enabled and how to further control it (typically through custom variables). Accepted keywords are +:group Symbol naming the behavior group this behavior is within. +:custom-group Symbol naming the custom group containing the options that + can be set in association with this behavior. If not specified, + the custom group with the same name as the behavior will be + used, if it exists. :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. +:commands A list of interactive commands that can be invoked in + conjunction with the behavior. These will appear in a submenu + along with the rest of the items for the behavior. 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 buffers and frob them. When a behavior is disabled, it should completely go away *everywhere*, as if it were never invoked at all. -The :disable keywords can be missing, although this is considered bad +The :disable keyword can be missing, although this is considered bad practice. In such a case, attempting to disable the behavior will signal -an error unless you use the `force' option." - (cl-parsing-keywords - ((:short-doc (capitalize-string-as-title (replace-in-string - (symbol-name name) "-" " "))) - :require - :enable - :disable) - t - (let ((entry (list :short-doc cl-short-doc :require cl-require - :enable cl-enable :disable cl-disable))) - (puthash name entry behavior-hash-table)))) +an error unless you use the `force' option. + +The :enable keyword can be missing. This is useful for behaviors that +are really a series of related commands without anything semantically +corresponding to \"turning on\" or \"turning off\" the behavior. + +A behavior with no :enable and no :command is possible. This might be +used, for example, by a behavior that encapsulates a series of related +Lisp functions. Such behaviors may be handled specially, e.g. not +displayed in the menus or displayed in a separate location, since they +have no user-invocable behavior." + (let ((entry (list :group (check-behavior-group group) + :custom-group custom-group + :short-doc short-doc :require require + :enable enable :disable disable + :commands commands))) + (puthash name entry behavior-hash-table)) + ;; update the children list of the group we're in (maybe nil). + (unless (member name (getf (gethash group behavior-group-hash-table) + :children)) + (push name (getf (gethash group behavior-group-hash-table) :children)))) + +(defun* override-behavior (name &key + short-doc + group + include + demote-others) + "Override the default properties of a behavior group NAME. +Normally, groups are created and assigned properties by individual packages. +The resulting hierarchy may not make much sense globally. This function +allows the hierarchy and appearance of a group to be specified globally, +and will take precendence over the properties assigned by `define-behavior-group'. This allows a global organization to be imposed on groups, while still allowing for graceful handling of new or unknown groups. + +NAME can be a symbol specifying a group name, or a list of +\(PARENT [...] NAME), where a path from a particular parent is explicitly +given. (This latter form allows the same name to be assigned to more than one +group.) + +Accepted keywords are + +:short-doc A \"pretty\" version of the name, for use in menus. +:group Parent group, if any. Should not be given if the parents are + explicitly specified in NAME. +:include A list of behaviors that are specifically included in this + group, in addition to those that are included by the behaviors + themselves. +:demote-others If non-nil, exclude all behaviors not specified in the :include + list and put them instead (i.e. \"demote\" them) to another group, + usually a subgroup." + (let ((entry (list :group (check-behavior-group group) + :short-doc short-doc + :include include + :demote-others demote-others))) + (puthash name entry behavior-override-hash-table))) + +(defun* define-behavior-group (name &key + (short-doc + (capitalize-string-as-title + (replace-in-string (symbol-name name) "-" + " "))) + group) + "Define a behavior group NAME. + +NAME can be a symbol specifying a group name, or a list of +\(PARENT [...] NAME), where a path from a particular parent is explicitly +given. (This latter form allows the same name to be assigned to more than one +group.) + +Accepted keywords are + +:short-doc A \"pretty\" version of the name, for use in menus. If omitted + a prettified name will be generated. +:group Parent group, if any. Should not be given if the parents are + explicitly specified in NAME." + (let ((entry (list :group (check-behavior-group group) + :short-doc short-doc))) + (puthash name entry behavior-group-hash-table)) + ;; update the children list of the parent (maybe nil). + (push name (getf (gethash group behavior-group-hash-table) :children))) (defun read-behavior (prompt &optional must-match initial-contents history - default-value) + default-value) "Return a behavior symbol from the minibuffer, prompting with string PROMPT. If non-nil, optional second arg INITIAL-CONTENTS is a string to insert in the minibuffer before reading. @@ -119,12 +355,10 @@ behavior-hash-table) (nreverse lis)))) (mapc #'(lambda (aentry) - (setcar aentry (symbol-name - (car aentry)))) + (setcar aentry (symbol-name (car aentry)))) table) table) - nil must-match initial-contents - (or history 'behavior-history) + nil must-match initial-contents (or history 'behavior-history) default-value))) (if (and result (stringp result)) (intern result) @@ -179,6 +413,99 @@ (customize-set-variable 'enabled-behavior-list (delq behavior enabled-behavior-list)))))) +(defun compute-behavior-group-children (group hash) + "Compute the actual children for GROUP and its subgroups. +This takes into account the override information specified." + (let* ((group-plist (gethash group behavior-group-hash-table)) + (override (gethash group behavior-override-hash-table)) + (children (getf group-plist :children))) + ) + ) + +(defun behavior-menu-filter-1 (menu group) + (submenu-generate-accelerator-spec + (let* ( + ;;options + ;;help + (enable + (menu-split-long-menu + (menu-sort-menu + (let ((group-plist (gethash group behavior-group-hash-table))) + (loop for behavior in (getf group-plist :children) + nconc (if (behavior-group-p behavior) + (list + (cons (getf + (gethash behavior behavior-group-hash-table) + :short-doc) + (behavior-menu-filter-1 menu behavior))) + (let* ((plist (gethash behavior behavior-hash-table)) + (commands (getf plist :commands))) + (nconc + (if (getf plist :enable) + `([,(format "%s (%s) [toggle]" + (getf plist :short-doc) + behavior) + (if (memq ',behavior + enabled-behavior-list) + (disable-behavior ',behavior) + (enable-behavior ',behavior)) + :active ,(if (getf plist :disable) t + (not (memq + ',behavior + enabled-behavior-list))) + :style toggle + :selected (memq ',behavior + enabled-behavior-list)])) + (cond ((null commands) nil) + ((and (eq (length commands) 1) + (vectorp (elt commands 0))) + (let ((comm (copy-sequence + (elt commands 0)))) + (setf (elt comm 0) + (format "%s (%s)" + (elt comm 0) behavior)) + (list comm))) + (t (list + (cons (format "%s (%s) Commands" + (getf plist :short-doc) + behavior) + commands))))))))) + )) + ) + ) + enable) + '(?p))) + +(defun behavior-menu-filter (menu) + (append + '(("%_Package Utilities" + ("%_Set Download Site" + ("%_Official Releases" + :filter (lambda (&rest junk) + (menu-split-long-menu + (submenu-generate-accelerator-spec + (package-ui-download-menu))))) + ("%_Pre-Releases" + :filter (lambda (&rest junk) + (menu-split-long-menu + (submenu-generate-accelerator-spec + (package-ui-pre-release-download-menu))))) + ("%_Site Releases" + :filter (lambda (&rest junk) + (menu-split-long-menu + (submenu-generate-accelerator-spec + (package-ui-site-release-download-menu)))))) + "--:shadowEtchedIn" + ["%_Update Package Index" package-get-update-base] + ["%_List and Install" pui-list-packages] + ["U%_pdate Installed Packages" package-get-update-all] + ["%_Help" (Info-goto-node "(xemacs)Packages")]) + "----") + (behavior-menu-filter-1 menu nil))) + +;; Initialize top-level group. +(puthash nil '(:children nil :short-doc "Root") behavior-group-hash-table) + (provide 'behavior) ;;; finder-inf.el ends here
--- a/lisp/mwheel.el Thu Feb 03 05:03:45 2005 +0000 +++ b/lisp/mwheel.el Thu Feb 03 05:26:41 2005 +0000 @@ -126,6 +126,18 @@ (setq keys (cdr keys))) (error nil)))) +;;;###autoload +(define-behavior 'mwheel + "This code enables the use of the infamous 'wheel' on the new +crop of mice. Under XFree86 and the XSuSE X Servers, the wheel +events are sent as button4/button5 events, which are automatically +set up to do scrolling in the expected way. The actual way that the +scrolling works can be controlled by `mwheel-scroll-amount' and +`mwheel-follow-mouse'." + :group 'mouse + :short-doc "Mouse wheel support for X Windows" + :enable 'mwheel-install) + (provide 'mwheel) ;;; mwheel.el ends here