# HG changeset patch # User cvs # Date 1186991945 -7200 # Node ID a2f645c6b9f8a9f2d47645e4ace7ce05bdcce242 # Parent 2947057885e5b5d599e5cde7666112fd80123638 Import from CVS: tag r20-3b24 diff -r 2947057885e5 -r a2f645c6b9f8 CHANGES-beta --- a/CHANGES-beta Mon Aug 13 09:58:32 2007 +0200 +++ b/CHANGES-beta Mon Aug 13 09:59:05 2007 +0200 @@ -1,4 +1,15 @@ -*- indented-text -*- +to 20.3 beta24 "Ljubljana" +-- Interface change: custom-loads now snarfed separately from autoloads. +-- custom snarfing code rewritten +-- iswitchb.el added from Emacs 20.2 +-- NT DOC file fix from David Hobley +-- jpeg detection corrected +-- bytecode fix to char-syntax +-- gnuserv.el reverted to 3.09 +-- Various patches/Emacs 20.1 synchs from Hrvoje Niksic +-- Miscellaneous bug fixes + to 20.3 beta23 "Sarajevo" -- Other new and older Hrvoje Niksic patches -- 20.1 synching by Hrvoje Niksic diff -r 2947057885e5 -r a2f645c6b9f8 ChangeLog --- a/ChangeLog Mon Aug 13 09:58:32 2007 +0200 +++ b/ChangeLog Mon Aug 13 09:59:05 2007 +0200 @@ -1,3 +1,25 @@ +1997-09-27 SL Baur + + * XEmacs 20.3-beta24 is released. + +1997-09-27 Hrvoje Niksic + + * Makefile.in (custom-loads): New target. + +1997-09-24 SL Baur + + * etc/BETA (XEmacs 20.3 packages): Added explanation of package + hierarchy. + +1997-09-23 SL Baur + + * lwlib/xlwmenu.c: Fix compilation problem with USE_XFONTSET. + From Kazuyuki IENAGA + +1997-09-22 SL Baur + + * XEmacs 19.16-pre4 is released. + 1997-09-20 SL Baur * XEmacs 20.3-beta23 is released. diff -r 2947057885e5 -r a2f645c6b9f8 Makefile.in --- a/Makefile.in Mon Aug 13 09:58:32 2007 +0200 +++ b/Makefile.in Mon Aug 13 09:59:05 2007 +0200 @@ -248,6 +248,9 @@ autoloads: src MAKE='$(MAKE)' sh ${srcdir}/lib-src/update-autoloads.sh +custom-loads: + MAKE='$(MAKE)' sh ${srcdir}/lib-src/update-custom.sh + finder: src @(cd lisp/utils; \ ../../src/xemacs -batch -q -no-site-file \ diff -r 2947057885e5 -r a2f645c6b9f8 etc/BETA --- a/etc/BETA Mon Aug 13 09:58:32 2007 +0200 +++ b/etc/BETA Mon Aug 13 09:59:05 2007 +0200 @@ -210,3 +210,49 @@ you will probably lose due to tab expansion. The best thing to do is to M-x cd to the appropriate directory, and issue the command `C-u M-!' from within XEmacs. + +* XEmacs 20.3 packages + +XEmacs 20.3 has added the concept of installable packages searched prior +to dump time when building. + +Packages are searched by default under /usr/local/lib/xemacs/packages/. +The summary message in configure will tell you where XEmacs is looking +for them. The packages hierarchy differs from site-lisp in that you +do not have install XEmacs to use it, indeed, the package path is +searched prior to dump time so that installed packages have the same +status as lisp distributed in the xemacs base tarball. + +The structure of each directory in the package search path should look +like the base installed directory (ie. have etc/, info/, and lisp/,). +Lisp is searched recursively. It and all subdirectories are added to +the `load-path'. Each etc directory is added to `data-directory-list', +and each info directory is added to `Info-default-directory-list'. + +A `find . -type d -print' in my top-level package directory reveals: +./etc +./etc/auctex +./etc/auctex/style +./etc/gnus +./etc/skk +./etc/gnusrefcard +./etc/smilies +./etc/message +./info +./lisp +./lisp/gnus +./lisp/auctex +./lisp/auctex/man +./lisp/footnote +./lisp/skk + + +AUCTeX and Gnus have package tarballs in + ftp://ftp.xemacs.org/pub/beta/packages-20.3/ +that you can simply untar in a package directory to install. + +Karl Hegbloom has a set of packages in + [I lost the reference] +that work the same way. + +This is not how package installation will work in released 20.3. diff -r 2947057885e5 -r a2f645c6b9f8 etc/NEWS --- a/etc/NEWS Mon Aug 13 09:58:32 2007 +0200 +++ b/etc/NEWS Mon Aug 13 09:59:05 2007 +0200 @@ -165,10 +165,6 @@ `save-current-buffer' in Lisp mode, `call/cc' to `call-with-current-continuation' in Scheme mode, etc. -** Customize now has a new `browser' mode of traversing -customizations, which is in many ways easier to follow than the -standard one. Try it with `M-x customize-browse'. - ** `C-x n d' now runs the new command `narrow-to-defun', which narrows the accessible parts of the buffer to just the current defun. @@ -185,6 +181,25 @@ previous echo area contents are restored (in case the command prints something useful). +** If you set scroll-conservatively to a small number, then when you +move point a short distance off the screen, XEmacs will scroll the +screen just far enough to bring point back on screen, provided that +does not exceed `scroll-conservatively' lines. + +** Customize changes. + +*** Customize has undergone a massive speedup, and should now operate +acceptably fast. Slowness of the interface used to be the biggest +gripe. + +*** Many more packages have been modified to use the facility, so +almost all of XEmacs options can be examined through the Customize +groups. + +*** There is a new `browser' mode of traversing customizations, in +many ways easier to follow than the standard one. Try it out with +`M-x customize-browse'. + ** Pending-delete changes. *** Pending-delete is now a minor mode, with the normal minor-mode @@ -204,18 +219,20 @@ ** Package starting changes. -*** Loading `paren.el' is no longer sufficient to enable -paren-blinking. Use `paren-set-mode' explicitly, or customize -`paren-mode'. - -*** Loading `uniquify.el' is no longer sufficient to enable uniquify; -you have to set `uniquify-buffer-name-style' to a legal value. - -*** Loading `time.el' is no longer sufficient to enable display time; -you have to invoke `display-time' explicitly. - -*** Loading `jka-compr.el' is no longer sufficient to enable -on-the-fly compression; you have to use `toggle-auto-compression'. +*** Loading `paren' no longer enables paren-blinking. Use +`paren-set-mode' explicitly, or customize `paren-mode'. + +*** Loading `uniquify' no longer enables uniquify. Set +`uniquify-buffer-name-style' to a legal value. + +*** Loading `time' no longer enables display time. Invoke +`display-time' explicitly. + +*** Loading `jka-compr' no longer enables on-the-fly compression. Use +`toggle-auto-compression' instead. + +*** Loading `id-select' no longer enables its behaviour. Use +`id-select-install' instead. ** XEmacs can now save the minibuffer histories from various minibuffers. To use this feature, add the line: @@ -235,9 +252,32 @@ Or `M-x customize-group RET add-log RET'. -** The `M-x customize' command now automatically customizes `Emacs' -group (top of the customize tree). Use `M-x customize-group' to -customize settings of a specific group. +** The key C-x m no longer runs the `mail' command directly. +Instead, it runs the command `compose-mail', which invokes the mail +composition mechanism you have selected with the variable +`mail-user-agent'. The default choice of user agent is +`sendmail-user-agent', which gives behavior compatible with the old +behavior. + +C-x 4 m now runs compose-mail-other-window, and C-x 5 m runs +compose-mail-other-frame. + +** When you kill a buffer that visits a file, if there are any +registers that save positions in the file, these register values no +longer become completely useless. If you try to go to such a register +with `C-x j', then you are asked whether to visit the file again. If +you say yes, it visits the file and then goes to the same position. + +** When you visit a file that changes frequently outside Emacs--for +example, a log of output from a process that continues to run--it may +be useful for Emacs to revert the file without querying you whenever +you visit the file afresh with `C-x C-f'. + +You can request this behavior for certain files by setting the +variable revert-without-query to a list of regular expressions. If a +file's name matches any of these regular expressions, find-file and +revert-buffer revert the buffer without asking for permission--but +only if you have not edited the buffer text yourself. ** Gnuserv changes @@ -331,6 +371,10 @@ ** The PATTERN argument to `split-string' is now optional and defaults to whitespace ("[ \f\t\n\r\v]+"). +** `set-extent-properties' is a new function that can be used to +change properties of an extent at once, and is analogous to +`set-frame-properties'. + ** The new macro `with-current-buffer' lets you evaluate an expression conveniently with a different current buffer. It looks like this: diff -r 2947057885e5 -r a2f645c6b9f8 lib-src/ChangeLog --- a/lib-src/ChangeLog Mon Aug 13 09:58:32 2007 +0200 +++ b/lib-src/ChangeLog Mon Aug 13 09:59:05 2007 +0200 @@ -1,3 +1,9 @@ +1997-09-27 Hrvoje Niksic + + * update-custom.sh: New file. + + * update-autoloads.sh: Minor fixes. + 1997-08-11 Jeff Miller * Makefile.in.in: Added a test for system-type equal to linux to lisp/paths.el. Mail spool dir should be /var/spool/mail. diff -r 2947057885e5 -r a2f645c6b9f8 lib-src/update-autoloads.sh --- a/lib-src/update-autoloads.sh Mon Aug 13 09:58:32 2007 +0200 +++ b/lib-src/update-autoloads.sh Mon Aug 13 09:59:05 2007 +0200 @@ -45,7 +45,7 @@ REAL=`cd \`dirname $EMACS\` ; pwd | sed 's|^/tmp_mnt||'`/`basename $EMACS` -echo "Rebuilding autoloads/custom-loads in `pwd|sed 's|^/tmp_mnt||'`" +echo "Rebuilding autoloads in `pwd|sed 's|^/tmp_mnt||'`" echo " with $REAL..." if [ "`uname -r | sed 's/\(.\).*/\1/'`" -gt 4 ]; then @@ -61,9 +61,8 @@ fi # Compute patterns to ignore when searching for files -# These directories don't have autoloads and customizations, or are partially -# broken. -ignore_dirs="cl egg eos ilisp its language locale mel mu sunpro term tooltalk" +# These directories don't have autoloads or are partially broken. +ignore_dirs="egg eos ilisp its language locale mel mu sunpro term tooltalk" # Prepare for autoloading directories with directory-specific instructions make_special_commands='' diff -r 2947057885e5 -r a2f645c6b9f8 lib-src/update-custom.sh --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib-src/update-custom.sh Mon Aug 13 09:59:05 2007 +0200 @@ -0,0 +1,100 @@ +#!/bin/sh +### update-custom.sh --- update Customize group dependencies + +# Author: Hrvoje Niksic, based on update-autoloads.el by +# Jamie Zawinski, Ben Wing, Martin Buchholz, and Steve Baur +# Maintainer: Hrvoje Niksic +# 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, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +### Commentary: + +# This is much simpler than update-autoloads.el. All we need to do is +# compute a list of directories we want to use, and feed it to +# Custom-make-dependencies. End of story. + +### Code: + +set -eu + +# get to the right directory +test ! -d ./lisp -a -d ../lisp && cd .. +if test ! -d ./lisp ; then + echo $0: neither ./lisp/ nor ../lisp/ exist + exit 1 +fi + +EMACS="./src/xemacs" +echo " (using $EMACS)" + +export EMACS + +REAL=`cd \`dirname $EMACS\` ; pwd | sed 's|^/tmp_mnt||'`/`basename $EMACS` + +echo "Rebuilding custom-loads with $REAL..." + +if [ "`uname -r | sed 's/\(.\).*/\1/'`" -gt 4 ]; then + echon() + { + /bin/echo $* '\c' + } +else + echon() + { + echo -n $* + } +fi + +# Compute patterns to ignore when searching for files +# These directories don't have customizations, or are partially broken. +# If some of the packages listed here are customized, don't forget to +# remove the directory! +ignore_dirs="cl egg eos ilisp its language locale mel mu sunpro term \ +tooltalk iso mailcrypt oobr tl tm mh-e hyperbole electric apel \ +hm--html-menus gnats pcl-cvs vm" + +# Only use Mule XEmacs to build Mule-specific autoloads & custom-loads. +echon "Checking for Mule support..." +lisp_prog='(princ (featurep (quote mule)))' +mule_p="`$EMACS -batch -no-site-file -eval \"$lisp_prog\"`" +if test "$mule_p" = nil ; then + echo No + ignore_dirs="$ignore_dirs mule leim" +else + echo Yes +fi + +echon "Checking directories..." +dirs= +for dir in lisp/*; do + if test -d $dir \ + -a $dir != lisp/CVS \ + -a $dir != lisp/SCCS; then + for ignore in $ignore_dirs; do + if test $dir = lisp/$ignore; then + continue 2 + fi + done + rm -f "$dir/custom-load.elc" + dirs="$dirs $dir" + fi +done +echo done + +$EMACS -batch -q -l cus-dep -f Custom-make-dependencies $dirs diff -r 2947057885e5 -r a2f645c6b9f8 lisp/ChangeLog --- a/lisp/ChangeLog Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/ChangeLog Mon Aug 13 09:59:05 2007 +0200 @@ -1,3 +1,341 @@ +1997-09-27 Hrvoje Niksic + + * custom/cus-dep.el (Custom-make-dependencies): Minor fixes. + +1997-09-27 SL Baur + + * packages/completion.el: Remove keybinding of M-return for + hyperbole. + (completion-kill-region): The version of this function in InfoDock + 4.0pre was very broken for XEmacs due to active region handling + and because it didn't set the `this-command' variable properly + when doing a kill. + From: Bob Weiner + +1997-09-26 SL Baur + + * utils/autoload.el: Removed code dealing with customization. + (update-file-autoloads): Fix typo in DOC string, remove custom code. + (update-autoloads-from-directory): Remove custom code. + (batch-update-autoloads): Fix DOC string, remove custom code. + (batch-update-directory): Fix DOC string, remove custom code. + +1997-09-26 Jens-Ulrik Holger Petersen + + * prim/help.el (describe-function-at-point): new function. + (describe-variable-at-point): ditto. + (help-next-symbol): ditto. + (help-prev-symbol): ditto. + (describe-function): Mention `find-function-function' in + docstring. Use `function-history' in completing-read. + (describe-function-1): Only print one filename, even if we know + two! Use `variable-history' in completing-read. + (where-is): Mention `find-function-function' in docstring. + (find-function-function): improve docstring. + (find-function-noselect): Remove optional arg. Now finds + libraries explicitly loaded from outside `load-path' as it should. + Search also for cl's defun*. Return a pair instead of a list. + (find-function-read-function): use `function-history'. + (find-function-do-it): new function. + (find-function): Remove optional arg. Use `find-function-do-it'. + (find-function-other-window): ditto. + (find-function-other-frame): ditto. + (find-function-at-point): new function. + +1997-09-26 Hrvoje Niksic + + * custom/cus-edit.el: Issue a message about loading customization + dependencies. + + * custom/wid-edit.el (widget-map-buttons): Fixed typo. + +1997-09-25 SL Baur + + * prim/files.el (after-find-file): Revert synch to Emacs 20 and + restore old directory creation behavior. + +1997-09-25 Hrvoje Niksic + + * custom/wid-edit.el (widget-button-or-field-extent): New + function. + (widget-next-button-or-field): Use it. + (widget-previous-button-or-field): Ditto. + (widget-move): Don't signal an error when there is only one widget + in the buffer. + (widget-push-button-value-create): Cache glyphs themselves, + instead of instantiators. + (widget-documentation-string-value-create): Better help echo + (widget-mouse-help): Use `functionp'. + (widget-echo-help): Ditto. + +1997-09-25 SL Baur + + * prim/glyphs.el (init-glyphs): Fix jpeg signature. + +1997-09-24 Jens-Ulrik Holger Petersen + + * modes/lazy-shot.el (lazy-shot-shot-function): make the message + be displayed as progress. + +1997-09-25 Hrvoje Niksic + + * comint/telnet.el: Minor custom changes. + + * custom/wid-edit.el (widget-field-action): Edit the value in the + minibuffer. + + * custom/cus-edit.el (custom-group-value-create): Renamed `Go to + Group' tag to `Open'. + + * custom/wid-edit.el (widget-shadow-subrs): New variable. + (widget-url-link-help-echo): New function. + (url-link): Use it. + (widget-emacs-library-link-help-echo): New function. + (emacs-library-link): Use it. + +1997-09-24 Hrvoje Niksic + + * custom/wid-edit.el (widget-glyph-insert-glyph): Encode the + widget information to extent, not to the glyph. + (widget-glyph-click): Extract the widget from the extent, not the + glyph. + (widget-glyph-find): Set up a glyph cache. + + * prim/about.el: Use :button-prefix and :button-suffix instead of + the variables. + + * custom/wid-edit.el (widget-field-keymap): Bind Sh-TAB to + `widget-backward'. + (widget-specify-field): Use extents, not overlays. + (widget-specify-button): Ditto. + (widget-specify-sample): Ditto. + (widget-specify-inactive): Ditto. + (widget-button-click): Ditto. + (widget-field-value-create): Ditto. + (widget-field-value-delete): Ditto. + (widget-color-notify): Ditto. + (widget-setup): Ditto. + (widget-map-buttons): Use `map-extents'. + (widget-keymap): Made `global-map' its parent. + (widget-next-button-or-field): New function. + (widget-previous-button-or-field): Ditto. + (widget-move): Use them. + + * custom/custom.el (custom-group-hash-table): Use + `make-hashtable', with initial size 300. + (custom-add-to-group): Update hash-table unconditionally. + +1997-09-24 SL Baur + + * prim/packages.el (packages-useful-lisp): Arrange to bytecompile + shadow.elc early. + +1997-09-22 Karl M. Hegbloom + + * x11/x-toolbar.el (Info-frame-plist): Added. + (toolbar-info) Use new plist variable to make-frame. + +1997-09-24 Hrvoje Niksic + + * custom/wid-edit.el (widget-button1-click): Would bug out on + events with no bindings. + + * custom/cus-edit.el (custom-group-value-create): Update members + after loading the widget. + (custom-group-link-help-echo): New function. + (custom-group-link): Use it. + + * prim/cus-load.el (custom-put): Update + `custom-parent-hash-table'. + + * custom/cus-edit.el (custom-add-parent-links): Use + `custom-group-hash-table' to map the groups. + + * custom/custom.el (custom-parent-hash-table): New variable. + (custom-add-to-group): Use it. + + * prim/cus-load.el: Don't issue message for every loaded file. + + * custom/cus-edit.el (custom-group-prompt): New function. + (customize): Use it. + (customize-other-window): Ditto. + + * custom/wid-edit.el (widget-field-keymap): Bind TAB to + `widget-forward'. + +1997-09-23 Hrvoje Niksic + + * custom/cus-edit.el: Use `display-message' to indicate progress + messages. + (customize-set-variable): Use the third argument to `get'. + (customize-save-variable): Ditto. + (custom-variable-value-create): Ditto. + (custom-variable-state-set): Ditto. + (custom-variable-set): Ditto. + (custom-variable-save): Ditto. + (custom-variable-reset-saved): Ditto. + (custom-variable-reset-standard): Ditto. + + * custom/cus-edit.el: Removed C-coded routines. + + * custom/cus-edit.el (custom-buffer-create-internal): Print a + limited number of messages. + (custom-group-value-create): Ditto. + + * custom/wid-edit.el (widget-editable-list-value-get): Revert to + `append'. + +1997-09-22 Colin Rafferty + + * modes/lazy-shot.el (lazy-shot-shot-function): Made it do its + work in the correct buffer. Also, changed obsolete + function call to non-obsolete version. + +1997-09-22 Colin Rafferty + + * utils/shadow.el (find-emacs-lisp-shadows): Removed extra slash + between directory and filename. + +1997-09-23 SL Baur + + * ilisp/Makefile (SHELL): Remove dependency on /bin/csh. + +1997-09-23 Hrvoje Niksic + + * custom/wid-edit.el (widget-move): Use `incf'. + (widget-after-change): Ditto. + (widget-field-value-get): Ditto. + (widget-info-link-help-echo): New function. + (info-link): Use it. + + * custom/cus-edit.el (custom-last): Removed. + (custom-buffer-create-internal): Use `incf'. + (custom-group-value-create): Ditto. + + * packages/auto-save.el: Minor custom fixes. + + * prim/cus-dep.el (Custom-make-dependencies): Generate correct + output wrt `custom-put'. + + * custom/wid-edit.el (widget-tabable-at): Use `widget-at'. + + * custom/cus-edit.el (custom-group-value-create): Use + `custom-group-visibility' instead of `group-visibility'. + + * prim/help.el (help-map): Bound `C-h C' to `customize'. + + * custom/wid-edit.el (widget-princ-to-string): Don't use `let'. + (widget-clear-undo): Removed current-buffer argument. + (widget-choose): Use minibuffer when there are more than 10 items. + +1997-09-22 Hrvoje Niksic + + * custom/cus-edit.el (custom-button-face): Made it bold. + (custom-group-value-create): Change outlook of buffer. + (custom-buffer-create-internal): Ditto. + (custom-menu-nesting): Removed -- was unused by XEmacs. + (custom-menu-create): Don't use `custom-menu-nesting'. + (custom-group-menu-create): Define unconditionally. + (customize-menu-create): Ditto. + (custom-unlispify-menu-entry): Use `with-current-buffer'. + + * custom/wid-edit.el (widget-checklist-match-inline): Revert to + `append'. + (widget-checklist-value-get): Ditto. + (widget-editable-list-match-inline): Ditto. + (widget-group-match-inline): Ditto. + (widget-glyph-find): Removed compatibility checks; use + `locate-data-directory'. + (widget-glyph-find): Use backquotes. + (widget-push-button-value-create): Ditto. + (widget-choice-mouse-down-action): Don't use `window-system'. + (widget-transpose-chars): New function. + (widget-text-keymap): Use it. + (widget-princ-to-string): Use `with-current-buffer'. + (widget-map-buttons): Ditto. + (widget-push-button-gui): Set to value of `widget-glyph-enable' by + default. + (widget-push-button-value-create): Call `widget-specify-button'. + + * utils/mail-extr.el: Customized. + +1997-09-21 SL Baur + + * packages/man.el: Reverse manual prefix patch. + +1997-09-21 Karl M. Hegbloom + + * packages/man.el: Got rid of the `stars', and hard coded a prefix + of "Man: " for manual-entry buffers. + +1997-09-21 Hrvoje Niksic + + * custom/cus-face.el (frame-background-mode): Renamed from + `custom-background-mode'. + (frame-background-mode): Rewritten. + + * x11/x-menubar.el: Customized. + + * custom/cus-face.el (face-spec-set-match-display): Use `warn' for + warnings. + + * x11/x-font-menu.el: Customized. + + * modes/reftex.el: Add prefixes to customization groups. + + * custom/cus-edit.el (customize): Accept GROUP. + (customize-group): Defalias to `customize'. + (customize-other-window): New function. + (customize-group-other-window): Alias to `customize-other-window'. + + * custom/wid-edit.el (widget-choose): Now works with + `widget-menu-minibuffer-flag' set to nil. + (widget-menu-minibuffer-flag): Default to nil. + (widget-specify-insert): Use new blackquote syntax. + (widget-checklist-value-get): Ditto. + (widget-map-buttons): Ditto. + (widget-checklist-match-inline): Ditto. + (widget-editable-list-match-inline): Ditto. + (widget-group-match-inline): Ditto. + (widget-checklist-match-inline): Use `nconc'. + (widget-keymap): Bind `M-tab' to `widget-backward'. + + * prim/help.el (find-function-noselect): `locate-library' is + compression-aware; don't duplicate the work. + + * prim/packages.el (packages-hardcoded-lisp): Remove "cl-defs". + + * custom/wid-edit.el: Use `remove-if'. + (widget-glyph-directory): Use `locate-data-directory'. + + * custom/cus-edit.el (custom-unlispify-remove-prefixes): Default + to t. + + * custom/wid-edit.el: Removed *lots* of compatibility stuff. + + * custom/wid-edit.el: (widget-editable-list-value-get): Apply + `nconc' instead of `append'. + + * custom/wid-edit.el: Ditto. + + * custom/cus-edit.el: Ditto. + + * custom/custom.el: Use `mapc' instead of `mapcar', where + appropriate. + + * custom/wid-edit.el: Ditto. + + * custom/cus-edit.el: Ditto. + + * custom/custom.el: Ditto. + + * custom/widget.el: Don't define widget keywords. + +1997-09-21 Joel Peterson + + * prim/menubar.el: use normalize-menu-item-name instead of downcase + to compare menu item names. + 1997-09-20 Hrvoje Niksic * packages/etags.el: Lots of changes. diff -r 2947057885e5 -r a2f645c6b9f8 lisp/calendar/custom-load.el --- a/lisp/calendar/custom-load.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/calendar/custom-load.el Mon Aug 13 09:59:05 2007 +0200 @@ -1,5 +1,13 @@ +;;; custom-load.el --- automatically extracted custom dependencies + +;; Created by SL Baur on Sat Sep 27 08:13:36 1997 + +;;; Code: + (custom-put 'holidays 'custom-loads '("calendar")) (custom-put 'calendar 'custom-loads '("calendar")) (custom-put 'local 'custom-loads '("calendar")) (custom-put 'diary 'custom-loads '("calendar")) (custom-put 'appt 'custom-loads '("appt")) + +;;; custom-load.el ends here diff -r 2947057885e5 -r a2f645c6b9f8 lisp/cc-mode/custom-load.el --- a/lisp/cc-mode/custom-load.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/cc-mode/custom-load.el Mon Aug 13 09:59:05 2007 +0200 @@ -1,1 +1,9 @@ +;;; custom-load.el --- automatically extracted custom dependencies + +;; Created by SL Baur on Sat Sep 27 08:13:38 1997 + +;;; Code: + (custom-put 'c 'custom-loads '("cc-vars")) + +;;; custom-load.el ends here diff -r 2947057885e5 -r a2f645c6b9f8 lisp/comint/custom-load.el --- a/lisp/comint/custom-load.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/comint/custom-load.el Mon Aug 13 09:59:05 2007 +0200 @@ -1,3 +1,9 @@ +;;; custom-load.el --- automatically extracted custom dependencies + +;; Created by SL Baur on Sat Sep 27 08:13:39 1997 + +;;; Code: + (custom-put 'ssh 'custom-loads '("ssh")) (custom-put 'telnet 'custom-loads '("telnet")) (custom-put 'shell 'custom-loads '("shell")) @@ -10,3 +16,5 @@ (custom-put 'processes 'custom-loads '("background" "comint" "rlogin" "shell" "ssh")) (custom-put 'background 'custom-loads '("background")) (custom-put 'unix 'custom-loads '("rlogin" "shell" "ssh")) + +;;; custom-load.el ends here diff -r 2947057885e5 -r a2f645c6b9f8 lisp/comint/telnet.el --- a/lisp/comint/telnet.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/comint/telnet.el Mon Aug 13 09:59:05 2007 +0200 @@ -54,7 +54,7 @@ (require 'comint) (defgroup telnet nil - "Telnet/rsh stuff" + "Run a telnet session from within an Emacs buffer." :group 'comint) (defvar telnet-new-line "\r") @@ -76,6 +76,7 @@ (defcustom telnet-program "telnet" "*Program to run to open a telnet connection." + :type 'string :group 'telnet) (defcustom rsh-eat-password-string nil diff -r 2947057885e5 -r a2f645c6b9f8 lisp/custom/ChangeLog --- a/lisp/custom/ChangeLog Mon Aug 13 09:58:32 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,3448 +0,0 @@ -Fri Sep 19 11:21:15 1997 Per Abrahamsen - - * Version 1.9960 released. - -Fri Sep 19 11:16:37 1997 Per Abrahamsen - - * Version 1.9959 released. - -Mon Sep 15 19:40:19 1997 Per Abrahamsen - - * Version 1.9958 released. - -Mon Sep 15 19:23:36 1997 Hrvoje Niksic - - * cus-edit.el (custom-menu-create): First load symbol - dependencies, then create menus. - [ Patch modified by Per Abrahamsen ] - -Mon Sep 08 19:56:06 1997 Per Abrahamsen - - * Version 1.9957 released. - -Tue Aug 26 19:43:14 1997 Per Abrahamsen - - * custom.el (custom-declare-variable): Changed default initializer - to `custom-initialize-reset'. - - * cus-edit.el (custom-variable-save): Fixed doc string. - -Fri Aug 15 12:34:58 1997 Per Abrahamsen - - * cus-edit.el (custom-variable-menu): Make it clear that `Lisp - mode' edit the initial lisp expression. - -Wed Aug 13 13:04:36 1997 Per Abrahamsen - - * Version 1.9956 released. - -Wed Aug 13 00:28:59 1997 Per Abrahamsen - - * cus-face.el (make-empty-face): Make it work on Emacsen compiled - without X support. - - * Version 1.9955 released. - -Wed Aug 13 00:28:15 1997 Per Abrahamsen - - * wid-edit.el (widget-before-change): Don't complain if - `inhibit-read-only' is non-nil. - -Mon Aug 11 17:55:02 1997 Per Abrahamsen - - * cus-face.el (custom-face-attributes): Don't initialize fg/bg - fields. - -Wed Jul 30 14:04:28 1997 Per Abrahamsen - - * cus-edit.el: Synched with FSF. - -Tue Jul 29 07:17:54 1997 Per Abrahamsen - - * widget.texi (Programming Example): Also delete overlays. - -Mon Jul 28 20:31:22 1997 Per Abrahamsen - - * Version 1.9954 released. - -Mon Jul 28 19:23:37 1997 Per Abrahamsen - - * cus-edit.el (hook): Support hooks whose value is just a symbol. - - * cus-edit.el (custom-magic-value-create): Support `mismatch' - form. - (custom-variable-value-create): Ditto. - (custom-variable-set): Ditto. - (custom-variable-save): Ditto. - (custom-variable-menu): Ditto. - - * Version 1.9953 released. - -Mon Jul 28 18:04:46 1997 Per Abrahamsen - - * wid-edit.el (widget-field-add-space): Default to t on all - plaforms. - - * custom.el (defgroup): Doc fix. - Patch by karlheg+xemacs@inetarena.com (Karl M. Hegbloom). - - * wid-edit.el (functionp): Use `byte-code-function-p' instead of - `compiled-function-p'. - - * Version 1.9952 released. - -Mon Jul 28 17:52:55 1997 Per Abrahamsen - - * wid-edit.el (functionp): Use `compiled-function-p' instead of - `byte-code-function-p'. - (widget-map-buttons): Comment out `parent'. - (widget-insert): Don't bind `from'. - (widget-move): Dont' bind `new' at start. - - * cus-edit.el (custom-buffer-create-internal): Refer to `mouse-2' - instead of `mouse-1'. - (customize-browse): Ditto. - (custom-mode-map): Don't bind `mouse-1'. - (custom-load-symbol): Check that `preloaded-file-list' is bound. - (custom-group-value-create): Comment out `indent'. - - * all: Synched with FSF. - -Sat Jul 12 01:24:32 1997 Per Abrahamsen - - * Version 1.9951 released. - -Sat Jul 12 00:29:33 1997 Per Abrahamsen - - * cus-edit.el (customize-save-variable): New command. - - * wid-edit.el (widget-move): Use `previous-overlay-change' and - `next-overlay-change'. - (widget-use-overlay-change): New option to control it. - -Fri Jul 11 14:25:34 1997 Per Abrahamsen - - * cus-edit.el (custom-save-all): Inhibit read only. - Reported by Simon Marshall . - - * wid-edit.el (regexp): Outcomment :value-face. - (file): Ditto. - -Thu Jul 10 16:13:36 1997 Per Abrahamsen - - * Version 1.9950 released. - -Thu Jul 10 16:12:33 1997 Per Abrahamsen - - * wid-edit.el (widget-add-change): Use local hooks. - (widget-before-change): Ditto. - Suggested by Simon Marshall . - -Wed Jul 09 21:35:05 1997 Per Abrahamsen - - * Version 1.9949 released. - -Wed Jul 9 20:26:58 1997 Per Abrahamsen - - * widget.el (:doc-overlay): New keyword. - * wid-edit.el (set-text-properties): Don't define. - (widget-specify-none): Delete. - (widget-specify-text): Delete. - (widget-field-use-before-change): Don't enable for XEmacs. - (widget-specify-field): Don't use text properties. - (widget-specify-field): Ditto. - (widget-specify-doc): Ditto. - (widget-specify-insert): Ditto. - (widget-insert): Ditto. - (widget-convert-text): Ditto. - (widget-leave-text): Ditto. - (widget-setup): Ditto. - (widget-before-change): Ditto. - (widget-default-create): Ditto. - (widget-default-delete): Ditto. - (widget-editable-list-insert-before): Ditto. - (widget-editable-list-entry-create): Ditto. - (widget-add-change): New function. - - * cus-edit.el (custom-buffer-create-internal): Refer to `mouse-2' - instead of `mouse-1'. - (custom-mode-map): Don't bind `mouse-1'. - -1997-07-09 Steven L Baur - - * custom/cus-edit.el (custom-file): Use same logic as startup.el - -Tue Jul 08 13:30:11 1997 Per Abrahamsen - - * Version 1.9948 released. - -Tue Jul 8 11:34:44 1997 Per Abrahamsen - - * wid-edit.el (widget-field-use-before-change): Doc fix. - -1997-07-08 Steven L Baur - - * cus-edit.el (custom-file): Rename .xemacs-custom to something - more general. - -Mon Jul 07 14:20:33 1997 Per Abrahamsen - - * Version 1.9947 released. - -Mon Jul 7 14:16:10 1997 Simon Marshall - - * cus-edit.el (custom-group-members): New function. - (custom-group-value-create): Use it rather than get. - -Mon Jul 7 11:39:31 1997 Per Abrahamsen - - * wid-edit.el (emacs-library-link): New widget. - (widget-emacs-library-link-action): New function. - Provided by Stephen Eglen . - -1997-07-06 Hrvoje Niksic - - * wid-edit.el (widget-beginning-of-line): Preserve zmacs region. - (widget-end-of-line): Ditto. - -Sun Jul 6 21:57:32 1997 Per Abrahamsen - - * wid-edit.el (widget-field-use-before-change): Enable for Emacs - 20. - -Fri Jul 04 16:24:21 1997 Per Abrahamsen - - * Version 1.9946 released. - -Fri Jul 4 15:31:45 1997 Per Abrahamsen - - * wid-edit.el (widget-color-sample-face-get): Kludge to make it - work before widget is fully created. - (widget-color-action): Try to use same relative position of point - in minibuffer as it had in the field. - - * cus-edit.el (custom-mode): Document `M-TAB'. - - * custom.texi (Usage for Package Authors): Fixed typo. - Patch by Adrian Aichner . - -Fri Jul 04 13:58:14 1997 Per Abrahamsen - - * all: Synched with FSF. - - * Version 1.9945 released. - -Fri Jul 4 12:40:13 1997 Per Abrahamsen - - * widget.el (:sample-overlay): New keyword. - * wid-edit.el (widget-leave-text): Use it. - (widget-specify-sample): Use it. - (widget-default-delete): Ditto. - (color): Make it an editable field. - (widget-color-value-create): Deleted. - (widget-color-value-get): Deleted. - (widget-color-value-set): Deleted. - (color-item): Deleted. - (widget-color-item-button-face-get): Renamed to - `widget-color-sample-face-get'. - (color-sample): Deleted. - (editable-color): Deleted. - (widget-editable-color-value-create): Deleted. - -Fri Jul 04 11:33:31 1997 Per Abrahamsen - - * all: Synched with FSF. - - * Version 1.9944 released. - -Fri Jul 4 11:32:04 1997 Per Abrahamsen - - * wid-edit.el (widget-specify-field): Add newline in overlay for - nil-:sized fields. - (widget-field-end): Ditto. - -Thu Jul 3 19:12:13 1997 Per Abrahamsen - - * wid-edit.el (emacs-library-link): New widget. - (widget-emacs-library-link-action): New function. - (widgets): Use it. - Suggested by Stephen Eglen . - (file-link): New widget. - (widget-file-link-action): New function. - -Wed Jul 02 17:44:40 1997 Per Abrahamsen - - * Version 1.9943 released. - -Wed Jul 2 17:35:42 1997 Per Abrahamsen - - * all: Synched with FSF. - -Wed Jul 02 17:19:13 1997 Per Abrahamsen - - * Version 1.9942 released. - -Wed Jul 2 17:18:08 1997 Per Abrahamsen - - * cus-edit.el (customize-browse): Use glyphs in description, if - possible. - -Mon Jun 30 17:07:20 1997 Per Abrahamsen - - * Version 1.9941 released. - -Mon Jun 30 17:02:21 1997 Per Abrahamsen - - * wid-edit.el (widget-menu-minibuffer-flag): Default to t on - XEmacs. - -Thu Jun 26 16:49:32 1997 Per Abrahamsen - - * Version 1.9940 released. - -Thu Jun 26 15:19:27 1997 Per Abrahamsen - - * wid-edit.el (widget-field-value-create): Add comment explaining - why `:field-overlay' contains two markers. - - * cus-edit.el (custom-browse-visibility, - custom-browse-visibility-action, custom-browse-group-tag, - custom-browse-group-tag-action, custom-browse-variable-tag-action, - custom-browse-face-tag, custom-browse-face-tag-action, - custom-browse-face-tag-action, custom-browse-alist): Changed - prefix from `custom-tree' to `custom-browse'. - (custom-variable-value-create, custom-face-value-create, - custom-group-value-create): Updated caller. - - * cus-edit.el (custom-browse-only-groups): New option. - (custom-group-value-create): Use it. Omit non-groups if non-nil. - Patch by Simon Marshall . - - * cus-edit.el (custom-help-menu): Renamed "Variable" to "Option". - Remove "..." from non-prompting entries. - Patch by Simon Marshall . - - * Version 1.9939 released. - -Thu Jun 26 15:16:15 1997 Per Abrahamsen - - * wid-edit.el (widget-single-line-field-face): New face. - (widget-single-line-display-table): New variable. - (regexp, file): Use `widget-single-line-field-face'. - Patch by Hrvoje Niksic . - -Wed Jun 25 20:23:52 1997 Per Abrahamsen - - * Version 1.9938 released. - -Wed Jun 25 17:46:18 1997 Per Abrahamsen - - * cus-edit.el (custom-unloaded-symbol-p): New function. - (custom-unloaded-widget-p): New function. - (custom-group-value-create): Use it. - (customize-browse): Mention [?]. - - * cus-edit.el (custom-toggle-hide): Load dependencies here. - - * wid-edit.el (functionp): New function. - - * Version 1.9937 released. - -Wed Jun 25 17:29:08 1997 Per Abrahamsen - - * widget.el (:match-alternatives): New keyword. - - * custom.el: Updated autoloads. - - * all: Synched with FSF. - -Tue Jun 24 16:27:41 1997 Per Abrahamsen - - * Version 1.9936 released. - -Tue Jun 24 14:35:17 1997 Per Abrahamsen - - * cus-edit.el (customize-browse): Take a group argument. - (custom-help-menu): Browse `emacs' group. - - * Version 1.9935 released. - -Tue Jun 24 14:31:53 1997 Per Abrahamsen - - * Version 1.9934 released. - -Tue Jun 24 14:30:26 MET DST 1997 Simon Marshall - - * cus-edit.el (custom-add-parent-links): Simplify mapatoms lambda. - (custom-browse): New group. - (custom-buffer-groups-last): - (custom-menu-groups-first): Options deleted. - (custom-browse-sort-alphabetically): - (custom-browse-order-groups): - (custom-buffer-order-groups): - (custom-menu-order-groups): New options. - (custom-browse-sort-predicate): - (custom-buffer-sort-predicate): - (custom-menu-sort-predicate): Functions deleted. - (custom-sort-items): New replacement function; simplification and - extension of previous predicate functions. - (customize-face): - (customize-customized): - (customize-saved): - (customize-apropos): - (custom-menu-create): - (custom-group-value-create): Use it. - -Tue Jun 24 11:46:40 1997 Per Abrahamsen - - * cus-edit.el (custom-tree-alist): Use "-\ " instead of "-+ ". - (custom-group-value-create): Ditto. - - * Version 1.9933 released. - -Tue Jun 24 11:32:55 1997 Per Abrahamsen - - * wid-edit.el (widget-button-click): Steal up event if key is not - bounbd in `widget-global-map'. - -Mon Jun 23 17:23:27 1997 Per Abrahamsen - - * Version 1.9932 released. - -Mon Jun 23 11:56:40 1997 Per Abrahamsen - - * cus-edit.el (custom-tree-insert-prefix): Renamed from - `custom-tree-insert'. - (custom-group-value-create): Use it. - - * wid-edit.el (widget-field-use-before-change): New option. - (widget-setup): Obey it. - - * cus-edit.el (custom-help-menu): Add entry for - `customize-browse'. - - * widget.texi: Change `@br' to `@*'. - Patch by Ralph Schleicher . - -Sat Jun 21 21:10:57 1997 Per Abrahamsen - - * Version 1.9931 released. - -Sat Jun 21 14:41:02 1997 Per Abrahamsen - - * face.xpm: New file. - * option.xpm: New file. - * folder.xpm: New file. - * Makefile (TEXT): Added. - * wid-edit.el (widget-push-button-value-create): Use :tag-glyph. - (widget-glyph-insert-glyph): Accept nil widget. - * cus-edit.el (custom-tree-group-tag): Specify :tag-glyph. - (custom-tree-variable-tag): Ditto. - (custom-tree-face-tag): Ditto. - - * Version 1.9930 released. - -Sat Jun 21 03:01:17 1997 Per Abrahamsen - - * all: Synched with FSF. - - * cus-edit.el (custom-buffer-indent): New option. - (custom-magic-value-create): Use it. - (custom-group-value-create): Ditto. - (custom-buffer-create-internal): Don't create parent groups here. - (custom-group-list): New variable. - (custom-add-parent-links): New function. - (custom-variable-value-create): Use it. - (custom-face-value-create): Use it. - (custom-group-value-create): Use it. - (custom-buffer-groups-last): Changed default. - - * wid-edit.el (group-visibility): Deleted. - (widget-group-visibility-create): Ditto. - (group-link): Deleted. - (widget-group-link-create): Ditto. - (widget-group-link-action): Ditto. - - * cus-edit.el (custom-nest-groups): Delete option. - (custom-buffer-style): Add `links' style instead. - (custom-group-link): New widget. - (custom-group-link-action): New function. - (custom-group-value-create): Use `custom-group-link'. - - * wid-edit.el (widget-before-change): Fixed comment and debug - string. - - * cus-edit.el (custom-mode-customize-menu): Deleted. - (custom-mode-menu): Define here. - (custom-mode): Don't add here. - (custom-format-handler): Deleted. - (custom): Don't add here. - - * all: Synched with FSF. - - * Version 1.9929 released. - -Sat Jun 21 02:05:08 1997 Per Abrahamsen - - * cus-edit.el (custom-browse-sort-predicate): New alias. - (custom-group-value-create): Use it. - (:custom-last): Replace :custom-extra-prefix. - (customize-browse): Use it. - (custom-group): Ditto. - (custom-group-value-create): Ditto. - - * Version 1.9928 released. - -Sat Jun 21 01:35:04 1997 Per Abrahamsen - - * cus-edit.el (face): Fixed format. - (custom-face-value-create): Browse face, not option. - - * Version 1.9927 released. - -Sat Jun 21 00:03:48 1997 Per Abrahamsen - - * cus-edit.el (custom-group-value-create): Rewrote to replace - entire format string. - (custom-variable-value-create): Ditto. - (custom-face-value-create): Ditto. - (custom-group): Delete :format. - (custom-variable): Ditto. - (custom-face): Delete :format and :format-handler. - (custom): Add :format. - (custom-format-handler): Removed unnecessary code. - (custom-face-format-handler): Deleted. - (custom-add-see-also): New function. - (custom-buffer-style): New option. - (widget-face-value-create): Use it here instead of :format. - (:custom-prefix, :custom-extra-prefix): New keywords. - (custom): Initialize them. - (custom-redraw-magic): Work with no magic button. - (customize-browse): New command. - (custom-tree-visibility): New widget. - (custom-tree-visibility-action): New function. - (custom-tree-group-tag): New widget. - (custom-tree-group-tag-action): New function. - (custom-tree-group-tag): New widget. - (custom-tree-group-tag-action): New function. - (custom-tree-variable-tag): New widget. - (custom-tree-variable-tag-action): New function. - (custom-tree-face-tag): New widget. - (custom-tree-face-tag-action): New function. - - * custom.el (customize-browse): Added autoload. - - * cus-edit.el (custom-buffer-sort-alphabetically): New option. - (custom-buffer-groups-last): New option. - (custom-buffer-sort-predicate): Use them. - (customize-apropos): Use it. - (custom-group-value-create): Ditto. - (custom-menu-sort-alphabetically): New option. - (custom-menu-groups-first): New option. - (custom-menu-sort-predicate): Use them. - (custom-menu-create): Use it. - (custom-buffer-sort-predicate, custom-buffer-order-predicate, - custom-menu-sort-predicate, custom-menu-order-predicate): Deleted. - -Thu Jun 19 17:29:05 1997 Per Abrahamsen - - * Version 1.9926 released. - -Thu Jun 19 13:31:08 1997 Per Abrahamsen - - * wid-edit.el (widget-leave-text): Don't delete nil overlays. - - * wid-edit.el (widget-get-indirect): New function. - (widget-default-create): Use it. - (widget-button-insert-indirect): Deleted. - - * wid-edit.el (widget-inactive-face): Use dim gray instead of dark - gray. - - * Version 1.9925 released. - -Thu Jun 19 12:09:32 1997 Per Abrahamsen - - * Synched with FSF. - - * Version 1.9924 released. - -Thu Jun 19 11:05:38 1997 Per Abrahamsen - - * cus-edit.el (customize-apropos): Always sort apropos. - Patch by Simon Marshall . - - * Version 1.9923 released. - -Thu Jun 19 10:59:26 1997 Per Abrahamsen - - * cus-edit.el (custom-reset-saved): Call :custom-reset-saved. - (custom-reset-standard): Call :custom-reset-standard. - - * Version 1.9922 released. - -1997-06-18 Steven L Baur - - * cus-edit.el (custom-file): Autoload, and use ~/.xemacs-custom - for XEmacs. - -Wed Jun 18 18:37:00 1997 Per Abrahamsen - - * cus-edit.el (custom-buffer-create-internal): Change parent tag. - - * Version 1.9921 released. - - * cus-edit.el (custom-buffer-create-internal): Add links to parent - groups when there is only a single item in the buffer. - -Wed Jun 18 13:49:20 1997 Simon Marshall - - * cus-edit.el (customize-apropos): Extend ALL arg to restrict - apropos to options, groups and faces. Doc fix. - (customize-apropos-options): - (customize-apropos-faces): - (customize-apropos-groups): New commands. Call it. - (custom-help-menu): Add commands to menu. - -Mon Jun 16 11:57:14 1997 Per Abrahamsen - - * wid-edit.el (widget-documentation-link-add): Only highlight text - inside link. - Patch by Simon Marshall . - -1997-06-16 Hrvoje Niksic - - * wid-edit.el (widget-specify-field): Place unreadable - text-property correctly when `widget-field-add-space' is non-nil. - -Sun Jun 15 17:21:34 1997 Per Abrahamsen - - * all: Synched with FSF. - - * Version 1.9920 released. - -Sun Jun 15 14:06:49 1997 Per Abrahamsen - - * cus-edit.el (custom-variable-menu): Rearranged lisp support. - (custom-face-menu): Ditto. - - * wid-edit.el (boolean): Add explicit toggle button. - (choice): Add explicit value menu button. - * cus-face.el (custom-face-attributes): Use booleans. - - * cus-edit.el (custom-format-handler): Handle %i escape. - (custom-face): Use it. - (custom-magic-value-create): Add spaces for groups. - (custom-format-handler): Add spaces for groups. - - * widget.el (:documentation-indent): New keyword. - * wid-edit.el (widget-default-format-handler): Obey it. - (widget-documentation-link-add): Add indentation. - (widget-documentation-string-value-create): Ditto. - - * Version 1.9919 released. - -Sun Jun 15 13:02:02 1997 Per Abrahamsen - - * cus-edit.el (widget-glyph-insert-glyph): Make the invisible - extent open ended. - - * cus-edit.el (custom-format-handler): Added :echo-help to - visibility widget. - (custom-variable-value-create): Ditto, also for tag. - * wid-edit.el (widget-documentation-string-value-create): Ditto. - (widget-documentation-link-help-echo): New function. - (documentation-link): Use it. Make untabable. - -Sat Jun 14 21:57:49 1997 Per Abrahamsen - - * Version 1.9918 released. - -Sat Jun 14 21:31:09 1997 Per Abrahamsen - - * wid-edit.el (widget-apply-action): Don't bind - `after-change-functions' here. - - * cus-edit.el (custom-toggle-hide): Call `widget-setup'. - - * wid-edit.el (widget-setup): Cleanup. - - * Version 1.9916 released. - -Sat Jun 14 18:24:36 1997 Per Abrahamsen - - * wid-edit.el (widget-tabable-at): New function. - (widget-move): Use it. - * wid-edit.el (widget-after-change): Reimplemented :secret. - - * wid-edit.el (widget-field-add-space): New option. - (widget-specify-field): Use it. - (widget-field-end): Ditto. - - * Version 1.9915 released. - -Sat Jun 14 12:12:38 1997 Per Abrahamsen - - * wid-edit.el (widget-leave-text): New function. - (widget-convert-text): Use it. - (documentation-link): New widget. - (widget-documentation-link-action): New function. - (widget-documentation-links): New option. - (widget-documentation-link-regexp): New option. - (widget-documentation-link-p): New option. - (widget-documentation-link-type): New option. - (widget-documentation-link-add): New function. - (widget-documentation-string-value-create): Use it. - - * all: Synched with FSF. - -Fri Jun 13 20:25:55 1997 Per Abrahamsen - - * Version 1.9914 released. - -1997-06-10 MORIOKA Tomohiko - - * wid-edit.el: Add widget `coding-system' for mule. - -Fri Jun 13 14:28:41 1997 Per Abrahamsen - - * wid-edit.el (widget-convert-text): New function. - (widget-convert-button): Ditto. - - * custom.texi: Use ../info/custom as file name. - (Declaring Variables): Reformulation. - Ispelled. - * widget.texi: Use ../info/widget as file name. - Ispelled. - -Thu Jun 12 19:22:22 1997 Per Abrahamsen - - * Version 1.9913 released. - -Thu Jun 12 12:15:33 1997 Per Abrahamsen - - * wid-edit.el (widget-field-buffer): Don't assume an overlay - exists. - (widget-field-start): Ditto. - (widget-field-end): Ditto. - - * cus-face.el (custom-face-attributes-get): Protect against - missing w3 font functions. - - * Version 1.9912 released. - -Thu Jun 12 12:14:30 1997 Per Abrahamsen - - * cus-edit.el (custom-magic-faces): New group. - Added magic faces. - -Wed Jun 11 20:15:33 1997 Per Abrahamsen - - * Version 1.9911 released. - -Wed Jun 11 14:35:58 1997 Per Abrahamsen - - * cus-edit.el (custom-buffer): New group. - (custom-menu): New group - Updated options. - * wid-edit.el (widget-faces): New group. - Updated all faces. - - * wid-edit.el (widget-map-buttons): New function. - Written by William M. Perry . - - * Version 1.9910 released. - -Wed Jun 11 13:35:16 1997 Simon Marshall - - * cus-edit.el (custom-buffer-sort-predicate): - (custom-menu-sort-predicate): Default to ignore. Rewrite :type form. - (custom-buffer-order-predicate): - (custom-menu-order-predicate): New variables. - (custom-buffer-sort-alphabetically): - (custom-menu-sort-alphabetically): Functions deleted. - (custom-sort-items-alphabetically): New function. Like deleted - functions, except that A and B must be the same custom type. - (custom-sort-groups-first): - (custom-sort-groups-last): New functions. Like deleted functions, - except that only A and B custom types are compared. - (custom-group-value-create): - (custom-menu-create): Also sort members using custom-*-order-predicate. - But sort the copy of the stored sequence to prevent changing the stored - value, and don't store the sorted copy. - -Wed Jun 11 11:10:18 1997 Per Abrahamsen - - * Version 1.9909 released. - -Wed Jun 11 10:13:05 1997 Per Abrahamsen - - * wid-edit.el (widget-specify-inactive): Don't set `mouse-face'. - (widget-setup): Don't use markers. - -Tue Jun 10 13:55:38 1997 Per Abrahamsen - - * wid-edit.el (widget-default-format-handler): Cleanup. - (widget-documentation-string-value-create): Also use documentation - properties on single line documentation strings. - -Mon Jun 9 06:21:49 1997 William M. Perry - - * wid-browse.el (widget-minor-mode): Fixed mistake in - widget-minor-mode - it had semantics of non-interactive calling - reveresed. - -Wed Jun 4 13:44:33 1997 Per Abrahamsen - - * all: Synched with FSF. - -Wed Jun 04 13:24:36 1997 Per Abrahamsen - - * Version 1.9908 released. - -Tue Jun 3 02:46:21 1997 Per Abrahamsen - - * wid-edit.el (widget-kill-line): Fixed for overlays. - Reported by Hrvoje Niksic . - - * cus-edit.el (custom-buffer-create-internal): Show full - documentation string in buffers with only a single item. - Suggested by Steven L Baur . - - * cus-edit.el (custom-mode-map): Suppress keymap. - -Tue Jun 03 02:05:13 1997 Per Abrahamsen - - * Version 1.9907 released. - -Tue Jun 3 00:22:44 1997 Per Abrahamsen - - * wid-edit.el (widget-beginning-of-line): Work with overlays. - (widget-end-of-line): Ditto. - (widget-specify-inactive): Use inactive for mouse-face as well. - (widget-read-event): New alias. - (widget-button-click): Use it. - Don't execute up events twice. - (widget-field-end): Workaround for local-map at - end of overlay. - (widget-specify-field): Ditto. - (widget-move): Fixed but with single button buffers. - -Mon Jun 2 23:09:33 1997 Per Abrahamsen - - * cus-edit.el (custom-buffer-create-internal): Improved help - strings for reset buttons. - - * wid-edit.el (widget-move): Restored support for - `widget-echo-help' and `widget-move-hook'. - (widget-documentation-string-value-create): Restore support for - `widget-documentation--face'. - -1997-06-02 Steven L Baur - - * cus-edit.el (customize-variable-other-window): Added defalias. - -Mon Jun 2 21:03:14 1997 Per Abrahamsen - - * widget.el (:complete): New keyword. - (:complete-function): New keyword. - * wid-edit.el (widget-complete): New command. - (widget-keymap): Bind it. - (widget-complete-field): New option. - (widget-default-complete): New function. - (default): Bind :complete. - (string): Bind :complete-function. - (sexp): Ditto. - -Mon Jun 02 20:39:28 1997 Per Abrahamsen - - * Version 1.9906 released. - -Mon Jun 2 23:26:11 1997 Hrvoje Niksic - - * wid-edit.el (widget-glyph-find): Would infloop when file not found. - -Mon Jun 2 17:54:43 1997 Per Abrahamsen - - * wid-edit.el (widget-glyph-find): Try to avoid pure text glyphs. - (widget-glyph-insert): Update doc string. - Patch by Hrvoje Niksic . - - * wid-edit.el (widget-button-click): Didn't restore `mouse-face'. - -Sun Jun 1 20:29:18 1997 Per Abrahamsen - - * widget.texi (editable-field): Removed :hide-front-space and - :hide-rear-space. - * widget.el: Ditto. - -Sun Jun 01 19:55:00 1997 Per Abrahamsen - - * Version 1.9905 released. - -Sun Jun 1 13:24:07 1997 Per Abrahamsen - - * wid-edit.el: Changed to overlays. - * cus-edit.el (custom-buffer-create-internal): Remove kludge for - getting read-only bob and eob in XEmacs. - * wid-browse.el (widget-browse-at): Use `get-char-property' - instead of `get-text-property'. - * widget.el (:value-from :value-to): Deleted. - * widget.el (:button-overlay, :field-overlay): New keywords. - * wid-edit.el (widget-default-delete): Delete overlays. - (widget-field-value-delete): Delete overlay. - - * wid-edit.el (widget-specify-field-update): Specify both - `ballon-help' and `help-echo'. - -Sun Jun 01 13:13:40 1997 Per Abrahamsen - - * Version 1.9904 released. - -Sun Jun 1 06:34:54 1997 Per Abrahamsen - - * wid-edit.el (visibility): Change "more" to "show". - - * cus-edit.el (:custom-category): New keyword. - (custom-variable): Add it. - (custom-face): Ditto. - (custom-group): Ditto. - (custom-magic-value-create): Replace %c with category in state - text. - (custom-magic-alist): Use it. - (custom-magic-show-hidden): Allow control on each custom - category. - (custom-magic-value-create): Ditto. - (custom-reset-current): Ignore extra arguments. - (custom-reset-saved): Ditto. - (custom-reset-standard): Ditto. - (custom-reset-button-menu): New option. - (custom-buffer-create-internal): Use it. - - * cus-edit.el (customize-variable): Uncomment alias. - - * all: Synched with FSF. - - * cus-edit.el (custom-format-handler): Cleanup. - - * wid-edit.el (widget-kill-line): Use forward-line instead of - search-forward. - Suggested by Hrvoje Niksic . - - * cus-edit.el (custom-magic-value-create): Cleanup. - - * wid-edit.el (set-text-properties): Redefine for broken XEmacsen. - (widget-field-value-get): Remove workaround. - (widget-specify-button): Specify both `ballon-help' and `help-echo'. - -Sat May 31 10:41:00 1997 Per Abrahamsen - - * Version 1.9903 released. - -Sat May 31 08:44:20 1997 Per Abrahamsen - - * Version 1.9902 released. - -Sat May 31 08:10:49 1997 Per Abrahamsen - - * all: Synched with FSF. - - * Version 1.9901 released. - -Sat May 31 03:26:11 1997 Per Abrahamsen - - * cus-edit.el (custom-format-handler): Don't show links for hidden - items. - - * wid-edit.el (widget-button-prefix): Move to `widget-button' group. - (widget-button-suffix): Ditto. - - * cus-edit.el (custom-format-handler): New %e and %- escapes. - (custom-group): Use them. - - * widget.el (:widget-doc): Removed keyword. - * wid-edit.el (widget-help): Removed widget. - (widget-help-action): Removed function. - - * widget.el (:documentation-shown): New keyword. - * wid-edit.el (documentation-string): New widget. - (widget-documentation-string-value-create): New function. - (widget-documentation-string-action): New function. - (widget-default-format-handler): Use them. - * cus-edit.el (custom-toggle-hide): Hide documentation. - - * cus-edit.el (custom-buffer-sort-predicate): Fix :type. - (custom-menu-sort-predicate): Ditto. - - * right.xpm: New file. - * right-pushed.xpm: New file. - * down.xpm: New file. - * down-pushed.xpm: New file. - * Makefile (TEXT): Add them - * wid-edit.el (visibility): New widget. - (widget-visibility-value-create): New function. - (widget-glyph-find): New function. - (widget-glyph-insert): Use it. - * cus-edit.el (custom-variable-menu, custom-face-menu, - custom-group-menu): Remove `Hide' entry. - (custom-magic-show-hidden): New option. - (custom-magic-value-create): Use it. - (custom-face): Show visibility. - - * custom.texi (The Variable Options): Use dots to show value. - (The Face Options): Ditto. - - * cus-edit.el (custom-load-symbol): More code to avoid recursion. - Patch by RMS. - -Fri May 30 04:44:37 1997 Hrvoje Niksic - - * wid-edit.el (widget-glyph-insert-glyph): Clean up. - -Fri May 30 01:50:05 1997 Per Abrahamsen - - * all: Synched with FSF. - - * cus-edit.el (custom-variable-action): Clarified prompt. - (custom-face-action): Ditto. - (custom-group-action): Ditto. - - * Version 1.9900 released. - -Fri May 30 01:02:57 1997 Per Abrahamsen - - * cus-edit.el (custom-face-set): Call `face-spec-set' instead of - `custom-face-display-set'. - (custom-face-save): Ditto. - (custom-face-reset-saved): Ditto. - (custom-face-reset-standard): Ditto. - - * cus-edit.el (custom-buffer-sort-predicate): New option. - (custom-buffer-sort-alphabetically): New function. - (custom-group-value-create): Use them. - (custom-menu-sort-predicate): New option. - (custom-menu-sort-alphabetically): New function. - (custom-menu-create): Use them. - - * cus-edit.el (custom-magic-alist): Shortened message. - -Thu May 29 00:09:41 1997 Per Abrahamsen - - * cus-edit.el: (custom-help-menu): Updated names. - - * cus-edit.el: Say `invoke' instead of `activate'. - - * wid-edit.el: Ditto. - * widget.texi: Ditto. - * custom.texi Ditto. - - * wid-edit.el (widget-help): Fix format string. - -Wed May 28 17:00:23 1997 Per Abrahamsen - - * cus-edit.el (custom-magic-value-create): Use push button - brackets around state button. - (custom-magic-value-create): Indent with three spaces. - - * cus-face.el (face-spec-set-match-display): Change error for - unknown requirement to warning. - Suggested by Hrvoje Niksic . - -Tue May 27 23:37:26 1997 Per Abrahamsen - - * wid-edit.el (widget-link-prefix): Change to "[". - (widget-link-suffix): Change to "]". - -Tue May 27 20:30:52 1997 Hrvoje Niksic - - * wid-edit.el (widget-color-item-button-face-get): Don't require - facemenu for XEmacs. - (widget-glyph-insert): Would bug out. - -Tue May 27 16:19:16 1997 Per Abrahamsen - - * Version 1.98 released. - -Mon May 26 22:29:22 1997 Per Abrahamsen - - * wid-edit.el (widget-glyph-directory): Fix doc. string. - (widget-image-conversion): New option. - (widget-glyph-insert): Use it. - (widget-glyph-insert-glyph): No tag here. - (widget-push-button-value-create): But here. - Patch by Hrvoje Niksic . - - * wid-edit.el (widget-field-face): Changed to dim gray. - Suggested by Simon Marshall . - -Sat May 24 00:07:50 1997 Per Abrahamsen - - * widget.texi (push-button): Documented new options. - (link): Ditto. - (Basic Types): Documented new keywords. - - * wid-edit.el (widget-push-button-prefix): New option. - (widget-push-button-suffix): New option. - (widget-button): New group. - - * widget.el (:text-format): Removed. - (:button-suffix): New keyword. - (:button-prefix): New keyword. - - * wid-edit.el (widget-button-prefix): New variable. - (widget-button-suffix): New variable. - (widget-insert-indirect): New function. - (widget-default-create): Use it. - (default): Bind them. - (widget-link-prefix): New option. - (widget-link-suffix): New option. - (link): Use them. - (push-button): Don't use `:text-format'. - (widget-push-button-value-create): Ditto. - (widget-help): Update format. - (checkbox): Ditto. - (radio-button): Ditto. - -Fri May 23 23:54:11 1997 Per Abrahamsen - - * cus-edit.el (custom-magic-alist): Use `activate' instead of - `push'. - * custom.texi (The Face Options): Ditto. - * widget.texi (Introduction): Ditto. - -Thu May 22 12:49:36 1997 Per Abrahamsen - - * cus-edit.el (custom-magic-alist): Changed rogue state message. - - * custom.el (defface): Doc fix. - -Tue May 20 19:17:01 1997 Steven L Baur - - * cus-edit.el (mule): New group for MULE merged emacsen. - (auto-save): Spelling fix. - -Thu May 15 10:47:20 1997 Per Abrahamsen - - * custom.texi (User Commands): Updated documentation. - - * cus-edit.el, custom.el: Renamed `factory' to `standard' - everywhere. - - * cus-edit.el (custom-magic-show-button): Changed default to - `nil'. - (custom): Removed `:format'. - (custom-variable): Removed level button. - (custom-face): Ditto. - (custom-level): Deleted. - (custom-level-action): Deleted. - (custom-format-handler): Update caller. - (custom-group-magic-alist): Merged into `custom-magic-alist'. - (custom-magic-value-create): Use merged `custom-magic-alist'. - (custom-group-state-update): Ditto. - -Wed May 14 19:47:35 1997 Per Abrahamsen - - * all: Synched with FSF. - -Tue May 13 16:05:34 1997 Per Abrahamsen - - * cus-edit.el (windows): Move to environment. - - * Version 1.97 released. - -Fri May 9 12:33:34 1997 Per Abrahamsen - - * wid-edit.el (widget-field-value-get): Add workaround for XEmacs - bug with `buffer-substring-no-properties'. - - * widget.texi (atoms): Documented `function', `variable', and - `regexp' widgets. - -Thu May 8 14:35:48 1997 Per Abrahamsen - - * custom.el (defcustom): Don't wrap in `eval-and-compile'. - - * wid-edit.el (widget-value-convert-widget): Don't convert :value - here. - - * cus-edit.el (custom-buffer-create-internal): New kludge for - making bib and eob read-only in XEmacs. - Kludge by Hrvoje Niksic . - - * wid-edit.el: Also allow prompt when field value is invalid. - - * cus-edit.el (custom-redraw): Fix repositioning for when column - is zero. - -Mon May 5 12:55:14 1997 Per Abrahamsen - - * cus-edit.el (x): New group. - -Mon Apr 28 13:10:48 1997 Per Abrahamsen - - * wid-edit.el (widget-boolean-prompt-value): Always ask. - - * cus-edit.el (custom-variable-value-create): Remove unreferenced - variable. - * wid-edit.el (widget-field-action): Ditto. - (widget-regexp-match): Ditto. - - * Version 1.96 released. - -Mon Apr 28 12:19:24 1997 Per Abrahamsen - - * cus-edit.el (custom-variable-action): Don't update state if it - is modified. - - * widget.el (:mouse-down-action): New keyword. - * wid-edit.el (button-release-event-p): New function. - (widget-keymap): Don't bind mouse up events. - (widget-button-pressed-face): New face. - (widget-button-click): Wait for up event, give feedback. - (default): Use `:mouse-down-action'. - (menu-choice): Ditto. - (widget-choice-mouse-down-action): New function. - (widget-info-link-action): Removed kludge to steal up event. - * cus-edit.el (widget-magic-mouse-down-action): New function. - (custom-magic-value-create): Use it. - (custom-buffer-create-internal): Removed kludge to steal up event. - -Sun Apr 27 12:05:12 1997 Per Abrahamsen - - * Version 1.95 released. - -Sun Apr 27 11:10:03 1997 Per Abrahamsen - - * widget.el (:glyph-up, :glyph-down, :glyph-inactive): New - keywords. - * wid-edit.el (widget-glyph-insert-glyph): Support optional `down' - and `inactive' glyphs. - (widget-push-button-value-create): Ditto. - (widget-glyph-click): New function. - (widget-button1-click): Use it. - (widget-button-click): Use it. - -Sat Apr 26 19:26:45 1997 Per Abrahamsen - - * Version 1.94 released. - -Sat Apr 26 16:39:58 1997 Per Abrahamsen - - * cus-edit.el (custom-buffer-create): Accept optional buffer NAME. - (custom-buffer-create-other-window): ditto. - (customize, customize-other-window, customize-variable, - customize-variable-other-window, customize-face, - customize-face-other-window, customize-customized, - customize-saved, customize-apropos, custom-face-menu-create, - custom-variable-menu-create, boolean, custom-menu-create): Updated - caller. - - * Version 1.93 released. - - * cus-edit.el (custom-variable-action): Reset magic state. - (custom-variable-menu): Allow `Reset to Current' on `changed' - items. - - * wid-edit.el (widget-choice-toggle): New option. - (widget-choice-action): Use it. - - * cus-edit.el (custom-group-menu): Only test state to see if the - item is enabled. - - * cus-face.el (custom-background-mode): Use `const', not - `choice-item'. - (custom-face-attributes): Use tags for toggling booleans, not the - value. - - * wid-edit.el (character): Use `characterp' when available. - -Fri Apr 25 17:05:52 1997 Per Abrahamsen - - * widget.el (:prompt-match): New keyword. - (:prompt-history): New keyword. - (:prompt-internal): New keyword. - * wid-edit.el (widget-field-prompt-internal): New function. - (widget-field-prompt-value): New function. - (editable-field): Use them. - (widget-field-action): Ditto. - (widget-symbol-prompt-value-history): New variable. - (widget-symbol-prompt-internal): New function. - (symbol): Use them. - (widget-variable-prompt-value-history): New variable. - (variable): Use them. - (widget-function-prompt-value-history): New variable. - (function): Use them. - - * wid-edit.el (boolean): Use tag to toggle. - (character, sexp, symbol, file, string): Inactive tag. - - * wid-edit.el (widget-choice-prompt-value): New function. - (choice, radio): Use it. - (widget-prompt-value): Prepend widget type to prompt. - - * wid-edit.el (widget-parent-action): Renamed from - `widget-choice-item-action'. - (choice-item): Updated widget. - * cus-edit.el (custom-magic): Ditto. - * widget.texi (Defining New Widgets): Documented it. - - * wid-edit.el (widget-children-validate): Renamed from - `widget-editable-list-validate'. - (editable-list, group): Updated widgets. - * cus-edit.el (custom, face): Ditto. - * widget.texi (Basic Types): Documented it. - - * wid-edit.el (widget-value-value-get): Renamed from - `widget-item-value-get'. - (item): Updated widget. - * cus-edit.el (face, custom): Ditto. - * widget.texi (Defining New Widgets): Documented it. - - * wid-edit.el (widget-value-convert-widget): Renamed from - `widget-item-convert-widget'. - (item, editable-field): Updated widgets. - * cus-edit.el (face): Ditto. - * widget.texi (Defining New Widgets): Documented it. - - * widget.texi (Defining New Widgets): Documented - `widget-types-convert-widget' and `widget-children-value-delete'. - - * custom.texi (User Commands): Documented new commands. - -Thu Apr 24 18:58:54 1997 Per Abrahamsen - - * all: Synched with FSF. - -Wed Apr 23 20:16:09 1997 Per Abrahamsen - - * widget.el (define-widget): Return name. - Patch by Simon Marshall . - -Tue Apr 22 14:36:09 1997 Per Abrahamsen - - * wid-edit.el, cus-edit.el: Replaced `copy-list' with - `copy-sequence'. - Patch by Simon Marshall . - -Mon Apr 21 19:01:20 1997 Per Abrahamsen - - * Version 1.90 released. - -Mon Apr 21 09:03:34 1997 Per Abrahamsen - - * cus-edit.el: (custom-set-value): New command. - (custom-set-variable): New command. - (customize-saved): Renamed from `customize-customized'. - (customize-customized): New command. - (custom-save-customized): New command. - - * widget.el (:prompt-value): New keyword. - - * wid-edit.el (widget-prompt-value): New function. - (default): Use it. - (widget-default-prompt-value): New function. - (const): Use it. - (widget-const-prompt-value): New function. - (string): Use it. - (widget-string-prompt-value-history): New variable. - (widget-string-prompt-value): New function. - (file): Use it. - (widget-file-prompt-value): New function. - (sexp): Use it. - (widget-sexp-prompt-value-history): New variable. - (widget-sexp-prompt-value): New function. - (boolean): Use it. - (widget-boolean-prompt-value): New function. - -Sat Apr 19 10:08:56 1997 Per Abrahamsen - - * cus-edit.el (custom-variable-prompt): Limit completion to user - options. Allow non-match input. - - * wid-edit.el (character): Give error if the length of the field - isn't exactly 1. - -Fri Apr 18 19:55:04 1997 Per Abrahamsen - - * widget.el, wid-edit.el, wid-browse.el, custom.el, cus-face.el, - cus-edit.el (cl): Require cl inside an `eval-when-compile'. - -Thu Apr 17 18:55:15 1997 Per Abrahamsen - - * wid-edit.el (widget-regexp-validate): New function. - (regexp): Use it. - (widget-regexp-match): New function. - (regexp): Use it. - - * cus-edit.el (custom-variable-action): Use `custom-toggle-hide'. - (custom-face-action): Ditto. - (custom-group-action): Ditto. - - * Version 1.89 released. - -Thu Apr 17 11:23:20 1997 Per Abrahamsen - - * cus-edit.el (custom-toggle-hide): New function. - (custom-level-action): Use it. - (custom-group-menu): Ditto. - (custom-face-menu): Ditto. - (custom-variable-menu): Ditto. - - * cus-edit.el (custom-redraw): Goto old line and column instead of - old character position. This is more tolerant for changes. - - * wid-edit.el (widget-choice-action): Only notify parent if - something was chosen. - - * widget.texi (Sexp Types): Documented `function-item' and - `variable-item'. - (group): New subsection. - (Widget Browser): New section. - (Widget Minor Mode): New sextion. - - * wid-edit.el: Moved widget minor mode support to - `wid-browse.el'. - - * custom.el (custom-declare-group): Make sure initial members - aren't duplicated even if the `defgroup' is evaluated twice. - - * custom.el (custom-declare-variable): Use `append' instead of - `copy-list'. - - * widget.texi (checklist): Documented `:greedy'. - -Wed Apr 16 19:24:47 1997 Per Abrahamsen - - * Version 1.88 released. - -Wed Apr 16 13:28:37 1997 Per Abrahamsen - - * wid-edit.el (widget-minor-mode): New variable and command. - (widget-minor-mode-map): New variable. - Add to `'minor-mode-alist' and `minor-mode-map-alist'. - * widget.el: Added autoload. - - * wid-edit.el (widget-specify-inactive): Set priority. - - * wid-edit.el (widget-move): Skip inactive widgets. - - * cus-edit.el (custom-display-unselected-match): Matched too many - displays. - - * Version 1.87 released. - -Wed Apr 16 00:15:26 1997 Per Abrahamsen - - * wid-edit.el (widget-field-face): Changed default background - color. - - * custom.el (custom-declare-variable): Set `custom-get' the right - place. - - * cus-edit.el (custom-magic): Don't notify the parent. - - * cus-edit.el (custom-variable-menu): Allow more actions on - `changed' and `rogue' states. - - * custom.el (custom-initialize-set): New function. - (custom-initialize-reset): New function. - (custom-initialize-changed): New function. - (custom-declare-variable): Use `custom-initialize-set' as - default for `:initialize'. - - * Version 1.86 released. - -Wed Apr 16 00:02:19 1997 Per Abrahamsen - - * cus-edit.el (custom-save-variables): Save :require symbols. - - * Version 1.85 released. - -Tue Apr 15 11:56:16 1997 Per Abrahamsen - - * custom.el (:initialize, :set, :get, :request): New keywords. - (custom-declare-variable): Support them. - (custom-set-variables): Ditto. - (defcustom): Document them. - (custom-initialize-default): New function. - * custom.texi (Declaring Variables): Documented them. - * cus-edit.el (custom-variable-value-create): Support them. - (custom-variable-set): Ditto. - (custom-variable-save): Ditto. - (custom-variable-reset-saved): Ditto. - (custom-variable-reset-factory): Ditto. - (custom-variable-state-set): Ditto. - - * cus-edit.el (custom-menu-filter): New function. - (custom-variable-menu): New format. - (custom-variable-action): Use it. - (custom-face-menu): New format. - (custom-face-action): Use it. - (custom-group-menu): New format. - (custom-group-action): Use it. - - * wid-edit.el (widget-choose): Accept unselectable items. - - * wid-edit.el (widget-default-create): Clear undo buffer. - (widget-default-delete): Ditto. - - * cus-edit.el (customize-other-window): New function. - - * cus-face.el (custom-frame-parameter): Replace - `frame-parameter'. - (custom-background-mode, custom-extract-frame-properties, - custom-get-frame-properties): Updated callers. - - * custom.el: Minor doc fixes from RMS. - - * cus-face.el (custom-declare-face): Protest when dumping defface - in Emacs. - - * wid-edit.el (widget-info-link-action): Steal mouse up event. - - * wid-edit.el (widget-specify-insert): Use old style backquote. - Patch by "William M. Perry" . - -Sun Apr 13 19:19:33 1997 Per Abrahamsen - - * custom.texi (Declaring Faces): Documentation property symbol is - `face-documentation'. - -Sat Apr 12 18:31:22 1997 Per Abrahamsen - - * Version 1.84 released. - -Sat Apr 12 15:08:31 1997 Per Abrahamsen - - * cus-edit.el (abbrev-mode, alloc, undo, modeline, fill, - editing-basics, display, execute, installation, dired, limits, - debug, minibuffer, keyboard, mouse, menu, auto-save, - processes-basics, windows): New customization groups. - - * Version 1.83 released. - -Sat Apr 12 10:44:15 1997 Per Abrahamsen - - * cus-start.el: New file. - - * cus-face.el (custom-face-font-size): Don't assume integral - number. Patch by Steven L Baur . - - * cus-edit.el (custom-menu-create): Don't allow optional `NAME'. - (customize-menu-create): Do allow optional name. - - * widget.texi (atoms): Documented `character' widget. - - * custom.el (custom-set-variables): Add warning for old format. - -Fri Apr 11 21:23:33 1997 Per Abrahamsen - - * Version 1.82 released. - -Fri Apr 11 18:27:02 1997 Per Abrahamsen - - * cus-edit.el (custom-variable-set): Use `set-default' instead of - `set'. - (custom-variable-save): Ditto. - (custom-variable-reset-saved): Ditto. - (custom-variable-reset-factory): Ditto. - - * Version 1.81 released. - - * custom.el: Added missing autoloads. - -Fri Apr 11 18:13:12 1997 Per Abrahamsen - - * Version 1.80 released. - -Fri Apr 11 18:06:28 1997 Per Abrahamsen - - * cus-edit.el (customize-face-other-window): Added autoload cookie. - - * Version 1.79 released. - -Fri Apr 11 15:27:25 1997 Per Abrahamsen - - * cus-edit.el (customize-face-other-window): New function. - - * wid-browse.el (widget-browse-mode-customize-menu): New menu. - (widget-browse-mode): Add it. - (widget-browse-mode-map): Bind `q'. - - * wid-browse.el (widget-browse-other-window): New function. - * widget.el (widget-browse-other-window): Autoload. - - * cus-edit.el (customize-menu-create): New function. - (custom-mode-customize-menu): Use it. - - * Version 1.78 released. - -Fri Apr 11 11:12:41 1997 Per Abrahamsen - - * cus-edit.el (custom-make-dependencies): Deleted function. - - * Makefile (cus-load.el): Removed target. - - * cus-edit.el (customize-face): Sort faces. - -Thu Apr 10 22:20:20 1997 Per Abrahamsen - - * Version 1.77 released. - -Thu Apr 10 19:44:07 1997 Per Abrahamsen - - * cus-edit.el (custom-buffer-create-internal): Move to bob + 1. - - * Version 1.76 released. - -Thu Apr 10 16:55:28 1997 Per Abrahamsen - - * cus-edit.el (custom-faces): New group. - (custom-magic-alist): Added. - (custom-variable-sample-face): Added. - (custom-variable-button-face): Added. - (custom-face-tag-face): Added. - (custom-group-tag-faces): Added. - (custom-group-tag-face): Added. - (customize): Removed from faces group. - - * cus-edit.el (custom-load-recursion): New variable. - (custom-load-symbol): Use it. - (custom-mode-customize-menu): New menu. - (custom-mode): Use it. - Code moved to te end of the file. - - * Version 1.75 released. - -Thu Apr 10 09:50:25 1997 Per Abrahamsen - - * cus-edit.el (custom-buffer-create-internal): Split out from - `custom-buffer-create'. - (custom-buffer-create-other-window): New function. - - * cus-edit.el (custom-guess-name-alist): Renamed from - `custom-guess-type-alist'. - (custom-guess-doc-alist): New option. - (custom-guess-type): Use them. - - * cus-edit.el (custom-menu-create): Add autoload cookie. - - * cus-face.el (set-face-stipple): Removed Kyle Jones code. - - * cus-face.el (face-doc-string): Changed property name to - `face-documentation'. - (set-face-doc-string): Ditto. - - * cus-edit.el (custom-variable-type): Don't guess type of - variables defined with `defcustom'. - -Wed Apr 09 21:11:14 1997 Per Abrahamsen - - * Version 1.74 released. - -Wed Apr 9 11:57:02 1997 Per Abrahamsen - - * cus-edit.el (custom-unlispify-menu-entry): Strip terminating - `-p' off booleans. - - * cus-edit.el (custom-save-faces): make sure `default' is saved first. - - * wid-edit.el (widget-vector-match): Pass arguments to - `widget-apply' in the correct order. - - * custom.el (custom-define-hook): Change to defvar. - * cus-edit.el (custom-define-hook): Add customization support. - - * cus-edit.el (custom-menu-update): Don't autoload. - (custom-menu-reset): Move here from `custom.el'. - Remove XEmacs support. - (custom-help-menu): Move here from `custom.el'. - Remove XEmacs support. - (custom-menu-create): Work even if `custom-menu-nesting' is - unbound. - (custom-menu-nesting): Don't define for XEmacs. - - * cus-face.el (after-make-frame-hook): Removed - `custom-initialize-frame', as this is now in `frame.el'. - -Tue Apr 08 19:24:17 1997 Per Abrahamsen - - * Version 1.73 released. - -Tue Apr 8 19:23:43 1997 Per Abrahamsen - - * widget.texi (push-button): Forgot `@end table'. - -Tue Apr 08 18:51:09 1997 Per Abrahamsen - - * Version 1.72 released. - -Tue Apr 8 09:21:15 1997 Per Abrahamsen - - * cus-edit.el (custom-guess-type-alist): New option. - (custom-guess-type): New function. - (custom-variable-type): New function. - (custom-variable-value-create): Use it. - - * cus-face.el (custom-face-attributes): Moved :family to the - beginning of the list. - Patch by Herve Poirier . - (custom-face-attributes): Added :strikethru attribute. - - * custom.texi (Declarations): Refer to `cus-edit.el' for - examples. - - * custom.el (custom-set-variables): If variable is already set, - overwrite it here. - (custom-declare-variable): Do not set saved variables, if they - already are bound. - (custom-declare-variable): Clear the `force-value' flag if set. - - * widget.el (:text-format): New keyword. - * wid-edit.el (push-button): Define it. - (widget-push-button-value-create): Use it. - * widget.texi (push-button): Documented it. - -Sun Apr 06 22:33:39 1997 Per Abrahamsen - - * Version 1.71 released. - -Sun Apr 6 22:25:45 1997 Per Abrahamsen - - * cus-face.el (custom-face-font-name): New alias. - (custom-face-attributes): Support `get' for remaining properties. - (custom-face-attributes-get): Require `font.el'. - (custom-face-font-size): New function. - (custom-face-font-family): New function. - (custom-face-bold): New function. - (custom-face-italic): New function. - (custom-face-stipple): New function. - Inspired by `rogue.el' by Hunter Kelly . - -Wed Apr 02 18:25:55 1997 Per Abrahamsen - - * Version 1.70 released. - -Wed Apr 2 10:41:48 1997 Per Abrahamsen - - * cus-edit.el (custom-buffer-create): Give progress report. - (customize-face): Remove message. - (custom-group-value-create): Give progress report. - (custom-face-value-create): Ditto. - - * cus-edit.el (custom-face-edit-selected): New function. - (custom-face-edit-all): New function. - (custom-face-edit-lisp): New function. - (custom-face-menu): Use them. - (custom-display-unselected): New widget. - (custom-display-unselected-match): New function. - (custom-face-selected): New widget. - (custom-face-selected): New constant. - (custom-face-value-create): Use them. - * custom.texi (The Face Options): Documented it. - - * cus-edit.el (custom-face-all): New widget. - (custom-face-all): New constant. - (custom-face-value-create): Use it. - - * cus-edit.el (custom-save-variables): Insert newline at eob. - (custom-save-faces): Ditto. - Reported by Jamie Zawinski . - -Tue Apr 01 20:08:10 1997 Per Abrahamsen - - * Version 1.69 released. - -Tue Apr 1 17:29:16 1997 Per Abrahamsen - - * Makefile (TEXT): Added x-overlay.el for use with old XEmacsen. - - * cus-face.el (custom-face-attributes): Add 4'th GET argument in - some attributes. - (custom-face-background): New function. - (custom-background-mode): Use it. - (custom-face-foreground): New function. - (custom-face-attributes-get): New function. - * cus-edit.el (custom-face-value-create): Use it. - - * wid-edit.el (widget-apply): Added ;;;###autoload. - * widget.el (widget-apply): Added autoload. - -Sun Mar 30 11:41:50 1997 Per Abrahamsen - - * cus-face.el (set-face-stipple): Added for XEmacs. - Written by Kyle Jones. - -Fri Mar 28 12:17:02 1997 Per Abrahamsen - - * wid-edit.el (widget-glyph-insert): Doc fix. - * custom.el (defface): Ditto. - (custom-add-to-group): Ditto. - * cus-face.el (custom-initialize-frame): Ditto. - -Thu Mar 27 19:31:40 1997 Per Abrahamsen - - * Version 1.68 released. - -Thu Mar 27 18:50:16 1997 Per Abrahamsen - - * widget.el (:active): New keywords. - (:inactive): Ditto. - (:activate): Ditto. - (:deactivate): Ditto. - - * wid-edit.el (widget-inactive-face): new face. - (widget-specify-inactive): New function. - (widget-overlay-inactive): Ditto. - (widget-specify-active): Ditto. - (widget-apply-action): Ditto. - (widget-field-activate): Use it. - (widget-button-click): Ditto. - (widget-button1-click): Ditto. - (widget-button-press): Ditto. - (widget-gui-action): Ditto. - (default): Use new keywords. - (widget-default-active): New function. - (widget-default-deactivate): Ditto. - (widget-checkbox-action): New function. - (checkbox): Use it. - (widget-checklist-add-item): Initialize active state. - (widget-radio-add-item): Ditto. - (widget-radio-value-set): Ditto. - (widget-radio-action): Ditto. - - * widget.texi (Widget Properties): Document the new keywords. - -Mon Mar 24 18:36:15 1997 Per Abrahamsen - - * Version 1.67 released. - -Mon Mar 24 18:19:05 1997 Per Abrahamsen - - * cus-edit.el (custom-save-all): Added autoload. - - * Version 1.66 released. - -Mon Mar 24 18:09:04 1997 Per Abrahamsen - - * wid-edit.el (widget-default-delete): Added workaround for bug - with empty `:format'. - -Thu Mar 20 12:33:59 1997 Per Abrahamsen - - * custom.texi (The Init File): Explain that `custom-file' is not - automatically loaded. - -Tue Mar 18 14:42:31 1997 Per Abrahamsen - - * Version 1.65 released. - -Tue Mar 18 11:03:02 1997 Per Abrahamsen - - * cus-face.el (custom-face-attributes): Removed `:invert'. - (custom-invert-face): Removed. - -Mon Mar 17 11:32:51 1997 Per Abrahamsen - - * wid-edit.el (widget-file-action): Spelling correction by Greg - Stark . - - * Version 1.64 released. - -Mon Mar 17 10:43:10 1997 Per Abrahamsen - - * cus-edit.el (custom-group-menu-create): Split definition into - XEmacs and Emacs. XEmacs uses :filter. Emacs limits - `custom-menu-nesting'. - (custom-menu-create): Do not limit `custom-menu-nesting' here. - (custom-menu-update): Removed XEmacs support. - - * custom.el (custom-help-menu): Use `custom-menu-create' in XEmacs - :filter. - -Fri Mar 14 18:03:55 1997 Per Abrahamsen - - * Version 1.63 released. - -Fri Mar 14 18:00:40 1997 Per Abrahamsen - - * custom.el (custom-help-menu): Use :filter to generate menu on - XEmacs. - * cus-edit.el (custom-menu-update): Support use as :filter on - XEmacs, popup menu on Emacs. - -Tue Mar 11 16:27:50 1997 Per Abrahamsen - - * Version 1.62 released. - -Tue Mar 11 11:30:39 1997 Per Abrahamsen - - * cus-face.el (custom-set-face-font-size): Use - `font-set-face-font' instead of `set-face-font'. - (custom-set-face-font-family): Ditto. - - * Version 1.61 released. - -Tue Mar 11 11:27:19 1997 Per Abrahamsen - - * cus-face.el (custom-set-faces): If face already exists, - overwrite it now. - -Mon Mar 10 15:40:29 1997 Per Abrahamsen - - * cus-face.el (custom-face-attributes): Changed default colors to - black and white. - - * wid-edit.el (color-item): Set `:sample-face-get'. - - * cus-face.el (custom-declare-face): Don't initialize an existing - saved face. - - * wid-edit.el (color): Changed default color from "default" to - "black". - - * Version 1.60 released. - -Mon Mar 10 11:32:51 1997 Per Abrahamsen - - * widget.el (:tab-order): New keyword. - * wid-edit.el (widget-move): Use it. - * widget.texi (Basic Types): Documented it. - Patch by "William M. Perry" . - -Sat Mar 08 17:21:12 1997 Per Abrahamsen - - * Version 1.59 released. - -Sat Mar 8 10:16:59 1997 Per Abrahamsen - - * widget.texi (editable-list): Documented new keywords. - (radio-button-choice): Ditto. - (checklist): Ditto. - - * cus-edit.el (custom-face-edit-args): Deleted. - - * wid-edit.el (color-item): Don't make sample a button. - - * widget.el (:insert-button-args): New keyword. - (:delete-button-args): Ditto. - - * wid-edit.el (widget-editable-list-entry-create): Use them. - * cus-edit.el (custom-face-value-create): Ditto. - - * widget.el (:append-button-args): New keyword. - * wid-edit.el (widget-editable-list-format-handler): Use it. - - * cus-edit.el (custom-face-edit): Add `:help-echo' to checkboxes. - * cus-face.el (custom-face-attributes): Add `:echo-help'. - * wid-edit.el (delete-button): Ditto. - (insert-button): Ditto. - - * widget.el (:button-args): New keyword. - (:sibling-args): New keyword. - * wid-edit.el (widget-checklist-add-item): Support them. - (widget-radio-add-item): Ditto. - - * wid-edit.el: (widget-mouse-help): Renamed from - `widget-ballon-help'. - (widget-specify-button): Support `help-echo'. - (widget-glyph-insert-glyph): Ditto. - (widget-specify-field-update): Ditto. - - * wid-edit.el: Minor spelling corrections. - Patch by Martin Buchholz . - -Fri Mar 07 21:29:07 1997 Per Abrahamsen - - * Version 1.58 released. - -Fri Mar 7 14:55:22 1997 Per Abrahamsen - - * cus-edit.el (custom-buffer-create): Go to top of buffer after - creating it. - - * custom.texi (The Customization Buttons): Documented `[Done]'. - -Fri Mar 07 14:40:52 1997 Per Abrahamsen - - * Version 1.57 released. - -Fri Mar 7 10:46:48 1997 Per Abrahamsen - - * cus-edit.el: Removed "Push me" from :help-echo strings. - * wid-edit.el: Ditto. - - * wid-edit.el (widget-specify-button): Support ballon-help. - (widget-glyph-insert-glyph): Ditto. - (widget-balloon-help): New function. - - * Makefile (some): New target. - - * wid-edit.el: A bit of compiler warning avoidance with new target. - - * cus-face.el (custom-face-attributes-set): Renamed from - `custom-face-attribites-set'. - (custom-face-display-set): Changed caller. - (custom-invert-face): Renamed from `reverse-face'. - (custom-face-attributes): Changed caller. - -Fri Mar 7 04:17:40 1997 Lars Magne Ingebrigtsen - - * cus-face.el: Moved variable defintions around a bit to avoid - compilation warnings. - -Thu Mar 06 16:30:04 1997 Per Abrahamsen - - * Version 1.56 released. - -Thu Mar 6 15:40:34 1997 Per Abrahamsen - - * cus-edit.el (custom-notify): Don't modify hidden items. - -Wed Mar 05 17:42:47 1997 Per Abrahamsen - - * Version 1.55 released. - -Wed Mar 5 17:20:05 1997 Per Abrahamsen - - * cus-face.el (set-face-doc-string). Renamed from - `set-face-documentation'. - (face-doc-string). Renamed from `face-documentation'. - (custom-declare-face): Changed caller. - * cus-edit.el (custom-face): Changed caller. - -Wed Mar 05 17:00:42 1997 Per Abrahamsen - - * Version 1.54 released. - - * cus-face.el (reverse-face): New function. - (custom-face-attributes): Use it. - -Wed Mar 05 15:08:30 1997 Per Abrahamsen - - * Version 1.53 released. - -Wed Mar 5 15:03:58 1997 Per Abrahamsen - - * cus-face.el (custom-relevant-frames): Don't cache the frames. - (custom-initialize-frame): Ditto. - -Wed Mar 05 14:39:19 1997 Per Abrahamsen - - * Version 1.52 released. - -Wed Mar 5 14:38:20 1997 Per Abrahamsen - - * wid-edit.el (widget-choose): Call `try-completion' to make sure - case changes are done. - -Tue Mar 04 21:04:30 1997 Per Abrahamsen - - * Version 1.51 released. - -Tue Mar 4 11:58:02 1997 Per Abrahamsen - - * widget.texi, custom.texi: Use @* instead of @br. - - * wid-edit.el (widget-glyph-insert): Allow glyphs as well as file - names from `widget-glyph-directory'. - -Mon Mar 3 19:38:57 1997 Per Abrahamsen - - * cus-edit.el (custom-mode-map): Bind `bury-buffer' to `q'. - Suggested by Neal Becker . - -Mon Mar 03 18:29:27 1997 Per Abrahamsen - - * Version 1.50 released. - -Mon Mar 3 15:01:25 1997 Per Abrahamsen - - * cus-face.el (face-documentation): Renamed from - `get-face-documentation'. - (custom-declare-face): Change caller. - * cus-edit.el (custom-face): Ditto. - - * cus-face.el (make-empty-face): New function. - (initialize-face-resources): New option. - (initialize-face-resources): New function. - (custom-declare-face): Call them here. - (custom-face-display-set): Don't create face here. - (custom-set-faces): Clear face. - * cus-edit.el (custom-face-set): Ditto. - (custom-face-save): Ditto. - (custom-face-reset-saved): Ditto. - (custom-face-reset-factory): Ditto. - -Mon Mar 03 10:36:40 1997 Per Abrahamsen - - * Version 1.49 released. - -Mon Mar 3 10:34:44 1997 Per Abrahamsen - - * cus-face.el (custom-background-mode): Don't call - `x-color-values' on Emacs tty frame. - Patch by Katsumi Yamaoka . - -Sat Mar 1 22:55:17 1997 Per Abrahamsen - - * cus-edit.el (cus-face): Require. - -Sat Mar 01 22:35:07 1997 Per Abrahamsen - - * Version 1.48 released. - -Sat Mar 1 21:45:44 1997 Per Abrahamsen - - * wid-edit.el: Renamed from widget-edit.el - * wid-browse.el: Renamed from widget-browse.el - * cus-edit.el: Renamed from custom-edit.el - * cus-face.el: New file. - * custom-xmas.el: Deleted. - * custom.el: Updated autoloads. - * widget.el: Ditto - * widget.texi: Updated examples. - * widget-example.el: Updated require. - -Fri Feb 28 02:04:49 1997 Per Abrahamsen - - * custom.el (custom-declare-face): Ignore already declared faces. - - * Version 1.47 released. - -Fri Feb 28 01:46:22 1997 Per Abrahamsen - - * custom.el (custom-background-mode): Take a frame argument. - (custom-declare-face): Create frame local faces where relevant. - (custom-declare-face): Whine when called during dump. - (custom-face-display-set): Don'e create frame local face if the - display is identical to the global face. - (custom-default-frame-properties): New variable and function. - (custom-extract-frame-properties): New function. - (custom-get-frame-properties): New function. - (custom-display-match-frame): Use it. - (custom-relevant-frames): New variable and function. - (custom-initialize-frame): New function. - (after-make-frame-hook): Enable it. - -Thu Feb 27 18:58:45 1997 Per Abrahamsen - - * custom-edit.el (custom-buffer-create): Read up event when - -Wed Feb 26 22:17:38 1997 Per Abrahamsen - - * Version 1.46 released. - -Wed Feb 26 12:27:21 1997 Per Abrahamsen - - * custom.el (emacs): Moved to custom-edit.el. - (customize): Ditto. - * custom-edit.el: Added customization groups for all finder - keywords. - (customize): Add to the appropriate groups. - * widget-edit.el (widgets): Ditto. - * custom.texi (Usage for Package Authors): Documented it. - - * widget-edit.el (widget-push-button-value-create): Use - `device-on-window-system-p' instead of `device-type'. - - * Version 1.45 released. - -Wed Feb 26 12:26:30 1997 Per Abrahamsen - - * widget-edit.el (widget-push-button-value-create): Check that - (device-type) is x. - Reported by "Tomasz J. Cholewo" . - -Sun Feb 23 21:48:43 1997 Per Abrahamsen - - * custom-edit.el (customize-face): By default, customize all - faces. - -Thu Feb 20 11:55:45 1997 Per Abrahamsen - - * Version 1.44 released. - -Thu Feb 20 11:44:33 1997 Per Abrahamsen - - * custom-edit.el (custom-variable-action): Pass symbol to - `custom-unlispify-tag-name'. - (custom-group-action): Ditto. - (custom-face-action): Ditto. - -Wed Feb 19 19:41:38 1997 Per Abrahamsen - - * custom.el (get-face-documentation): New function. - (set-face-documentation): Ditto. - (custom-declare-face): Use it. - - * custom-edit.el (custom-face): Ditto. - -Tue Feb 18 21:42:38 1997 Per Abrahamsen - - * Version 1.43 released. - -Tue Feb 18 19:57:28 1997 Per Abrahamsen - - * widget.el: Don't call autoloads when `load-gc' is fbound. - - * Version 1.42 released. - -Tue Feb 18 08:39:59 1997 Per Abrahamsen - - * custom.el (custom-background-mode): Doc fix. - (custom-declare-variable): Ditto. - Patch by Simon Marshall . - - * custom.el (custom-face-display-set): Pass frame parameter to - `copy-face'. - (custom-face-attribites-set): Pass frame parameter. - - * custom-xmas.el: Cleanup. - - * custom.el (XEmacs): Load "custom-xmas" instead of requiring. - - * widget-edit.el (widget-keymap): Removed duplicate key binding. - -Mon Feb 17 12:58:40 1997 Per Abrahamsen - - * Version 1.41 released. - -Mon Feb 17 12:43:12 1997 Per Abrahamsen - - * custom-edit.el (custom-variable-action): Use - `custom-unlispify-tag-name' instead of `capitalize'. - (custom-face-action): Ditto. - (custom-group-action): Ditto. - - * custom-xmas.el: New file. - * custom.el: Move XEmacs code there. - -Sat Feb 15 22:27:07 1997 Per Abrahamsen - - * Version 1.40 released. - -Sat Feb 15 22:18:57 1997 Per Abrahamsen - - * custom-edit.el: Use the `changed' state. - -Fri Feb 14 12:46:46 1997 Per Abrahamsen - - * Version 1.39 released. - -Fri Feb 14 12:35:15 1997 Per Abrahamsen - - * custom-edit.el (custom-variable-action): Capitalize. - (custom-face-action): Ditto. - (custom-group-action): Ditto. - * widget-edit.el (widget-choose): Use title in XEmacs. - Patch by Jens Lautenbacher . - -Thu Feb 13 21:14:41 1997 Per Abrahamsen - - * Version 1.38 released. - -Thu Feb 13 15:15:24 1997 Per Abrahamsen - - * custom-edit.el (custom-buffer-create): Added `Done' button. - - * custom-edit.el (custom-variable-state-set): Customized to - factory setting is the same as uncustomized. - (custom-variable-set): Did not set `customized-value' right. - - * widget-edit.el (widget-plist-member): Changed to defsubst. - (widget-get): Made it non-recursive. - - * widget-edit.el (widget-glyph-insert-glyph): New function. - (widget-glyph-insert): Use it. - (widget-push-button-gui): New option. - (widget-push-button-cache): New variable. - (widget-gui-action): New function. - (widget-push-button-value-create): New function. - (push-button): Use it. - (widget-editable-list-gui): New option. - (widget-editable-list-format-handler): Use it. - (widget-editable-list-value-create): Ditto. - This implements GUI push buttons. - - * Version 1.37 released. - -Thu Feb 13 13:51:20 1997 Per Abrahamsen - - * custom-edit.el (custom-redraw): Protect point. - - * widget-edit.el (widget-button1-click): New function. - (widget-keymap): Bind it. - - * Version 1.36 released. - -Thu Feb 13 13:16:34 1997 Per Abrahamsen - - * custom.el: Removed all `;;;###autoload' at the request of Steven - L Baur . - Don't call `autoload' or `custom-menu-reset' when `load-gc' is - fbound. - - * Version 1.35 released. - -Thu Feb 13 10:37:18 1997 Per Abrahamsen - - * widget-edit.el (boolean): Forgot terminating newline in :format. - -Wed Feb 12 18:49:03 1997 Per Abrahamsen - - * Version 1.34 released. - -Wed Feb 12 09:13:52 1997 Per Abrahamsen - - * widget-edit.el (widget-field-keymap): Disabled menu-bar in the - worng keymap. - (widget-text-keymap): Ditto. - (widget-glyph-directory): Default to "data-directory/custom/'. - - * Version 1.33 released. - -Wed Feb 12 09:11:23 1997 Per Abrahamsen - - * Makefile (TEXT): Added `check0.xpm' and `check1.xpm'. - - * widget-edit.el (checkbox): Add glyphs. - -Mon Feb 10 22:52:03 1997 Per Abrahamsen - - * widget-browse.el (widget-browse-sexps): New function. - (:args): Use it. - (widget-browse-action): New function. - (widget-browse): Use it. - (widget-browse-widgets): Use it. - - * Version 1.32 released. - -Mon Feb 10 15:39:45 1997 Per Abrahamsen - - * widget-browse.el (widget-browse-sexp): Catch printing errors. - (widget-browse-widgets): Print types instead of numbers. - - * all: Renamed `widget-name' to `widget-type'. - - * widget-edit.el (widget-button-click): Call the right command. - - * widget.texi (Basic Types): Documented new glyph options. - - * Version 1.31 released. - -Mon Feb 10 13:04:14 1997 Per Abrahamsen - - * widget-edit.el (widget-glyph-directory): New option. - (widget-glyph-enable): New option. - (widget-glyph-insert): New function. - (widget-toggle-value-create): Use it. - (radio-button): Use it. - (widget-field-activate): Only look for a field - (widget-button-click): Handle glyph events. - (widget-default-create): Handle `:glyph'. - * widget.el (:on-glyph): New keyword. - (:off-glyph): Ditto. - (:glyph): Ditto. - * widget.texi (toggle): Documented them.. - (Basic Types): Ditto. - * radio1.xpm: New file. - * radio0.xpm: Ditto. - Original patch provided by Robert Bihlmeyer . - - * widget-browse.el (widget-browse): Add group. - (widget-browse-mode-menu): Add commands. - - * widget-edit.el (widget-keymap): Bind [mouse-2-down] instead of - [mouse-2]. - - * widget-edit.el (widget-keymap): Don't bind [menu-bar] here. - (widget-field-keymap): Bind it here instead. - (widget-text-keymap): And here. - -Sun Feb 9 20:33:25 1997 Per Abrahamsen - - * widget-browse.el: New file. - * Makefile (WIDGET): Added it. - * widget.el (widget-browse-at): Added autoload. - (widget-browse): Ditto. - * widget-edit.el (widget-identify): Deleted. - - * custom-edit.el (custom-mode): Install custom-mode-menu under - XEmacs. - -Sat Feb 08 13:16:17 1997 Per Abrahamsen - - * Version 1.30 released. - -Sat Feb 8 13:15:21 1997 Per Abrahamsen - - * widget-edit.el (widget-name): New macro. - * widget.texi: Document it. - -Sat Feb 08 12:35:22 1997 Per Abrahamsen - - * Version 1.29 released. - -Sat Feb 8 12:29:48 1997 Per Abrahamsen - - * widget-edit.el (widget-get-sibling): New function. - (widget-identify): New command. - - * widget-edit.el (toggle): Don't use subwidgets. - (widget-toggle-convert-widget): Deleted. - (widget-toggle-value-create): New function. - (widget-toggle-action): New function. - (checkbox): Caller updated. - (radio-button): Ditto. - (boolean): Ditto. - * custom.el (custom-face-attributes): Ditto. - -Fri Feb 07 18:34:42 1997 Per Abrahamsen - - * Version 1.28 released. - -Fri Feb 7 18:33:47 1997 Per Abrahamsen - - * widget-edit.el (widget-keymap): Don't bind `C-a' and `C-e' - here. - (widget-field-keymap): Bind them here instead. - (widget-text-keymap): And here. - -Fri Feb 07 18:29:31 1997 Per Abrahamsen - - * Version 1.27 released. - -Fri Feb 7 18:18:31 1997 Per Abrahamsen - - * widget-edit.el (widget-beginning-of-line): New function. - (widget-keymap): Bind it. - Patch by "William M. Perry" . - (widget-end-of-line): New function. - (widget-keymap): Bind it. - -Thu Feb 06 19:21:09 1997 Per Abrahamsen - - * Version 1.26 released. - -Thu Feb 6 19:19:12 1997 Per Abrahamsen - - * widget-edit.el (widget-kill-line): New function. - (widget-keymap): Bind it. - -Thu Feb 06 19:10:37 1997 Per Abrahamsen - - * Version 1.25 released. - -Thu Feb 6 19:09:52 1997 Per Abrahamsen - - * widget-edit.el (widget-specify-field-update): Unconditionally - set local keymap property after the field. - -Sat Feb 01 13:13:48 1997 Per Abrahamsen - - * Version 1.24 released. - -Thu Jan 30 13:04:30 1997 Per Abrahamsen - - * widget-edit.el (widget-field-value-delete): Fix problem with - editable fields where the format string doesn't contain %v. - -Tue Jan 28 08:23:17 1997 Per Abrahamsen - - * Version 1.23 released. - -Tue Jan 28 04:33:24 1997 Per Abrahamsen - - * widget.el (:valid-regexp): New keyword. - * widget-edit.el (widget-field-validate): New function. - (editable-field): Use them. - * widget.texi (editable-field): Document it. - - * custom-edit.el (custom-face-format-handler): Removed unused - variable `state'. - - * custom.el (custom-menu-reset): Support menu-less XEmacs. - Reported by Carsten Leonhardt . - -Mon Jan 27 11:51:17 1997 Per Abrahamsen - - * Version 1.22 released. - -Mon Jan 27 08:46:05 1997 Per Abrahamsen - - * custom-edit.el (custom-variable-set): Fixed error message. - (custom-variable-save): Ditto. - - * Version 1.21 released. - -Mon Jan 27 07:17:55 1997 Per Abrahamsen - - * widget.el (:secret): New keyword. - * widget-edit.el (widget-specify-field-update): Support it. - (widget-field-value-get): Ditto. - * widget.texi (editable-field): Documented it. - - * widget-edit.el (widget-field-keymap): New variable. - (editable-field): Use it. - (widget-text-keymap): New variable. - (text): Use it. - (widget-field-activate): New command. - -Sun Jan 26 13:02:20 1997 Per Abrahamsen - - * custom.el (customize): Include `widgets' customization group. - -Sat Jan 25 08:23:02 1997 Per Abrahamsen - - * Version 1.20 released. - -Sat Jan 25 07:13:26 1997 Per Abrahamsen - - * widget-edit.el (widget-specify-field-update): Use - `widget-keymap' by default. - -Fri Jan 24 08:10:46 1997 Per Abrahamsen - - * Version 1.19 released. - -Fri Jan 24 06:53:48 1997 Per Abrahamsen - - * widget-edit.el (widget-documentation-face): Typo in face name. - - * custom-edit.el (custom-variable-sample-face): New face. - (custom-variable-button-face): New face. - (custom-variable-value-create): Use them. - (custom-face-tag-face): New face. - (custom-face): Use it. - (custom-face-format-handler): Don't make the sample a button. - (custom-group-tag-faces): New variable. - (custom-group-tag-face-1): New face. - (custom-group-tag-face): New face. - (custom-group-sample-face-get): New function. - (custom-group): Use it. - - * widget-edit.el (character): Use sample face for tag. - (list): Ditto. - (vector): Ditto. - (cons): Ditto. - (radio): Ditto. - (repeat): Ditto. - (set): Ditto. - (boolean): Ditto. - -Thu Jan 23 20:25:46 1997 Per Abrahamsen - - * widget.el (:sample-face-get): New keyword. - (:sample-face): New keyword. - - * widget-edit.el (widget-default-create): Support %{ and %} - escapes. - (widget-specify-sample): New function. - (default): Define `:sample-face-get'. - (widget-default-sample-face-get): New function. - - * custom-edit.el (custom-variable-action): Show if hidden. - -Wed Jan 22 04:54:10 1997 Per Abrahamsen - - * widget-edit.el (error-message-string): Define if unbound. - -Thu Jan 16 16:07:09 1997 Per Abrahamsen - - * Version 1.18 released. - -Thu Jan 16 16:03:25 1997 Per Abrahamsen - - * custom-edit.el (custom-load-symbol): Use `assoc' instead of - `member' to check if a file is in load-history. - (custom-load-symbol): Use `condition-case' around loads. - -Tue Jan 14 20:51:37 1997 Per Abrahamsen - - * custom-edit.el (:custom-reset): Split into - :`custom-reset-current', `:custom-reset-saved', and - `:custom-reset-factory'. - (custom-mode-menu): Ditto. - (custom-mode): Ditto. - (custom-variable): Ditto. - (custom-variable-menu): Ditto. - (custom-face): Ditto. - (custom-face-menu): Ditto. - (custom-group): Ditto. - (custom-group-menu): Ditto. - (custom-group-reset): Ditto. - (custom-reset-menu): New variable. - (custom-reset): Use it. - (custom-reset-current): New function. - (custom-reset-saved): New function. - (custom-reset-factory): New function. - (custom-buffer-create): Pass event to `custom-reset'. - (custom-variable-reset-saved): Renamed from - `custom-variable-default'. - (custom-variable-reset-factory): Renamed from - `custom-variable-factory'. - (custom-face-reset-saved): Renamed from `custom-face-default'. - (custom-face-reset-factory): Renamed from - `custom-face-reset-factory'. - -Mon Jan 13 01:23:36 1997 Per Abrahamsen - - * Version 1.17 released. - -Mon Jan 13 00:19:35 1997 Per Abrahamsen - - * custom-edit.el (custom-face-format-handler): Missing "hide". - (custom-face-action): Show when hidden. - - * custom.texi: (The State Button): Updated. - -Wed Jan 8 15:23:29 1997 Per Abrahamsen - - * custom-edit.el (custom-quote): Support `characterp'. Patch - by Sudish Joseph . - - * custom-edit.el (custom-magic-alist): Refer to state button - instead of level button. - -Sat Jan 04 21:34:12 1997 Per Abrahamsen - - * Version 1.16 released. - -Fri Jan 3 22:56:57 1997 Per Abrahamsen - - * custom-edit.el (custom-group): Group tags are no longer buttons. - (custom-group-action): Show when hidden. - (custom-magic-value-create): Added :help-echo. - (custom-manual): Ditto. - * widget-edit.el (link): Ditto. - -Fri Jan 03 00:00:37 1997 Per Abrahamsen - - * Version 1.15 released. - -Thu Jan 2 23:30:43 1997 Per Abrahamsen - - * custom-edit.el (custom-magic): Can now contain multiple buttons. - (custom-magic-alist): Add description element. - (custom-magic-show): New variable. - (custom-magic-show-button): New variable. - (custom-magic-value-create): Use them. - (custom): Ditto. - (custom-variable): Ditto. - (custom-face): Ditto. - (widget-face-value-create): Ditto. - (custom-group): Ditto. - (custom-variable-value-create): Don't create [show] button. - (custom-variable-factory): Only save when saved. - (custom-face-factory): Ditto. - -Sat Dec 28 18:54:38 1996 Per Abrahamsen - - * Version 1.14 released. - -Sat Dec 28 13:43:44 1996 Per Abrahamsen - - * custom-edit.el: (custom-changed-face): New face. - (custom-magic-alist): New `changed' state. - (custom-variable-state-set): Support `set' state. - (custom-save): Ditto. - (custom-variable-set): Ditto. - (custom-variable-save): Ditto. - (custom-variable-default): Ditto. - (custom-variable-factory): Ditto. - (custom-face-state-set): Ditto. - (custom-face-set): Ditto. - (custom-face-save): Ditto. - (custom-face-default): Ditto. - (custom-face-factory): Ditto. - (custom-group-save): Ditto. - - * custom.texi (The State Button): Documented `changed' state. - - * custom-edit.el: New terminology: `Set default' automatically - saves the new value and has been renamed `Save'. `Apply' has been - renamed `Set'. `Edit Default' has been renamed to `Edit Lisp'. - * custom.texi: Ditto. - - * widget-edit.el (widget-move): New function. - (widget-forward): Use it. - (widget-backward): Ditto. - -Tue Dec 17 10:47:23 1996 Per Abrahamsen - - * custom-edit.el (custom-mode-menu): Added help item. - - * custom.texi (Declarations): New section. Documented `:tag' - keyword. - (Declaring Groups): Documented `:prefix' keyword. - - * custom-edit.el (custom-set-default): Also save. - (custom-buffer-create): Removed save button. - -Thu Dec 12 07:57:23 1996 Per Abrahamsen - - * widget-edit.el (widget-menu-max-size): Added `:group'. - - * custom-edit.el (custom-display): Added support for `pm', `pc', - and `win32' window systems. - - * widget-edit.el (widget-field-face): Do not require X. - -Tue Dec 10 13:28:22 1996 Per Abrahamsen - - * widget-edit.el (widget-documentation-face): Green by default. - -Mon Dec 09 12:28:10 1996 Per Abrahamsen - - * Version 1.13 released. - -Mon Dec 9 08:50:46 1996 Per Abrahamsen - - * custom-edit.el (custom-unlispify-tag-names): New variable. - (custom-unlispify-tag-name): New function. - (custom-variable-value-create): Use it. - (custom-group-value-create): Use it. - (:custom-prefixes): New keyword. - (custom-variable-value-create): Use it. - (custom-group-value-create): Use it. - - * widget-edit.el (widget-item-convert-widget): Doc fix. - - * custom-edit.el (custom-menu-create): Do not create menus for - groups with more than `widget-menu-max-size' members. - -Sun Dec 08 16:19:21 1996 Per Abrahamsen - - * Version 1.12 released. - -Sun Dec 8 14:38:42 1996 Per Abrahamsen - - * custom.el (:tag): New keyword. - (custom-handle-keyword): Accept it. - - * custom.el (:prefix): New keyword. - (custom-declare-group): Handle it. - (customize): Use it. - * widget-edit.el (widgets): Use it. - - * custom-edit.el (custom-prefix-list): New variable. - (custom-unlispify-menu-entries): New variable. - (custom-unlispify-menu-entry): New function. - (custom-face-menu-create): Use it. - (custom-variable-menu-create): Use it. - (boolean): Use it. - (custom-menu-create): Use it. - - * custom-edit.el (custom-menu-create): New function. - (custom-group-menu-create): Use it. - -Thu Dec 5 14:00:04 1996 Per Abrahamsen - - * custom-opt.el: New file. - -Thu Dec 05 13:53:48 1996 Per Abrahamsen - - * Version 1.11 released. - -Thu Dec 5 13:22:31 1996 Per Abrahamsen - - * custom-edit.el (:custom-menu): New keyword. - (custom-variable): Use it. - (custom-face): Ditto. - (custom-group): Ditto. - (boolean): Ditto. - (custom-menu-update): Ditto. - (custom-face-menu-create): New function. - (custom-variable-menu-create): New function. - (custom-group-menu-create): New function. - (custom-menu-create-entry): Removed. - -Tue Dec 3 09:28:19 1996 Per Abrahamsen - - * custom.texi (Utilities): Documented `custom-add-load'. - -Tue Dec 03 08:42:15 1996 Per Abrahamsen - - * Version 1.10 released. - -Tue Dec 3 00:42:14 1996 Per Abrahamsen - - * custom-edit.el (custom-menu-nesting): Moved from `custom.el'. - (custom-menu-create-entry): Ditto. - (custom-menu-update): Ditto. - -Mon Dec 2 22:48:14 1996 Per Abrahamsen - - * custom.el (:load): New keyword. - (custom-add-load): New function. - (custom-handle-keyword): Use them. - * custom.texi: Document it. - * custom-edit.el (custom-load-symbol): New function. - (custom-load-widget): New function. - (custom-group-value-create): Use it. - (custom-variable-value-create): Use it. - (custom-face-value-create): Use it. - - * custom.el (custom-handle-keyword): New function. - (custom-declare-variable): Use it. - (custom-handle-all-keywords): New function. - (custom-declare-group): Use it. - (custom-declare-face): Use it. - -Sat Nov 30 01:37:07 1996 Per Abrahamsen - - * Version 1.09 released. - -Sat Nov 30 01:36:24 1996 Per Abrahamsen - - * widget-edit.el (widget-specify-field): Make terminating newline - writable under XEmacs. - -Thu Nov 28 22:03:56 1996 Per Abrahamsen - - * Version 1.08 released. - -Thu Nov 28 21:46:30 1996 Per Abrahamsen - - * custom-edit.el (custom-hook-convert-widget): Make space part of - function instead of the editable-list. - - * Version 1.07 released. - -Thu Nov 28 21:31:31 1996 Per Abrahamsen - - * custom-edit.el (custom-variable-state-set): Handle void - variables. - - * Version 1.06 released. - -Thu Nov 28 01:35:54 1996 Per Abrahamsen - - * widget-edit.el (widget-create-child-value): New function. - (widget-choice-value-create): Use it. - (widget-checklist-add-item): Ditto. - (widget-radio-add-item): Ditto. - (widget-editable-list-entry-create): Ditto - (widget-group-value-create): Ditto. - - * widget-edit.el (widget-specify-field): Extend read-only extent. - - * widget-edit.el (widget-create-child): Obey `:extra-offset'. - - * custom-edit.el (custom-mode-hook): Added. - -Tue Nov 26 17:04:45 1996 Per Abrahamsen - - * widget-edit.el: More patches for support of old Emacsen from - William Perry . - - * Version 1.05 released. - -Tue Nov 26 15:05:36 1996 Per Abrahamsen - - * widget-edit.el (widget-make-intangible): New function. - (widget-specify-field): Use it. - (widget-after-change): Remove XEmacs workaround. - (widget-field-value-create): Ditto. - (widget-specify-text): Fully specify stickyness. - -Mon Nov 25 17:01:05 1996 Per Abrahamsen - - * custom-edit.el (custom-face-format-handler): Create face before - use under XEmacs. - - * Version 1.04 released. - -Mon Nov 25 01:14:13 1996 Per Abrahamsen - - * custom.el (custom-facep): New function. - (custom-declare-face): Use it. - * custom-edit.el (customize-face): Ditto. - (customize-customized): Ditto. - (customize-apropos): Ditto. - (custom-save-faces): Ditto. - - * custom.el (custom-declare-variable): Return symbol. Suggested - by Lars Magne Ingebrigtsen . - (custom-declare-group): Ditto. - (custom-declare-face): Return face. - - * widget-edit.el (widget-button-face): Removed :link. - (widget-mouse-face): Ditto. - (widget-field-face): Ditto. - - * custom.el (emacs): Link to (emacs)Top, not (dir)Top. - - * Version 1.03 released. - -Mon Nov 25 00:29:27 1996 Per Abrahamsen - - * widget-edit.el (widgets): Add links. - (widget-button-face): Add link. - (widget-mouse-face): Add link. - (widget-field-face): Add link. - - * widget.texi (User Interface): Use `deffn Face' instead of - `defopt' for declaring faces. - - * custom-edit.el (custom-manual): New widget. - (custom-format-handler): Support "%a" escape. - (custom-variable): Use it. - (custom-face): Use it. - (custom-group): Use it. - - * custom.el (:link): New keyword. - (custom-declare-variable): Support it. - (custom-declare-face): Ditto. - (custom-declare-group): Ditto. - (emacs): Use it. - (customize): Ditto. - (custom-add-link): New function. - - * custom.texi (Utilities): New section. Document `custom-manual' - `custom-add-to-group', and `custom-add-link'. - - * widget.texi (url-link): New section. - (info-link): New section. - -Sat Nov 23 17:45:32 1996 Per Abrahamsen - - * Version 1.02 released. - -Sat Nov 23 17:42:31 1996 Per Abrahamsen - - * custom.el (set-face-font-family) New XEmacs function. - (custom-face-attributes): Added family support for XEmacs. - -Fri Nov 22 18:59:29 1996 Per Abrahamsen - - * Version 1.01 released. - -Fri Nov 22 16:29:08 1996 Per Abrahamsen - - * custom.el (custom-display-match-frame): Use `frame-device' to - convert a frame to a device. - - * widget-edit.el (widget-after-change): Avoid zero sized fields in - XEmacs. - (widget-field-value-create): Ditto. - - * custom.el (custom-face-display-set): Removed call to - `make-face'. Patch by David Moore . - (custom-declare-variable): If there is a saved value, use it, even - if the variable is already bound. Reported by Jens Lautenbacher - . - (custom-declare-face): If there is a saved face, use it, even - if the face is already made. - (custom-face-attributes): Added :size for XEmacs. Thanks to - William Perry for part of the code. - -Wed Nov 20 16:40:53 1996 Per Abrahamsen - - * custom-edit.el (custom-variable-value-create): Use - `default-value' instead of `symbol-value'. - (custom-variable-state-set): Ditto. - -Tue Nov 19 17:11:27 1996 Per Abrahamsen - - * widget-edit.el (custom): Wrap require in `eval-and-compile'. - -Mon Nov 18 15:55:16 1996 Per Abrahamsen - - * Version 1.00 released. - -Sat Nov 16 20:58:01 1996 Per Abrahamsen - - * custom.el (custom-help-menu): Renamed update entry to `Update - menu...'. - -Thu Nov 14 23:16:53 1996 Per Abrahamsen - - * custom-edit.el (customize-customized): Ignore uninitialized - faces and variables. - -Wed Nov 13 20:39:08 1996 Per Abrahamsen - - * Version 0.999 released. - -Wed Nov 13 12:21:56 1996 Per Abrahamsen - - * custom-edit.el: Added autolaod. - - * custom.el: Added menu support. - - * custom-edit.el (customize-customized): New command. - (custom-variable-default): Remember to evaluate default setting. - - * Version 0.998 released. - -Mon Nov 11 19:30:24 1996 Per Abrahamsen - - * widget-edit.el (widget-at): New function by William Perry - . - (widget-echo-help): Use it. - -Fri Nov 8 20:34:59 1996 Per Abrahamsen - - * widget-edit.el (widget-checklist-match-up): Cleaned up. - (function-item): Removed :match and :value-delete properties. - (variable-item): Ditto. - - * custom.el (custom-add-option): Only add option if not already - there. - (custom-declare-variable): Ditto. - - * custom-edit.el (custom-buffer-create): Reset magic. - -Thu Nov 07 16:14:35 1996 Per Abrahamsen - - * Version 0.997 released. - -Thu Nov 7 14:24:33 1996 Per Abrahamsen - - * custom-edit.el (custom-split-regexp-maybe): New function. - - * custom.el (x-color-values): Define if missing. - (frame-property): Define if missing. - (custom-background-mode): Optimized. - (custom-display-match-frame): Use above. - - * custom.el (custom-add-option): New function. - -Wed Nov 06 18:00:59 1996 Per Abrahamsen - - * Version 0.996 released. - -Wed Nov 6 09:42:33 1996 Per Abrahamsen - - * widget-edit.el (widget-children-value-delete): Renamed from - `widget-children-value-delete'. - Updated all callers. - (widget-choice-convert-widget): Renamed from `'. - - * custom-edit.el (widget-face-value-create): Add child to - `custom-options'. - (widget-face-value-delete): Added. - - * widget-edit.el (widget-keymap): Added binding for [backtab]. - Requested by Greg Stark . - -Sat Nov 2 13:40:49 1996 Per Abrahamsen - - - * custom.el (custom-set-variables): Accept `(SYMBOL VALUE [NOW])' - format. - (custom-set-faces): Accept `(FACE SPEC [NOW])' format. - * custom-edit.el (custom-save-variables): Write in new format. - (custom-save-faces): Ditto. - - * custom-edit.el (custom-format-handler): Handle `%L' escape. - (custom-group): Add `%L' escape. - (custom-face-format-handler): Use the text "hide" for sample in - shown faces. - (custom-buffer-create): Show single option. - -Tue Oct 29 13:36:11 1996 Per Abrahamsen - - * Version 0.995 released. - -Tue Oct 29 12:21:57 1996 Per Abrahamsen - - * custom.el (custom-display-match-frame): Fixed bug for - `display-type'. - - * custom.el (custom-background-mode): Memorized - `custom-background-mode' as suggested by David Moore - . - - * widget-edit.el (widget-specify-button): Make a button non-sticky - on XEmacs. - -Sun Oct 20 20:16:05 1996 Per Abrahamsen - - * custom-edit.el (easymenu): Added require. - -Mon Oct 14 15:09:43 1996 Per Abrahamsen - - * widget-edit.el: Removed `eval-and-compile' around compatibility - code. - -Sat Oct 12 21:15:04 1996 Per Abrahamsen - - * Version 0.994 released. - -Sat Oct 12 20:11:19 1996 Per Abrahamsen - - * custom.el (:options): New keyword. - - * widget-edit.el (hook): Removed widget. - (function): Allow any sexp. - - * custom-edit.el (hook): Added widget. - (custom-hook-convert-widget): New function. - - * custom.el (custom-declare-face): Check that facep is defined. - reported by Enami Tsugutomo - -Wed Oct 09 01:41:55 1996 Per Abrahamsen - - * Version 0.993 released. - -Tue Oct 8 01:48:02 1996 Per Abrahamsen - - * custom.el (custom-set-face-bold): Removed condition-case. - (custom-set-face-italic): Ditto. - (custom-face-attribites-set): Added condition-case. - (custom-set-variables): Do not bind symbol here. - (custom-set-faces): Do not create face here. - (custom-declare-variable): Use saved-value property, if is exists. - - * custom-edit.el (custom-face-format-handler): Changed `sample' to - `show'. - - * custom.el (custom-declare-face): Do not overwrite an existing - face. - -Sat Oct 05 01:23:27 1996 Per Abrahamsen - - * Version 0.992 released. - -Fri Oct 4 23:54:54 1996 Per Abrahamsen - - * widget-edit.el (character): New widget. - (widget-specify-field): Allow use of newline in format to hide - space. - -Wed Oct 2 19:06:17 1996 Per Abrahamsen - - * widget.texi (menu-choice): Document `:case-fold'. - -Wed Oct 02 19:02:45 1996 Per Abrahamsen - - * Version 0.991 released. - -Wed Oct 2 18:54:53 1996 Per Abrahamsen - - * widget-edit.el (widget-choice-action): Use :case-fold. - (menu-choice): Initialize :case-fold. - - * widget.el (:case-fold): New keyword, patch by David Byers - . - -Mon Sep 30 20:26:59 1996 Per Abrahamsen - - * lpath.el (maybe-fbind): New function. - Shut up byte compiler under XEmacs. - - * custom-edit.el (custom-format-handler): Removed unused binding. - (custom-variable-apply): Added missing argument to error. - (custom-variable-set-default): Ditto. - - * widget-edit.el (regexp): Add `:tag'. - - * custom-edit.el (custom-variable-factory): Evaluate factory - setting before applying. - -Sun Sep 29 01:24:31 1996 Per Abrahamsen - - * Version 0.99 released. - -Sun Sep 29 00:16:31 1996 Per Abrahamsen - - * widget-edit.el (widget-color-action): Notify parent. - (widget-field-action): Ditto. - (widget-choice-action): Ditto. - (widget-file-action): Ditto. - - * custom-edit.el (custom-magic-alist): Changed `item' to `const'. - (face): Fixed formatting. - (widget-face-value-create): Ditto. - (widget-face-action): Notify parent. - - * widget-edit.el (widget-field-value-get): Don't strip trailing - spaces from zero-sized fields. Requested by David Byers - . - -Sat Sep 28 00:31:54 1996 Per Abrahamsen - - * custom-edit.el (custom-save-needed-p): New variable. - (kill-emacs-hook): Add `custom-save-maybe'. - (custom-save-maybe): New function. - (custom-variable-set-default): Set `custom-save-needed-p'. - (custom-variable-factory): Ditto. - (custom-save): Ditto. - (custom-unimplemented): Deleted. - - * Version 0.98 released. - -Sat Sep 28 00:04:58 1996 Per Abrahamsen - - * widget-edit.el (widget-choice-action): Got validate wrong, once - again. - - * widget.texi (Basic Types): Documented `%h'. - -Fri Sep 27 00:32:14 1996 Per Abrahamsen - - * widget-edit.el (widget-field-action): Set value directly. - - * custom-edit.el (custom-format-handler): Use default format - handler. - - * widget-edit.el (widget-cons-match): Parameters in wrong order. - (text): Parent should be `editable-field'. - (widget-field-action): Call `widget-setup' after modification. - (symbol): Make multiple convertion kludge more robust. - (integer): Ditto. - (number): Ditto. - (widget-echo-help): New function, patch by William Perry - . - (widget-forward): Use it - (widget-echo-help-mouse): New function. - (repeat): Don't highlight tag. - (set): Ditto. - (widget-editable-list-format-handler): Default to help format - handler. - (function-item): Use default format handler. - (variable-item): Ditto. - (widget-help-format-handler): Rename to and merge with - `widget-default-format-handler'. - -Wed Sep 25 22:44:45 1996 Per Abrahamsen - - * Version 0.97 released. - -Wed Sep 25 00:12:09 1996 Per Abrahamsen - - * widget-edit.el (url-link): New widget. - - * custom-edit.el (custom-variable-set-default): Also set current - value. - - * lpath.el: Added dummy definitions to really shut up the byte - compiler. - - * custom-edit.el (custom-buffer-create): Create a help button. - - * widget-edit.el (info-link): New widget. - -Tue Sep 24 23:52:07 1996 Per Abrahamsen - - * custom.texi (The Customization Buffer): Exanded a lot. - -Mon Sep 23 18:27:55 1996 Per Abrahamsen - - * Makefile (FTPDIR): New variable. - (dist): Use it. - - * Version 0.96 released. - -Mon Sep 23 13:30:08 1996 Per Abrahamsen - - * widget.texi (editable-field): Added explanation of - :hide-front-space and :hide-rear-space. - - * widget-edit.el (widget-specify-field): Make front and rear - spaces intangible only when the :format string says it is safe, or - the user has explictly requested it. - - * widget.el (:hide-front-space): New keyword. - (:hide-rear-space): New keyword. - - * widget-edit.el (widget-field-value-create): Don't insert space - for empty values. - (widget-specify-field-update): Make null sized field have a face - that extents to the end of the line. - (widget-after-change): Make sure face is updated after extending a - fixed size field. - -Sun Sep 22 21:07:56 1996 Per Abrahamsen - - * Version 0.95 released. - -Sun Sep 22 13:44:02 1996 Per Abrahamsen - - * widget-edit.el (symbol): Kludge allowing multiple conversions. - (widget-field-value-create): Don't append spaces unless empty. - Suggested by David Byers . - (widget-field-value-get): Don't remove trailing spacesfor variable - sized fields. Suggested by David Byers . - - * custom-edit.el (custom-show): New function. - (custom-variable-value-create): Use it. - (editable-field): Only show when value has no newlines and is - shorter than 40 characters. - (custom-buffer-create): Use `switch-to-buffer' instead of - `switch-to-buffer-other-window'. - - * widget-edit.el: Added hack to make `widget-edit.el' useful even - with the old custom library. Suggested by David Byers - . - - * custom-edit.el (custom-help): Delete widget. - (custom-help-action): Delete function. - (:custom-doc): Delete keyword. - (:custom-documentation-property): Delete keyword. - (custom-format-handler): Leave `h' to `widget-help-format-handler'. - (custom): Replace `:custom-documentation-property' with - `:documentation-property'. - (custom-variable): Ditto. - (custom-face): Ditto. - (custom-group): Ditto. - - * widget-edit.el (widget-help): New widget. - (widget-help-action): New function. - (widget-help-format-handler): New function. - (function-item): New widget. - (variable-item): New widget. - (hook): New widget. - - * widget.el (:documentation-property): New keyword. - (:widget-doc): New keyword. - - * custom-edit.el (custom-variable-state-set): Compare value to - evaluted defaults. - - * widget-edit.el (radio): New sexp widget. - - * lpath.el (custom): Add require. - - * custom.el: (custom-face-empty): Test for `(boundp 'make-face)'. - Reported by enami tsugutomo . - (custom-face-display-set): Ditto. - - * lpath.el: Removed byte compiler kludge. - -Sun Sep 22 11:48:02 1996 Lars Magne Ingebrigtsen - - * custom.el (defcustom): Eval and compile. - * widget.el (define-widget-keywords): Ditto. - -Sat Sep 21 23:17:22 1996 Per Abrahamsen - - * Version 0.94 released. - -Sat Sep 21 13:26:15 1996 Per Abrahamsen - - * custom-edit.el: Added `:custom-apply', `:custom-set-default', - and `:custom-reset' keywords. - (custom-variable): Bind above. - (custom-face): Ditto. - (custom-group): Ditto. - (custom-group-menu): Activate functions below. - (custom-group-apply): New function. - (custom-group-set-default): New function. - (custom-group-reset): New function. - (custom-mode-menu): New menu. - (custom-mode): Describe all commands. - (custom-mode): Added `custom-mode-hook' hook. - (custom-apply): New command. - (custom-set-default): New command. - (custom-reset): New command. - (custom-buffer-create): Set `custom-options' properly. - (custom-buffer-create): Add `apply', `Set Default', and `Reset' - butons. - - * custom.texi (Wishlist): Remove implemented items from the - wishlist. - - * widget.texi (atoms): Document `boolean' widget. - (composite): Document `choice', `set', and `repeat' widgets. - - * widget-edit.el (boolean): New sexp widget. - - * Version 0.93 released. - -Sat Sep 21 00:57:14 1996 Per Abrahamsen - - * lpath.el Disable byte compiler hacking on XEmacs. - - * Version 0.92 released. - -Fri Sep 20 03:04:53 1996 Per Abrahamsen - - * Added support for automatic indentation of nested widgets. - - * Made code and internal API creation of nested widget more - clear and less buggy. - - * Version 0.91 released. - -Thu Sep 19 19:30:46 1996 Per Abrahamsen - - * lpath.el: Add code to shut up the compiler. - - * widget.el (define-widget-keywords): Use this to shut up the - bytecompiler. - - * widget-edit.el: (widget-field-action): New function. - (field): Added. - (string, list, vector, cons): Added tag. - - * custom-edit.el (custom-magic): New widget. - Most other widgets and functions updated to support it. - (custom-notify): New function. - (custom): Use it. - (customize-apropos): Less greedy. Thanks Ilya - Zakharevich . - - * widget-edit.el (pp-to-string): Added autoload. Thanks Ilya - Zakharevich . - -Wed Sep 18 19:24:03 1996 Per Abrahamsen - - * widget-edit.el (widget-documentation-face): New face. - (widget-specify-doc): Use it. - -Tue Sep 17 00:57:02 1996 Per Abrahamsen - - * widget-edit.el (item): Add "%d" to format. - (function): New widget. - (variable): New widget. - (regexp): New widget. - - * custom.el (custom-x-color-values): Stolen from Gnus. - (custom-background-mode): Stolen from Gnus. - (custom-display-match-frame): Should now work on XEmacs. - - * custom-edit.el: Minor cleanups in organization. - (custom-variable-value-create): Handle case where the value of a - variable does not match the type gracefully. - (custom-redraw): Renamed from `custom-reset'. - - * Version 0.9 released. - -Tue Sep 17 00:21:01 1996 Per Abrahamsen - - * widget-edit.el (widget-color-action): Use `read-prompt' in - XEmacs and `read-string' on a tty. - - * custom-edit.el (customize-apropos): Don't match undocumented - variables. - -Mon Sep 16 15:44:34 1996 Per Abrahamsen - - * custom-edit.el: Added help text to many widgets. - - * widget-edit.el (color-item): Made it a choice-item. - - * custom-edit.el (custom-level): New widget. - (custom-help): New widget. - (custom): New widget. - (custom-variable): Derive widget from `custom'. - (custom-face): Ditto. - (custom-group): Ditto. - - * widget-edit.el (widget-choose): Do not reverse the items here. - (widget-choice-action): Reverese the items here instead. - - * custom.el (keywords): Only define the keywords used by - declarations here. - - * widget-edit.el (toggle): Removed `:void' property. - - * custom.texi (Declaring Groups): Use proper defuns. - - * Makefile (TEXT): Added `ChangeLog' and `custom.texi'. - (dist): Add release to `ChangeLog'. diff -r 2947057885e5 -r a2f645c6b9f8 lisp/custom/auto-autoloads.el --- a/lisp/custom/auto-autoloads.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/custom/auto-autoloads.el Mon Aug 13 09:59:05 2007 +0200 @@ -1,7 +1,19 @@ ;;; DO NOT MODIFY THIS FILE (if (featurep 'custom-autoloads) (error "Already loaded")) -;;;### (autoloads (customize-menu-create custom-menu-create custom-save-all customize-save-customized customize-browse custom-buffer-create-other-window custom-buffer-create customize-apropos-groups customize-apropos-faces customize-apropos-options customize-apropos customize-saved customize-customized customize-face-other-window customize-face customize-option-other-window customize-option customize-group-other-window customize-group customize customize-save-variable customize-set-variable customize-set-value) "cus-edit" "custom/cus-edit.el") +;;;### (autoloads (Custom-make-dependencies) "cus-dep" "custom/cus-dep.el") + +(autoload 'Custom-make-dependencies "cus-dep" "\ +Extract custom dependencies from .el files in SUBDIRS. +SUBDIRS is a list of directories. If it is nil, the command-line +arguments are used. If it is a string, only that directory is +processed. This function is especially useful in batch mode. + +Batch usage: xemacs -batch -l cus-dep.el -f Custom-make-dependencies DIRS" t nil) + +;;;*** + +;;;### (autoloads (customize-menu-create custom-menu-create custom-save-all customize-save-customized customize-browse custom-buffer-create-other-window custom-buffer-create customize-apropos-groups customize-apropos-faces customize-apropos-options customize-apropos customize-saved customize-customized customize-face-other-window customize-face customize-option-other-window customize-variable customize-other-window customize customize-save-variable customize-set-variable customize-set-value) "cus-edit" "custom/cus-edit.el") (autoload 'customize-set-value "cus-edit" "\ Set VARIABLE to VALUE. VALUE is a Lisp object. @@ -44,18 +56,18 @@ (autoload 'customize "cus-edit" "\ Select a customization buffer which you can use to set user options. User options are structured into \"groups\". -Initially the top-level group `Emacs' and its immediate subgroups -are shown; the contents of those subgroups are initially hidden." t nil) +The default group is `Emacs'." t nil) -(autoload 'customize-group "cus-edit" "\ -Customize GROUP, which must be a customization group." t nil) +(defalias 'customize-group 'customize) -(autoload 'customize-group-other-window "cus-edit" "\ +(autoload 'customize-other-window "cus-edit" "\ Customize SYMBOL, which must be a customization group." t nil) -(defalias 'customize-variable 'customize-option) +(defalias 'customize-group-other-window 'customize-other-window) -(autoload 'customize-option "cus-edit" "\ +(defalias 'customize-option 'customize-variable) + +(autoload 'customize-variable "cus-edit" "\ Customize SYMBOL, which must be a user option variable." t nil) (defalias 'customize-variable-other-window 'customize-option-other-window) @@ -134,6 +146,10 @@ ;;;### (autoloads (custom-set-faces custom-initialize-frame custom-declare-face) "cus-face" "custom/cus-face.el") +(defcustom frame-background-mode nil "*The brightness of the background.\nSet this to the symbol dark if your background color is dark, light if\nyour background is light, or nil (default) if you want Emacs to\nexamine the brightness for you." :group 'faces :type '(choice (choice-item dark) (choice-item light) (choice-item :tag "Auto" nil))) + +(defcustom initialize-face-resources t "If non nil, allow X resources to initialize face properties.\nThis only affects faces declared with `defface', and only X11 frames." :group 'faces :type 'boolean) + (autoload 'custom-declare-face "cus-face" "\ Like `defface', but FACE is evaluated as a normal argument." nil nil) @@ -171,11 +187,7 @@ ;;;*** -;;;### (autoloads (widget-delete widget-create widget-prompt-value widget-apply) "wid-edit" "custom/wid-edit.el") - -(autoload 'widget-apply "wid-edit" "\ -Apply the value of WIDGET's PROPERTY to the widget itself. -ARGS are passed as extra arguments to the function." nil nil) +;;;### (autoloads (widget-delete widget-create widget-prompt-value) "wid-edit" "custom/wid-edit.el") (autoload 'widget-prompt-value "wid-edit" "\ Prompt for a value matching WIDGET, using PROMPT. diff -r 2947057885e5 -r a2f645c6b9f8 lisp/custom/cus-dep.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/custom/cus-dep.el Mon Aug 13 09:59:05 2007 +0200 @@ -0,0 +1,164 @@ +;;; cus-dep.el --- Find customization dependencies. +;; +;; Copyright (C) 1997 Free Software Foundation, Inc. +;; +;; Author: Per Abrahamsen , then +;; Richar Stallman , then +;; Hrvoje Niksic (rewritten for XEmacs) +;; Maintainer: Hrvoje Niksic +;; 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, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Synched up with: Not synched with FSF. + + +;;; Commentary: + +;; This file generates the custom-load files, loaded by cus-load.el. +;; The only entry point is `Custom-make-dependencies'. + +;; It works so that it scans all the `.el' files in a directory, and +;; evaluates any `defcustom', `defgroup', or `defface' expression that +;; it finds. The symbol changed by this expression is stored to a +;; hash table as the hash key, file name being the value. + +;; After all the files have been examined, custom-loads.el is +;; generated by mapping all the atoms, and seeing if any of them +;; contains a `custom-group' property. This property is a list whose +;; each element's car is the "child" group symbol. If that property +;; is in the hash-table, the file name will be looked up from the +;; hash-table, and added to cusload-file. Because the hash-table is +;; cleared whenever we process a new directory, we cannot get confused +;; by custom-loads from another directory, or from a previous +;; installation. This is also why it is perfectly safe to have old +;; custom-loads around, and have them loaded by `cus-load.el' (as +;; invoked by `cus-edit.el'). + +;; A trivial, but crucial optimization is that if cusload-file exists, +;; and no .el files in the directory are newer than cusload-file, it +;; will not be generated. This means that the directories where +;; nothing has changed will be skipped. + +;; The `custom-put' function, generated by this file, is a specialized +;; form of `put' that deals with lists, eliminating the duplicates. +;; For instance: + +;; (custom-put 'foo 'custom-loads '("bar" "baz")) +;; (get 'foo 'custom-loads) +;; => ("bar" "baz") +;; +;; (custom-put 'foo 'custom-loads '("hmph" "baz" "quz")) +;; (get 'foo 'custom-loads) +;; => ("bar" "baz" "hmph" "qux") + +;; Obviously, this allows correct incremental loading of custom-load +;; files. This is not necessary under FSF (they use a simple `put'), +;; since they have only *one* file. With the advent of packages, we +;; cannot afford the same luxury. + + +;;; Code: + +(require 'cl) +(require 'widget) +(require 'cus-edit) +(require 'cus-face) + +;; Don't change this, unless you plan to change the code in +;; cus-start.el, too. +(defconst cusload-base-file "custom-load.el") + +;;;###autoload +(defun Custom-make-dependencies (&optional subdirs) + "Extract custom dependencies from .el files in SUBDIRS. +SUBDIRS is a list of directories. If it is nil, the command-line +arguments are used. If it is a string, only that directory is +processed. This function is especially useful in batch mode. + +Batch usage: xemacs -batch -l cus-dep.el -f Custom-make-dependencies DIRS" + (interactive "DDirectory: ") + (and (stringp subdirs) + (setq subdirs (list subdirs))) + (or subdirs + ;; Usurp the command-line-args + (setq subdirs command-line-args-left + command-line-args-left nil)) + (setq subdirs (mapcar #'expand-file-name subdirs)) + (with-temp-buffer + (let ((enable-local-eval nil) + (hash (make-hash-table :test 'eq))) + (dolist (dir subdirs) + (message "Processing %s" dir) + (let ((cusload-file (expand-file-name cusload-base-file dir)) + (files (directory-files dir t "\\`[^=].*\\.el\\'"))) + ;; A trivial optimization: if no files in the directory is + ;; newer than custom-load.el, no need to do anything! + (if (and (file-exists-p cusload-file) + (dolist (file files t) + (when (file-newer-than-file-p file cusload-file) + (return nil)))) + (message "No changes need to be written.") + ;; Process directory + (dolist (file files) + (when (file-exists-p file) + (erase-buffer) + (insert-file-contents file) + (goto-char (point-min)) + (let ((name (file-name-sans-extension + (file-name-nondirectory file)))) + (condition-case nil + (while (re-search-forward + "^(defcustom\\|^(defface\\|^(defgroup" + nil t) + (beginning-of-line) + (let ((expr (read (current-buffer)))) + (eval expr) + (setf (gethash (nth 1 expr) hash) name))) + (error nil))))) + (message "Generating %s..." cusload-base-file) + (with-temp-file cusload-file + (insert ";;; " cusload-base-file + " --- automatically extracted custom dependencies\n" + "\n;; Created by " (user-full-name) " on " + (current-time-string) "\n\n;;; Code:\n\n") + (mapatoms + (lambda (sym) + (let ((members (get sym 'custom-group)) + item where found) + (when members + (while members + (setq item (car (car members)) + members (cdr members) + where (gethash item hash)) + (unless (or (null where) + (member where found)) + (if found + (insert " ") + (insert "(custom-put '" (symbol-name sym) + " 'custom-loads '(")) + (prin1 where (current-buffer)) + (push where found))) + (when found + (insert "))\n")))))) + (insert "\n;;; custom-load.el ends here\n")) + (clrhash hash))))))) + +(provide 'cus-dep) + +;;; cus-dep.el ends here diff -r 2947057885e5 -r a2f645c6b9f8 lisp/custom/cus-edit.el --- a/lisp/custom/cus-edit.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/custom/cus-edit.el Mon Aug 13 09:59:05 2007 +0200 @@ -3,24 +3,25 @@ ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen +;; Maintainer: Hrvoje Niksic ;; Keywords: help, faces -;; Version: 1.9960 +;; Version: 1.9960-x ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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. -;; GNU Emacs is distributed in the hope that it will be useful, +;; 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 GNU Emacs; see the file COPYING. If not, write to the +;; along with XEmacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. @@ -34,28 +35,17 @@ ;; that interferes with completion. Use `customize-' for commands ;; that the user will run with M-x, and `Custom-' for interactive commands. + ;;; Code: (require 'cus-face) (require 'wid-edit) (require 'easymenu) -(eval-when-compile (require 'cl)) - -(condition-case nil - (require 'cus-load) - (error nil)) - -(condition-case nil - (require 'cus-start) - (error nil)) - -(define-widget-keywords :custom-last :custom-prefix :custom-category - :custom-prefixes :custom-menu - :custom-show - :custom-magic :custom-state :custom-level :custom-form - :custom-set :custom-save :custom-reset-current :custom-reset-saved - :custom-reset-standard) - + +(require 'cus-load) +(require 'cus-start) + +;; Huh? This looks dirty! (put 'custom-define-hook 'custom-type 'hook) (put 'custom-define-hook 'standard-value '(nil)) (custom-add-to-group 'customize 'custom-define-hook 'custom-variable) @@ -64,7 +54,7 @@ (defgroup emacs nil "Customization of the One True Editor." - :link '(custom-manual "(emacs)Top")) + :link '(custom-manual "(XEmacs)Top")) ;; Most of these groups are stolen from `finder.el', (defgroup editing nil @@ -351,20 +341,9 @@ "Windows within a frame." :group 'environment) + ;;; Utilities. -(defun custom-last (x &optional n) - ;; Stolen from `cl.el'. - "Returns the last link in the list LIST. -With optional argument N, returns Nth-to-last link (default 1)." - (if n - (let ((m 0) (p x)) - (while (consp p) (incf m) (pop p)) - (if (<= n 0) p - (if (< n m) (nthcdr (- m n) x) x))) - (while (consp (cdr x)) (pop x)) - x)) - (defun custom-quote (sexp) "Quote SEXP iff it is not self quoting." (if (or (memq sexp '(t nil)) @@ -413,6 +392,17 @@ (if (symbolp v) v nil) (intern val))))) +;; Here we take not only the actual groups, but the loads, too. +(defun custom-group-prompt (prompt) + "Read group from minibuffer." + (let ((completion-ignore-case t)) + (list (completing-read + prompt obarray + (lambda (symbol) + (or (get symbol 'custom-group) + (get symbol 'custom-loads))) + t)))) + (defun custom-menu-filter (menu widget) "Convert MENU to the form used by `widget-choose'. MENU should be in the same format as `custom-variable-menu'. @@ -430,6 +420,7 @@ (push name result))) (nreverse result))) + ;;; Unlispify. (defvar custom-prefix-list nil @@ -440,8 +431,8 @@ :group 'custom-menu :type 'boolean) -(defcustom custom-unlispify-remove-prefixes nil - "Non-nil means remove group prefixes from option names in buffer." +(defcustom custom-unlispify-remove-prefixes t + "Non-nil means remove group prefixes from option names in buffers and menus." :group 'custom-menu :type 'boolean) @@ -454,8 +445,7 @@ (get symbol 'custom-tag) (concat (get symbol 'custom-tag) "..."))) (t - (save-excursion - (set-buffer (get-buffer-create " *Custom-Work*")) + (with-current-buffer (get-buffer-create " *Custom-Work*") (erase-buffer) (princ symbol (current-buffer)) (goto-char (point-min)) @@ -463,16 +453,16 @@ (re-search-forward "-p\\'" nil t)) (replace-match "" t t) (goto-char (point-min))) - (if custom-unlispify-remove-prefixes - (let ((prefixes custom-prefix-list) - prefix) - (while prefixes - (setq prefix (car prefixes)) - (if (search-forward prefix (+ (point) (length prefix)) t) - (progn - (setq prefixes nil) - (delete-region (point-min) (point))) - (setq prefixes (cdr prefixes)))))) + (when custom-unlispify-remove-prefixes + (let ((prefixes custom-prefix-list) + prefix) + (while prefixes + (setq prefix (car prefixes)) + (if (search-forward prefix (+ (point) (length prefix)) t) + (progn + (setq prefixes nil) + (delete-region (point-min) (point))) + (setq prefixes (cdr prefixes)))))) (subst-char-in-region (point-min) (point-max) ?- ?\ t) (capitalize-region (point-min) (point-max)) (unless no-suffix @@ -496,6 +486,7 @@ (concat (symbol-name symbol) "-")) prefixes)) + ;;; Guess. (defcustom custom-guess-name-alist @@ -558,6 +549,7 @@ docs nil)))))) found)) + ;;; Sorting. (defcustom custom-browse-sort-alphabetically nil @@ -634,6 +626,7 @@ ;; Since A and B cannot be groups, sort. (string-lessp namea nameb))))))) + ;;; Custom Mode Commands. (defvar custom-options nil @@ -643,19 +636,19 @@ "Set changes in all modified options." (interactive) (let ((children custom-options)) - (mapcar (lambda (child) - (when (eq (widget-get child :custom-state) 'modified) - (widget-apply child :custom-set))) - children))) + (mapc (lambda (child) + (when (eq (widget-get child :custom-state) 'modified) + (widget-apply child :custom-set))) + children))) (defun Custom-save () "Set all modified group members and save them." (interactive) (let ((children custom-options)) - (mapcar (lambda (child) - (when (memq (widget-get child :custom-state) '(modified set)) - (widget-apply child :custom-save))) - children)) + (mapc (lambda (child) + (when (memq (widget-get child :custom-state) '(modified set)) + (widget-apply child :custom-save))) + children)) (custom-save-all)) (defvar custom-reset-menu @@ -680,29 +673,30 @@ "Reset all modified group members to their current value." (interactive) (let ((children custom-options)) - (mapcar (lambda (child) - (when (eq (widget-get child :custom-state) 'modified) - (widget-apply child :custom-reset-current))) - children))) + (mapc (lambda (child) + (when (eq (widget-get child :custom-state) 'modified) + (widget-apply child :custom-reset-current))) + children))) (defun Custom-reset-saved (&rest ignore) "Reset all modified or set group members to their saved value." (interactive) (let ((children custom-options)) - (mapcar (lambda (child) - (when (eq (widget-get child :custom-state) 'modified) - (widget-apply child :custom-reset-saved))) - children))) + (mapc (lambda (child) + (when (eq (widget-get child :custom-state) 'modified) + (widget-apply child :custom-reset-saved))) + children))) (defun Custom-reset-standard (&rest ignore) "Reset all modified, set, or saved group members to their standard settings." (interactive) (let ((children custom-options)) - (mapcar (lambda (child) - (when (eq (widget-get child :custom-state) 'modified) - (widget-apply child :custom-reset-standard))) - children))) - + (mapc (lambda (child) + (when (eq (widget-get child :custom-state) 'modified) + (widget-apply child :custom-reset-standard))) + children))) + + ;;; The Customize Commands (defun custom-prompt-variable (prompt-var prompt-val) @@ -794,24 +788,12 @@ (custom-save-all)) ;;;###autoload -(defun customize () +(defun customize (group) "Select a customization buffer which you can use to set user options. User options are structured into \"groups\". -Initially the top-level group `Emacs' and its immediate subgroups -are shown; the contents of those subgroups are initially hidden." - (interactive) - (customize-group 'emacs)) - -;;;###autoload -(defun customize-group (group) - "Customize GROUP, which must be a customization group." - (interactive (list (let ((completion-ignore-case t)) - (completing-read "Customize group: (default emacs) " - obarray - (lambda (symbol) - (get symbol 'custom-group)) - t)))) - +The default group is `Emacs'." + (interactive (custom-group-prompt + "Customize group: (default emacs) ")) (when (stringp group) (if (string-equal "" group) (setq group 'emacs) @@ -826,14 +808,13 @@ (custom-unlispify-tag-name group)))))) ;;;###autoload -(defun customize-group-other-window (symbol) +(defalias 'customize-group 'customize) + +;;;###autoload +(defun customize-other-window (symbol) "Customize SYMBOL, which must be a customization group." - (interactive (list (completing-read "Customize group: (default emacs) " - obarray - (lambda (symbol) - (get symbol 'custom-group)) - t))) - + (interactive (custom-group-prompt + "Customize group: (default emacs) ")) (when (stringp symbol) (if (string-equal "" symbol) (setq symbol 'emacs) @@ -843,14 +824,17 @@ (format "*Customize Group: %s*" (custom-unlispify-tag-name symbol)))) ;;;###autoload -(defalias 'customize-variable 'customize-option) +(defalias 'customize-group-other-window 'customize-other-window) ;;;###autoload -(defun customize-option (symbol) +(defalias 'customize-option 'customize-variable) + +;;;###autoload +(defun customize-variable (symbol) "Customize SYMBOL, which must be a user option variable." (interactive (custom-variable-prompt)) (custom-buffer-create (list (list symbol 'custom-variable)) - (format "*Customize Option: %s*" + (format "*Customize Variable: %s*" (custom-unlispify-tag-name symbol)))) ;;;###autoload @@ -870,7 +854,7 @@ "Customize SYMBOL, which should be a face name or nil. If SYMBOL is nil, customize all faces." (interactive (list (completing-read "Customize face: (default all) " - obarray 'custom-facep))) + obarray 'find-face))) (if (or (null symbol) (and (stringp symbol) (zerop (length symbol)))) (custom-buffer-create (custom-sort-items (mapcar (lambda (symbol) @@ -890,7 +874,7 @@ (defun customize-face-other-window (&optional symbol) "Show customization buffer for FACE in other window." (interactive (list (completing-read "Customize face: " - obarray 'custom-facep))) + obarray 'find-face))) (if (or (null symbol) (and (stringp symbol) (zerop (length symbol)))) () (if (stringp symbol) @@ -908,7 +892,7 @@ (let ((found nil)) (mapatoms (lambda (symbol) (and (get symbol 'customized-face) - (custom-facep symbol) + (find-face symbol) (push (list symbol 'custom-face) found)) (and (get symbol 'customized-value) (boundp symbol) @@ -925,7 +909,7 @@ (let ((found nil)) (mapatoms (lambda (symbol) (and (get symbol 'saved-face) - (custom-facep symbol) + (find-face symbol) (push (list symbol 'custom-face) found)) (and (get symbol 'saved-value) (boundp symbol) @@ -951,7 +935,7 @@ (get symbol 'custom-group)) (push (list symbol 'custom-group) found)) (when (and (not (memq all '(options groups))) - (custom-facep symbol)) + (find-face symbol)) (push (list symbol 'custom-face) found)) (when (and (not (memq all '(groups faces))) (boundp symbol) @@ -986,6 +970,7 @@ (interactive "sCustomize regexp: \n") (customize-apropos regexp 'groups)) + ;;; Buffer. (defcustom custom-buffer-style 'links @@ -994,8 +979,8 @@ brackets: groups nest within each other with big horizontal brackets. links: groups have links to subgroups." - :type '(radio (const brackets) - (const links)) + :type '(radio (const :tag "brackets: Groups nest within each others" brackets) + (const :tag "links: Group have links to subgroups" links)) :group 'custom-buffer) (defcustom custom-buffer-indent 3 @@ -1035,36 +1020,35 @@ :type 'boolean :group 'custom-buffer) +(defconst custom-skip-messages 5) + (defun custom-buffer-create-internal (options &optional description) (message "Creating customization buffer...") (custom-mode) (widget-insert "This is a customization buffer") (if description (widget-insert description)) - (widget-insert ". -Square brackets show active fields; type RET or click mouse-2 -on an active field to invoke its action. Editing an option value -changes the text in the buffer; invoke the State button and -choose the Set operation to set the option value. + (widget-insert ".\n\ +Type RET or click button2 on an active field to invoke its action. Invoke ") (widget-create 'info-link :tag "Help" - :help-echo "Read the online help." - "(emacs)Easy Customization") + :help-echo "Read the online help" + "(XEmacs)Easy Customization") (widget-insert " for more information.\n\n") (message "Creating customization buttons...") (widget-insert "Operate on everything in this buffer:\n ") (widget-create 'push-button - :tag "Set for Current Session" + :tag "Set" :help-echo "\ -Make your editing in this buffer take effect for this session." +Make your editing in this buffer take effect for this session" :action (lambda (widget &optional event) (Custom-set))) (widget-insert " ") (widget-create 'push-button - :tag "Save for Future Sessions" + :tag "Save" :help-echo "\ -Make your editing in this buffer take effect for future Emacs sessions." +Make your editing in this buffer take effect for future Emacs sessions" :action (lambda (widget &optional event) (Custom-save))) (if custom-reset-button-menu @@ -1072,32 +1056,32 @@ (widget-insert " ") (widget-create 'push-button :tag "Reset" - :help-echo "Show a menu with reset operations." + :help-echo "Show a menu with reset operations" :mouse-down-action (lambda (&rest junk) t) :action (lambda (widget &optional event) (custom-reset event)))) - (widget-insert "\n ") + (widget-insert " ") (widget-create 'push-button :tag "Reset" :help-echo "\ -Reset all edited text in this buffer to reflect current values." +Reset all edited text in this buffer to reflect current values" :action 'Custom-reset-current) (widget-insert " ") (widget-create 'push-button :tag "Reset to Saved" :help-echo "\ -Reset all values in this buffer to their saved settings." +Reset all values in this buffer to their saved settings" :action 'Custom-reset-saved) (widget-insert " ") (widget-create 'push-button :tag "Reset to Standard" :help-echo "\ -Reset all values in this buffer to their standard settings." +Reset all values in this buffer to their standard settings" :action 'Custom-reset-standard)) - (widget-insert " ") + (widget-insert " ") (widget-create 'push-button - :tag "Bury Buffer" - :help-echo "Bury the buffer." + :tag "Done" + :help-echo "Bury the buffer" :action (lambda (widget &optional event) (bury-buffer))) (widget-insert "\n\n") @@ -1115,28 +1099,33 @@ (let ((count 0) (length (length options))) (mapcar (lambda (entry) - (prog2 - (message "Creating customization items %2d%%..." - (/ (* 100.0 count) length)) - (widget-create (nth 1 entry) + (prog2 + (display-message + 'progress + (format "Creating customization items %2d%%..." + (/ (* 100.0 count) length))) + (widget-create (nth 1 entry) :tag (custom-unlispify-tag-name (nth 0 entry)) :value (nth 0 entry)) - (setq count (1+ count)) - (unless (eq (preceding-char) ?\n) - (widget-insert "\n")) - (widget-insert "\n"))) - options)))) + (incf count) + (unless (eq (preceding-char) ?\n) + (widget-insert "\n")) + (widget-insert "\n"))) + options)))) (unless (eq (preceding-char) ?\n) (widget-insert "\n")) - (message "Creating customization items %2d%%...done" 100) + (display-message 'progress + (format + "Creating customization items %2d%%...done" 100)) (unless (eq custom-buffer-style 'tree) - (mapcar 'custom-magic-reset custom-options)) + (mapc 'custom-magic-reset custom-options)) (message "Creating customization setup...") (widget-setup) (goto-char (point-min)) (message "Creating customization buffer...done")) + ;;; The Tree Browser. ;;;###autoload @@ -1221,13 +1210,14 @@ (customize-face-other-window (widget-value parent)))) (defconst custom-browse-alist '((" " "space") - (" | " "vertical") - ("-\\ " "top") - (" |-" "middle") - (" `-" "bottom"))) + (" | " "vertical") + ("-\\ " "top") + (" |-" "middle") + (" `-" "bottom"))) (defun custom-browse-insert-prefix (prefix) "Insert PREFIX. On XEmacs convert it to line graphics." + ;; ### Unfinished. (if nil ; (string-match "XEmacs" emacs-version) (progn (insert "*") @@ -1241,6 +1231,7 @@ (overlay-put overlay 'end-open t))))) (insert prefix))) + ;;; Modification of Basic Widgets. ;; ;; We add extra properties to the basic widgets needed here. This is @@ -1264,7 +1255,6 @@ (define-widget 'custom-manual 'info-link "Link to the manual entry for this customization option." - :help-echo "Read the manual entry for this option." :tag "Manual") ;;; The `custom-magic' Widget. @@ -1445,7 +1435,7 @@ (widget-get parent :custom-level)))) (push (widget-create-child-and-convert widget 'choice-item - :help-echo "Change the state of this item." + :help-echo "Change the state of this item" :format (if hidden "%t" "%[%t%]") :button-prefix 'widget-push-button-prefix :button-suffix 'widget-push-button-suffix @@ -1479,7 +1469,7 @@ :button-face face :button-prefix "" :button-suffix "" - :help-echo "Change the state." + :help-echo "Change the state" :format (if hidden "%t" "%[%t%]") :tag (if (memq form '(lisp mismatch)) (concat "(" magic ")") @@ -1495,7 +1485,7 @@ ;;; The `custom' Widget. -(defface custom-button-face nil +(defface custom-button-face '((t (:bold t))) "Face used for buttons in customization buffers." :group 'custom-faces) @@ -1700,16 +1690,17 @@ (start (point)) found) (insert (or initial-string "Parent groups:")) - (mapatoms (lambda (symbol) - (let ((entry (assq name (get symbol 'custom-group)))) - (when (eq (nth 1 entry) type) - (insert " ") - (push (widget-create-child-and-convert - widget 'custom-group-link - :tag (custom-unlispify-tag-name symbol) - symbol) - buttons) - (setq found t))))) + (maphash (lambda (group ignore) + (let ((entry (assq name (get group 'custom-group)))) + (when (eq (nth 1 entry) type) + (insert " ") + (push (widget-create-child-and-convert + widget 'custom-group-link + :tag (custom-unlispify-tag-name group) + group) + buttons) + (setq found t)))) + custom-group-hash-table) (widget-put widget :buttons buttons) (if found (insert "\n") @@ -1735,7 +1726,7 @@ (define-widget 'custom-variable 'custom "Customize variable." :format "%v" - :help-echo "Set or reset this variable." + :help-echo "Set or reset this variable" :documentation-property 'variable-documentation :custom-category 'option :custom-state nil @@ -1812,7 +1803,7 @@ buttons) (push (widget-create-child-and-convert widget 'visibility - :help-echo "Show the value of this option." + :help-echo "Show the value of this option" :action 'custom-toggle-parent nil) buttons)) @@ -1829,7 +1820,7 @@ (insert (symbol-name symbol) ": ") (push (widget-create-child-and-convert widget 'visibility - :help-echo "Hide the value of this option." + :help-echo "Hide the value of this option" :action 'custom-toggle-parent t) buttons) @@ -1854,7 +1845,7 @@ widget 'item :format tag-format :action 'custom-tag-action - :help-echo "Change value of this option." + :help-echo "Change value of this option" :mouse-down-action 'custom-tag-mouse-down-action :button-face 'custom-variable-button-face :sample-face 'custom-variable-tag-face @@ -1863,7 +1854,7 @@ (insert " ") (push (widget-create-child-and-convert widget 'visibility - :help-echo "Hide the value of this option." + :help-echo "Hide the value of this option" :action 'custom-toggle-parent t) buttons) @@ -1960,7 +1951,7 @@ ("Don't show as Lisp expression" custom-variable-edit (lambda (widget) (eq (widget-get widget :custom-form) 'lisp))) - ("Show initial Lisp expression" custom-variable-edit-lisp + ("Show as Lisp expression" custom-variable-edit-lisp (lambda (widget) (eq (widget-get widget :custom-form) 'edit)))) "Alist of actions for the `custom-variable' widget. @@ -2082,7 +2073,7 @@ :format "%t: %v" :tag "Attributes" :extra-offset 12 - :button-args '(:help-echo "Control whether this attribute have any effect.") + :button-args '(:help-echo "Control whether this attribute have any effect") :args (mapcar (lambda (att) (list 'group :inline t @@ -2097,57 +2088,57 @@ "Select a display type." :tag "Display" :value t - :help-echo "Specify frames where the face attributes should be used." + :help-echo "Specify frames where the face attributes should be used" :args '((const :tag "all" t) (checklist :offset 0 :extra-offset 9 :args ((group :sibling-args (:help-echo "\ -Only match the specified window systems.") +Only match the specified window systems") (const :format "Type: " type) (checklist :inline t :offset 0 (const :format "X " :sibling-args (:help-echo "\ -The X11 Window System.") +The X11 Window System") x) (const :format "PM " :sibling-args (:help-echo "\ -OS/2 Presentation Manager.") +OS/2 Presentation Manager") pm) (const :format "Win32 " :sibling-args (:help-echo "\ -Windows NT/95/97.") +Windows NT/95/97") win32) (const :format "DOS " :sibling-args (:help-echo "\ -Plain MS-DOS.") +Plain MS-DOS") pc) (const :format "TTY%n" :sibling-args (:help-echo "\ -Plain text terminals.") +Plain text terminals") tty))) (group :sibling-args (:help-echo "\ -Only match the frames with the specified color support.") +Only match the frames with the specified color support") (const :format "Class: " class) (checklist :inline t :offset 0 (const :format "Color " :sibling-args (:help-echo "\ -Match color frames.") +Match color frames") color) (const :format "Grayscale " :sibling-args (:help-echo "\ -Match grayscale frames.") +Match grayscale frames") grayscale) (const :format "Monochrome%n" :sibling-args (:help-echo "\ -Match frames with no color support.") +Match frames with no color support") mono))) (group :sibling-args (:help-echo "\ -Only match frames with the specified intensity.") +Only match frames with the specified intensity") (const :format "\ Background brightness: " background) @@ -2155,11 +2146,11 @@ :offset 0 (const :format "Light " :sibling-args (:help-echo "\ -Match frames with light backgrounds.") +Match frames with light backgrounds") light) (const :format "Dark\n" :sibling-args (:help-echo "\ -Match frames with dark backgrounds.") +Match frames with dark backgrounds") dark))))))) ;;; The `custom-face' Widget. @@ -2171,7 +2162,7 @@ (define-widget 'custom-face 'custom "Customize face." :sample-face 'custom-face-tag-face - :help-echo "Set or reset this face." + :help-echo "Set or reset this face" :documentation-property '(lambda (face) (face-doc-string face)) :value-create 'custom-face-value-create @@ -2188,9 +2179,9 @@ (define-widget 'custom-face-all 'editable-list "An editable list of display specifications and attributes." :entry-format "%i %d %v" - :insert-button-args '(:help-echo "Insert new display specification here.") - :append-button-args '(:help-echo "Append new display specification here.") - :delete-button-args '(:help-echo "Delete this display specification.") + :insert-button-args '(:help-echo "Insert new display specification here") + :append-button-args '(:help-echo "Append new display specification here") + :delete-button-args '(:help-echo "Delete this display specification") :args '((group :format "%v" custom-display custom-face-edit))) (defconst custom-face-all (widget-convert 'custom-face-all) @@ -2243,9 +2234,8 @@ (widget-specify-sample widget begin (point)) (insert ": ")) ;; Sample. - (and (string-match "XEmacs" emacs-version) + (and (not (find-face symbol)) ;; XEmacs cannot display uninitialized faces. - (not (custom-facep symbol)) (copy-face 'custom-face-empty symbol)) (push (widget-create-child-and-convert widget 'item :format "(%{%t%})" @@ -2256,7 +2246,7 @@ (insert " ") (push (widget-create-child-and-convert widget 'visibility - :help-echo "Hide or show this face." + :help-echo "Hide or show this face" :action 'custom-toggle-parent (not (eq state 'hidden))) buttons) @@ -2444,7 +2434,7 @@ :value-get 'widget-value-value-get :validate 'widget-children-validate :action 'widget-face-action - :match '(lambda (widget value) (symbolp value))) + :match (lambda (widget value) (symbolp value))) (defun widget-face-value-create (widget) ;; Create a `custom-face' child. @@ -2514,9 +2504,14 @@ (define-widget 'custom-group-link 'link "Show parent in other window when activated." - :help-echo "Create customization buffer for this group." + :help-echo 'custom-group-link-help-echo :action 'custom-group-link-action) +(defun custom-group-link-help-echo (widget) + (concat "Create customization buffer for the `" + (custom-unlispify-tag-name (widget-value widget)) + "' group")) + (defun custom-group-link-action (widget &rest ignore) (customize-group (widget-value widget))) @@ -2555,7 +2550,7 @@ :format "%v" :sample-face-get 'custom-group-sample-face-get :documentation-property 'group-documentation - :help-echo "Set or reset all members of this group." + :help-echo "Set or reset all members of this group" :value-create 'custom-group-value-create :action 'custom-group-action :custom-category 'group @@ -2587,10 +2582,9 @@ (if (not groups-only) (get symbol 'custom-group) (let (members) - (dolist (entry (get symbol 'custom-group)) + (dolist (entry (get symbol 'custom-group) (nreverse members)) (when (eq (nth 1 entry) 'custom-group) - (push entry members))) - (nreverse members)))) + (push entry members)))))) (defun custom-group-value-create (widget) "Insert a customize group for WIDGET in the current buffer." @@ -2698,12 +2692,12 @@ (if (eq custom-buffer-style 'links) (push (widget-create-child-and-convert widget 'custom-group-link - :tag "Go to Group" + :tag "Open" symbol) buttons) (push (widget-create-child-and-convert - widget 'group-visibility - :help-echo "Show members of this group." + widget 'custom-group-visibility + :help-echo "Show members of this group" :action 'custom-toggle-parent (not (eq state 'hidden))) buttons)) @@ -2721,6 +2715,11 @@ (widget-default-format-handler widget ?h)) ;; Nested style. (t ;Visible. + (custom-load-widget widget) + ;; Update members + (setq members (custom-group-members + symbol (and (eq custom-buffer-style 'tree) + custom-browse-only-groups))) ;; Add parent groups references above the group. (if t ;;; This should test that the buffer ;;; was made to display a group. @@ -2741,7 +2740,7 @@ (insert "--------") (push (widget-create-child-and-convert widget 'visibility - :help-echo "Hide members of this group." + :help-echo "Hide members of this group" :action 'custom-toggle-parent (not (eq state 'hidden))) buttons) @@ -2774,7 +2773,6 @@ ?\ )) ;; Members. (message "Creating group...") - (custom-load-widget widget) (let* ((members (custom-sort-items members custom-buffer-sort-alphabetically custom-buffer-order-groups)) @@ -2782,26 +2780,30 @@ (custom-prefix-list (custom-prefix-add symbol prefixes)) (length (length members)) (count 0) - (children (mapcar (lambda (entry) - (widget-insert "\n") - (message "\ + (children (mapcar + (lambda (entry) + (widget-insert "\n") + (when (zerop (% count custom-skip-messages)) + (display-message + 'progress + (format "\ Creating group members... %2d%%" - (/ (* 100.0 count) length)) - (setq count (1+ count)) - (prog1 - (widget-create-child-and-convert - widget (nth 1 entry) - :group widget - :tag (custom-unlispify-tag-name - (nth 0 entry)) - :custom-prefixes custom-prefix-list - :custom-level (1+ level) - :value (nth 0 entry)) - (unless (eq (preceding-char) ?\n) - (widget-insert "\n")))) - members))) + (/ (* 100.0 count) length)))) + (incf count) + (prog1 + (widget-create-child-and-convert + widget (nth 1 entry) + :group widget + :tag (custom-unlispify-tag-name + (nth 0 entry)) + :custom-prefixes custom-prefix-list + :custom-level (1+ level) + :value (nth 0 entry)) + (unless (eq (preceding-char) ?\n) + (widget-insert "\n")))) + members))) (message "Creating group magic...") - (mapcar 'custom-magic-reset children) + (mapc 'custom-magic-reset children) (message "Creating group state...") (widget-put widget :children children) (custom-group-state-update widget) @@ -2854,43 +2856,43 @@ (defun custom-group-set (widget) "Set changes in all modified group members." (let ((children (widget-get widget :children))) - (mapcar (lambda (child) - (when (eq (widget-get child :custom-state) 'modified) - (widget-apply child :custom-set))) - children ))) + (mapc (lambda (child) + (when (eq (widget-get child :custom-state) 'modified) + (widget-apply child :custom-set))) + children))) (defun custom-group-save (widget) "Save all modified group members." (let ((children (widget-get widget :children))) - (mapcar (lambda (child) - (when (memq (widget-get child :custom-state) '(modified set)) - (widget-apply child :custom-save))) - children ))) + (mapc (lambda (child) + (when (memq (widget-get child :custom-state) '(modified set)) + (widget-apply child :custom-save))) + children))) (defun custom-group-reset-current (widget) "Reset all modified group members." (let ((children (widget-get widget :children))) - (mapcar (lambda (child) - (when (eq (widget-get child :custom-state) 'modified) - (widget-apply child :custom-reset-current))) - children ))) + (mapc (lambda (child) + (when (eq (widget-get child :custom-state) 'modified) + (widget-apply child :custom-reset-current))) + children))) (defun custom-group-reset-saved (widget) "Reset all modified or set group members." (let ((children (widget-get widget :children))) - (mapcar (lambda (child) - (when (memq (widget-get child :custom-state) '(modified set)) - (widget-apply child :custom-reset-saved))) - children ))) + (mapc (lambda (child) + (when (memq (widget-get child :custom-state) '(modified set)) + (widget-apply child :custom-reset-saved))) + children))) (defun custom-group-reset-standard (widget) "Reset all modified, set, or saved group members." (let ((children (widget-get widget :children))) - (mapcar (lambda (child) - (when (memq (widget-get child :custom-state) - '(modified set saved)) - (widget-apply child :custom-reset-standard))) - children ))) + (mapc (lambda (child) + (when (memq (widget-get child :custom-state) + '(modified set saved)) + (widget-apply child :custom-reset-standard))) + children))) (defun custom-group-state-update (widget) "Update magic." @@ -2990,7 +2992,7 @@ (princ "\n '(default ") (prin1 value) (if (or (get 'default 'face-defface-spec) - (and (not (custom-facep 'default)) + (and (not (find-face 'default)) (not (get 'default 'force-face)))) (princ ")") (princ " t)")))) @@ -3004,7 +3006,7 @@ (princ " ") (prin1 value) (if (or (get symbol 'face-defface-spec) - (and (not (custom-facep symbol)) + (and (not (find-face symbol)) (not (get symbol 'force-face)))) (princ ")") (princ " t)")))))) @@ -3034,19 +3036,14 @@ (let ((inhibit-read-only t)) (custom-save-variables) (custom-save-faces) - (save-excursion - (set-buffer (find-file-noselect custom-file)) + (with-current-buffer (find-file-noselect custom-file) (save-buffer)))) + ;;; The Customize Menu. ;;; Menu support -(defcustom custom-menu-nesting 2 - "Maximum nesting in custom menus." - :type 'integer - :group 'custom-menu) - (defun custom-face-menu-create (widget symbol) "Ignoring WIDGET, create a menu entry for customization face SYMBOL." (vector (custom-unlispify-menu-entry symbol) @@ -3072,19 +3069,12 @@ ':style 'toggle ':selected symbol))) -(if (string-match "XEmacs" emacs-version) - ;; XEmacs can create menus dynamically. - (defun custom-group-menu-create (widget symbol) - "Ignoring WIDGET, create a menu entry for customization group SYMBOL." - `( ,(custom-unlispify-menu-entry symbol t) - :filter (lambda (&rest junk) - (cdr (custom-menu-create ',symbol))))) - ;; But emacs can't. - (defun custom-group-menu-create (widget symbol) - "Ignoring WIDGET, create a menu entry for customization group SYMBOL." - ;; Limit the nesting. - (let ((custom-menu-nesting (1- custom-menu-nesting))) - (custom-menu-create symbol)))) +;; XEmacs can create menus dynamically. +(defun custom-group-menu-create (widget symbol) + "Ignoring WIDGET, create a menu entry for customization group SYMBOL." + `( ,(custom-unlispify-menu-entry symbol t) + :filter (lambda (&rest junk) + (cdr (custom-menu-create ',symbol))))) ;;;###autoload (defun custom-menu-create (symbol) @@ -3094,30 +3084,27 @@ `(customize-group ',symbol) t))) ;; Item is the entry for creating a menu buffer for SYMBOL. - (if (< custom-menu-nesting 0) - ;; We don't nest any further. - item - ;; We may nest, if the menu is not too big. - (custom-load-symbol symbol) - (if (< (length (get symbol 'custom-group)) widget-menu-max-size) - ;; The menu is not too big. - (let ((custom-prefix-list (custom-prefix-add symbol - custom-prefix-list)) - (members (custom-sort-items (get symbol 'custom-group) - custom-menu-sort-alphabetically - custom-menu-order-groups))) - ;; Create the menu. - `(,(custom-unlispify-menu-entry symbol t) - ,item - "--" - ,@(mapcar (lambda (entry) - (widget-apply (if (listp (nth 1 entry)) - (nth 1 entry) - (list (nth 1 entry))) - :custom-menu (nth 0 entry))) - members))) - ;; The menu was too big. - item)))) + ;; We may nest, if the menu is not too big. + (custom-load-symbol symbol) + (if (< (length (get symbol 'custom-group)) widget-menu-max-size) + ;; The menu is not too big. + (let ((custom-prefix-list (custom-prefix-add symbol + custom-prefix-list)) + (members (custom-sort-items (get symbol 'custom-group) + custom-menu-sort-alphabetically + custom-menu-order-groups))) + ;; Create the menu. + `(,(custom-unlispify-menu-entry symbol t) + ,item + "--" + ,@(mapcar (lambda (entry) + (widget-apply (if (listp (nth 1 entry)) + (nth 1 entry) + (list (nth 1 entry))) + :custom-menu (nth 0 entry))) + members))) + ;; The menu was too big. + item))) ;;;###autoload (defun customize-menu-create (symbol &optional name) @@ -3127,13 +3114,9 @@ The format is suitable for use with `easy-menu-define'." (unless name (setq name "Customize")) - (if (string-match "XEmacs" emacs-version) - ;; We can delay it under XEmacs. - `(,name - :filter (lambda (&rest junk) - (cdr (custom-menu-create ',symbol)))) - ;; But we must create it now under Emacs. - (cons name (cdr (custom-menu-create symbol))))) + `(,name + :filter (lambda (&rest junk) + (cdr (custom-menu-create ',symbol))))) ;;; The Custom Mode. @@ -3142,7 +3125,7 @@ (unless custom-mode-map (setq custom-mode-map (make-sparse-keymap)) - (set-keymap-parent custom-mode-map widget-keymap) + (set-keymap-parents custom-mode-map widget-keymap) (suppress-keymap custom-mode-map) (define-key custom-mode-map " " 'scroll-up) (define-key custom-mode-map "\177" 'scroll-down) @@ -3229,6 +3212,7 @@ (add-hook 'widget-edit-functions 'custom-state-buffer-message nil t) (run-hooks 'custom-mode-hook)) + ;;; The End. (provide 'cus-edit) diff -r 2947057885e5 -r a2f645c6b9f8 lisp/custom/cus-face.el --- a/lisp/custom/cus-face.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/custom/cus-face.el Mon Aug 13 09:59:05 2007 +0200 @@ -1,143 +1,70 @@ -;;; cus-face.el -- XEmacs specific custom support. +;;; cus-face.el -- Support for Custom faces. ;; ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen +;; Maintainer: Hrvoje Niksic ;; Keywords: help, faces -;; Version: 1.9960 +;; Version: 1.9960-x ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: ;; ;; See `custom.el'. +;; This file should probably be dissolved, and code moved to faces.el, +;; like Stallman did. + ;;; Code: (require 'custom) -(eval-when-compile (require 'cl)) - -;;; Compatibility. - -(if (string-match "XEmacs" emacs-version) - (defun custom-face-background (face &optional frame) - ;; Specifiers suck! - "Return the background color name of face FACE, or nil if unspecified." - (color-instance-name (specifier-instance (face-background face) frame))) - (defalias 'custom-face-background 'face-background)) - -(if (string-match "XEmacs" emacs-version) - (defun custom-face-foreground (face &optional frame) - ;; Specifiers suck! - "Return the background color name of face FACE, or nil if unspecified." - (color-instance-name (specifier-instance (face-foreground face) frame))) - (defalias 'custom-face-foreground 'face-foreground)) - -(defalias 'custom-face-font-name (if (string-match "XEmacs" emacs-version) - 'face-font-name - 'face-font)) +;; To elude the warnings for font functions. +(eval-when-compile + (require 'font)) -(eval-and-compile - (cond ((fboundp 'frame-property) - ;; XEmacs. - (defalias 'custom-frame-parameter 'frame-property)) - ((fboundp 'frame-parameter) - ;; Emacs 19.35. - (defalias 'custom-frame-parameter 'frame-parameter)) - (t - ;; Old emacsen. - (defun custom-frame-parameter (frame property &optional default) - "Return FRAME's value for property PROPERTY." - (or (cdr (assq property (frame-parameters frame))) - default)))) +;;;###autoload +(defcustom frame-background-mode nil + "*The brightness of the background. +Set this to the symbol dark if your background color is dark, light if +your background is light, or nil (default) if you want Emacs to +examine the brightness for you." + :group 'faces + :type '(choice (choice-item dark) + (choice-item light) + (choice-item :tag "Auto" nil))) - (unless (fboundp 'face-doc-string) - ;; XEmacs function missing in Emacs. - (defun face-doc-string (face) - "Get the documentation string for FACE." - (get face 'face-documentation))) - - (unless (fboundp 'set-face-doc-string) - ;; XEmacs function missing in Emacs. - (defun set-face-doc-string (face string) - "Set the documentation string for FACE to STRING." - (put face 'face-documentation string)))) -(unless (fboundp 'x-color-values) - ;; Emacs function missing in XEmacs 19.14. - (defun x-color-values (color &optional frame) - "Return a description of the color named COLOR on frame FRAME. -The value is a list of integer RGB values--(RED GREEN BLUE). -These values appear to range from 0 to 65280 or 65535, depending -on the system; white is (65280 65280 65280) or (65535 65535 65535). -If FRAME is omitted or nil, use the selected frame." - (color-instance-rgb-components (make-color-instance color)))) - -;; XEmacs and Emacs have different definitions of `facep'. -;; The Emacs definition is the useful one, so emulate that. -(cond ((not (fboundp 'facep)) - (defun custom-facep (face) - "No faces" - nil)) - ((string-match "XEmacs" emacs-version) - (defalias 'custom-facep 'find-face)) - (t - (defalias 'custom-facep 'facep))) +;; Originally, this did much more stuff, and cached the results. The +;; trouble is that, if user changes the bg color of a frame's default +;; face, the cache wouldn't get updated. This version should be fast +;; enough for use without caching, I think. +(defun get-frame-background-mode (frame) + "Detect background mode for FRAME." + (let* ((color-instance (face-background-instance 'default frame)) + (mode (condition-case nil + (if (< (apply '+ (color-instance-rgb-components + color-instance)) 65536) + 'dark + 'light) + ;; We'll get an error on a TTY; TTY-s are generally dark. + (error 'dark)))) + ;(set-frame-property 'background-mode mode) + mode)) -(unless (fboundp 'make-empty-face) - ;; This should be moved to `faces.el'. - (cond - ((string-match "XEmacs" emacs-version) - ;; Give up for old XEmacs pre 19.15/20.1. - (defalias 'make-empty-face 'make-face)) - ((fboundp 'internal-find-face) - ;; We can do faces... - (defun make-empty-face (name) - "Define a new FACE on all frames, ignoring X resources." - (interactive "SMake face: ") - (or (internal-find-face name) - (let ((face (make-vector 8 nil))) - (aset face 0 'face) - (aset face 1 name) - (let* ((frames (frame-list)) - (inhibit-quit t) - (id (internal-next-face-id))) - (make-face-internal id) - (aset face 2 id) - (while frames - (set-frame-face-alist (car frames) - (cons (cons name (copy-sequence face)) - (frame-face-alist (car frames)))) - (setq frames (cdr frames))) - (setq global-face-data (cons (cons name face) global-face-data))) - ;; add to menu - (if (fboundp 'facemenu-add-new-face) - (facemenu-add-new-face name)) - face)) - name)) - (t - (fset 'make-empty-face 'ignore)))) - +;;;###autoload (defcustom initialize-face-resources t "If non nil, allow X resources to initialize face properties. -This only affects faces declared with `defface', and only NT or X11 frames." - :group 'customize +This only affects faces declared with `defface', and only X11 frames." + :group 'faces :type 'boolean) -(cond ((fboundp 'initialize-face-resources) - ;; Already bound, do nothing. - ) - ((fboundp 'make-face-x-resource-internal) - ;; Emacs or new XEmacs. - (defun initialize-face-resources (face &optional frame) - "Initialize face according to the X11 resources. +(defun initialize-face-resources (face &optional frame) + "Initialize face according to the X11 resources. This might overwrite existing face properties. Does nothing when the variable initialize-face-resources is nil." - (when initialize-face-resources - (make-face-x-resource-internal face frame t)))) - (t - ;; Too hard to do right on XEmacs. - (defalias 'initialize-face-resources 'ignore))) + (when initialize-face-resources + (make-face-x-resource-internal face frame t))) ;;(if (string-match "XEmacs" emacs-version) ;; ;; Xemacs. @@ -156,106 +83,63 @@ ;; (interactive (list (read-face-name "Reverse face: "))) ;; (let ((fg (or (face-foreground face frame) ;; (face-foreground 'default frame) -;; (custom-frame-parameter (or frame (selected-frame)) +;; (frame-property (or frame (selected-frame)) ;; 'foreground-color) ;; "black")) ;; (bg (or (face-background face frame) ;; (face-background 'default frame) -;; (custom-frame-parameter (or frame (selected-frame)) +;; (frame-property (or frame (selected-frame)) ;; 'background-color) ;; "white"))) ;; (set-face-foreground face bg frame) ;; (set-face-background face fg frame)))) -(defcustom custom-background-mode nil - "The brightness of the background. -Set this to the symbol dark if your background color is dark, light if -your background is light, or nil (default) if you want Emacs to -examine the brightness for you." - :group 'customize - :type '(choice (const dark) - (const light) - (const :tag "default" nil))) - -(defun custom-background-mode (frame) - "Kludge to detect background mode for FRAME." - (let* ((bg-resource - (condition-case () - (x-get-resource ".backgroundMode" "BackgroundMode" 'string) - (error nil))) - color - (mode (cond (bg-resource - (intern (downcase bg-resource))) - ((and (setq color (condition-case () - (or (custom-frame-parameter - frame - 'background-color) - (custom-face-background - 'default)) - (error nil))) - (or (string-match "XEmacs" emacs-version) - window-system) - (< (apply '+ (x-color-values color)) - (/ (apply '+ (x-color-values "white")) - 3))) - 'dark) - (t 'light)))) - (modify-frame-parameters frame (list (cons 'background-mode mode))) - mode)) - -(eval-and-compile - (if (string-match "XEmacs" emacs-version) - ;; XEmacs. - (defun custom-extract-frame-properties (frame) - "Return a plist with the frame properties of FRAME used by custom." - (list 'type (device-type (frame-device frame)) - 'class (device-class (frame-device frame)) - 'background (or custom-background-mode - (custom-frame-parameter frame - 'background-mode) - (custom-background-mode frame)))) - ;; Emacs. - (defun custom-extract-frame-properties (frame) - "Return a plist with the frame properties of FRAME used by custom." - (list 'type window-system - 'class (custom-frame-parameter frame 'display-type) - 'background (or custom-background-mode - (custom-frame-parameter frame 'background-mode) - (custom-background-mode frame)))))) +(defun custom-extract-frame-properties (frame) + "Return a plist with the frame properties of FRAME used by custom." + (list 'type (device-type (frame-device frame)) + 'class (device-class (frame-device frame)) + 'background (or frame-background-mode + (frame-property frame 'background-mode) + (get-frame-background-mode frame)))) ;;; Declaring a face. ;;;###autoload (defun custom-declare-face (face spec doc &rest args) "Like `defface', but FACE is evaluated as a normal argument." - (when (or (fboundp 'load-gc) ;XEmacs. - ;; Emacs. - (and (boundp purify-flag) purify-flag)) - ;; This should be allowed, somehow. + (when (fboundp 'load-gc) + ;; This should be allowed, using specifiers. (error "Attempt to declare a face during dump")) (unless (get face 'face-defface-spec) (put face 'face-defface-spec spec) - (when (fboundp 'facep) - (unless (custom-facep face) - ;; If the user has already created the face, respect that. - (let ((value (or (get face 'saved-face) spec)) - (frames (custom-relevant-frames)) - frame) - ;; Create global face. - (make-empty-face face) - (custom-face-display-set face value) - ;; Create frame local faces - (while frames - (setq frame (car frames) - frames (cdr frames)) - (custom-face-display-set face value frame)) - (initialize-face-resources face)))) + (unless (find-face face) + ;; If the user has already created the face, respect that. + (let ((value (or (get face 'saved-face) spec)) + (frames (custom-relevant-frames)) + frame) + ;; Create global face. + (make-empty-face face) + (custom-face-display-set face value) + ;; Create frame local faces + (while frames + (setq frame (car frames) + frames (cdr frames)) + (custom-face-display-set face value frame)) + (initialize-face-resources face))) (when (and doc (null (face-doc-string face))) (set-face-doc-string face doc)) (custom-handle-all-keywords face args 'custom-face) (run-hooks 'custom-define-hook)) face) +(defun custom-face-background (face &optional frame) + "Return the background color name of face FACE, or nil if unspecified." + (color-instance-name (specifier-instance (face-background face) frame))) + +(defun custom-face-foreground (face &optional frame) + "Return the background color name of face FACE, or nil if unspecified." + (color-instance-name (specifier-instance (face-foreground face) frame))) + ;;; Font Attributes. (defconst custom-face-attributes @@ -338,7 +222,7 @@ get (nth 3 att)) (condition-case nil ;; This may fail if w3 doesn't exists. - (when get + (when get (let ((answer (funcall get face frame))) (unless (equal answer (funcall get 'default frame)) (when (widget-apply (nth 1 att) :match answer) @@ -354,7 +238,7 @@ (defun custom-face-bold (face &rest args) "Return non-nil if the font of FACE is bold." - (let* ((font (apply 'custom-face-font-name face args)) + (let* ((font (apply 'face-font-name face args)) (fontobj (font-create-object font))) (font-bold-p fontobj))) @@ -366,67 +250,60 @@ (defun custom-face-italic (face &rest args) "Return non-nil if the font of FACE is italic." - (let* ((font (apply 'custom-face-font-name face args)) + (let* ((font (apply 'face-font-name face args)) (fontobj (font-create-object font))) (font-italic-p fontobj))) (defun custom-face-stipple (face &rest args) "Return the name of the stipple file used for FACE." - (if (string-match "XEmacs" emacs-version) - (let ((image (apply 'specifier-instance - (face-background-pixmap face) args))) - (when image - (image-instance-file-name image))) - (apply 'face-stipple face args))) - -(when (string-match "XEmacs" emacs-version) - ;; Support for special XEmacs font attributes. - (autoload 'font-create-object "font" nil) + (let ((image (apply 'specifier-instance + (face-background-pixmap face) args))) + (and image + (image-instance-file-name image)))) - (defun custom-set-face-font-size (face size &rest args) - "Set the font of FACE to SIZE" - (let* ((font (apply 'custom-face-font-name face args)) - (fontobj (font-create-object font))) - (set-font-size fontobj size) - (apply 'font-set-face-font face fontobj args))) +(defun custom-set-face-font-size (face size &rest args) + "Set the font of FACE to SIZE" + (let* ((font (apply 'face-font-name face args)) + (fontobj (font-create-object font))) + (set-font-size fontobj size) + (apply 'font-set-face-font face fontobj args))) - (defun custom-face-font-size (face &rest args) - "Return the size of the font of FACE as a string." - (let* ((font (apply 'custom-face-font-name face args)) - (fontobj (font-create-object font))) - (format "%s" (font-size fontobj)))) +(defun custom-face-font-size (face &rest args) + "Return the size of the font of FACE as a string." + (let* ((font (apply 'face-font-name face args)) + (fontobj (font-create-object font))) + (format "%s" (font-size fontobj)))) - (defun custom-set-face-font-family (face family &rest args) - "Set the font of FACE to FAMILY." - (let* ((font (apply 'custom-face-font-name face args)) - (fontobj (font-create-object font))) - (set-font-family fontobj family) - (apply 'font-set-face-font face fontobj args))) +(defun custom-set-face-font-family (face family &rest args) + "Set the font of FACE to FAMILY." + (let* ((font (apply 'face-font-name face args)) + (fontobj (font-create-object font))) + (set-font-family fontobj family) + (apply 'font-set-face-font face fontobj args))) - (defun custom-face-font-family (face &rest args) - "Return the name of the font family of FACE." - (let* ((font (apply 'custom-face-font-name face args)) - (fontobj (font-create-object font))) - (font-family fontobj))) +(defun custom-face-font-family (face &rest args) + "Return the name of the font family of FACE." + (let* ((font (apply 'face-font-name face args)) + (fontobj (font-create-object font))) + (font-family fontobj))) - (setq custom-face-attributes - (append '((:family (editable-field :format "Font Family: %v" - :help-echo "\ +(setq custom-face-attributes + (append '((:family (editable-field :format "Font Family: %v" + :help-echo "\ Name of font family to use (e.g. times).") - custom-set-face-font-family - custom-face-font-family) - (:size (editable-field :format "Size: %v" - :help-echo "\ + custom-set-face-font-family + custom-face-font-family) + (:size (editable-field :format "Size: %v" + :help-echo "\ Text size (e.g. 9pt or 2mm).") - custom-set-face-font-size - custom-face-font-size) - (:strikethru (toggle :format "%[Strikethru%]: %v\n" - :help-echo "\ + custom-set-face-font-size + custom-face-font-size) + (:strikethru (toggle :format "%[Strikethru%]: %v\n" + :help-echo "\ Control whether the text should be strikethru.") - set-face-strikethru-p - face-strikethru-p)) - custom-face-attributes))) - + set-face-strikethru-p + face-strikethru-p)) + custom-face-attributes)) ;;; Frames. (defun face-spec-set (face spec &optional frame) @@ -435,27 +312,25 @@ See `defface' for information about SPEC. Clear all existing attributes first." - (when (fboundp 'copy-face) - (copy-face 'custom-face-empty face frame)) + (copy-face 'custom-face-empty face frame) (custom-face-display-set face spec frame)) (defun custom-face-display-set (face spec &optional frame) "Set FACE to the attributes to the first matching entry in SPEC. Iff optional FRAME is non-nil, set it for that frame only. See `defface' for information about SPEC." - (when (fboundp 'make-face) - (while spec - (let* ((entry (car spec)) - (display (nth 0 entry)) - (atts (nth 1 entry))) - (setq spec (cdr spec)) - (when (face-spec-set-match-display display frame) - ;; Avoid creating frame local duplicates of the global face. - (unless (and frame (eq display (get face 'custom-face-display))) - (apply 'custom-face-attributes-set face frame atts)) - (unless frame - (put face 'custom-face-display display)) - (setq spec nil)))))) + (while spec + (let* ((entry (car spec)) + (display (nth 0 entry)) + (atts (nth 1 entry))) + (setq spec (cdr spec)) + (when (face-spec-set-match-display display frame) + ;; Avoid creating frame local duplicates of the global face. + (unless (and frame (eq display (get face 'custom-face-display))) + (apply 'custom-face-attributes-set face frame atts)) + (unless frame + (put face 'custom-face-display display)) + (setq spec nil))))) (defvar custom-default-frame-properties nil "The frame properties used for the global faces. @@ -468,7 +343,7 @@ If FRAME is nil, return the default frame properties." (cond (frame ;; Try to get from cache. - (let ((cache (custom-frame-parameter frame 'custom-properties))) + (let ((cache (frame-property frame 'custom-properties))) (unless cache ;; Oh well, get it then. (setq cache (custom-extract-frame-properties frame)) @@ -506,8 +381,8 @@ ((eq req 'background) (memq background options)) (t - (message (format "\ -Warning: Unknown req `%S' with options `%S'" req options)) + (warn "Unknown req `%S' with options `%S'" + req options) nil)))) match))) @@ -527,13 +402,13 @@ (defun custom-initialize-faces (&optional frame) "Initialize all custom faces for FRAME. If FRAME is nil or omitted, initialize them for all frames." - (mapcar (lambda (symbol) - (let ((spec (or (get symbol 'saved-face) - (get symbol 'face-defface-spec)))) - (when spec - (custom-face-display-set symbol spec frame) - (initialize-face-resources symbol frame)))) - (face-list))) + (mapc (lambda (symbol) + (let ((spec (or (get symbol 'saved-face) + (get symbol 'face-defface-spec)))) + (when spec + (custom-face-display-set symbol spec frame) + (initialize-face-resources symbol frame)))) + (face-list))) ;;;###autoload (defun custom-initialize-frame (&optional frame) @@ -547,8 +422,7 @@ ;;; Initializing. -(and (fboundp 'make-face) - (make-face 'custom-face-empty)) +(make-face 'custom-face-empty) ;;;###autoload (defun custom-set-faces (&rest args) @@ -570,7 +444,7 @@ (put face 'saved-face spec) (when now (put face 'force-face t)) - (when (or now (custom-facep face)) + (when (or now (find-face face)) (face-spec-set face spec)) (setq args (cdr args))) ;; Old format, a plist of FACE SPEC pairs. diff -r 2947057885e5 -r a2f645c6b9f8 lisp/custom/cus-load.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/custom/cus-load.el Mon Aug 13 09:59:05 2007 +0200 @@ -0,0 +1,56 @@ +;;; cus-load.el --- Batch load all available cus-load files + +;; Copyright (C) 1997 by Free Software Foundation, Inc. + +;; Author: Steven L Baur +;; Keywords: internal, help, faces + +;; 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, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; In FSF all of the custom loads are in a single `cus-load' file. +;; However, we have them distributed across directories, with optional +;; incremental loading. Here we simply collect the whole set. + + +;;; Code: + +(require 'custom) + +(defun custom-put (symbol property list) + (let ((loads (get symbol property))) + (dolist (el list) + (unless (member el loads) + (setq loads (nconc loads (list el))))) + (put symbol property loads) + (puthash symbol t custom-group-hash-table))) + +(message "Loading customization dependencies...") + +(mapc (lambda (dir) + (load (expand-file-name "custom-load" dir) t t)) + load-path) + +(message "Loading customization dependencies...done") + +(provide 'cus-load) + +;;; cus-load.el ends here diff -r 2947057885e5 -r a2f645c6b9f8 lisp/custom/cus-start.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/custom/cus-start.el Mon Aug 13 09:59:05 2007 +0200 @@ -0,0 +1,200 @@ +;;; cus-start.el --- define customization properties of builtins. +;; +;; Copyright (C) 1997 Free Software Foundation, Inc. +;; +;; Author: Per Abrahamsen +;; 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, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not synched with FSF. + +;;; Commentary: +;; +;; The following code is used to define the customization properties +;; for builtin variables, and variables in the packages that are +;; preloaded /very/ early, before custom.el itself (replace.el is such +;; an example). The way it handles custom stuff is dirty, and should +;; be regarded as a last resort. DO NOT add variables here, unless +;; you know what you are doing. + +;; Must be run before the user has changed the value of any options! + + +;;; Code: + +(require 'custom) + +(defun custom-start-quote (sexp) + ;; This is copied from `cus-edit.el'. + "Quote SEXP iff it is not self quoting." + (if (or (memq sexp '(t nil)) + (and (symbolp sexp) + (eq (aref (symbol-name sexp) 0) ?:)) + (and (listp sexp) + (memq (car sexp) '(lambda))) + (stringp sexp) + (numberp sexp) + (and (fboundp 'characterp) + (characterp sexp))) + sexp + (list 'quote sexp))) + +(let ((all '(;; boolean + (abbrev-all-caps abbrev boolean) + (allow-deletion-of-last-visible-frame frames boolean) + (debug-on-quit debug boolean) + (delete-auto-save-files auto-save boolean) + (delete-exited-processes processes-basics boolean) + (indent-tabs-mode editing-basics boolean) + (load-ignore-elc-files maint boolean) + (load-warn-when-source-newer maint boolean) + (load-warn-when-source-only maint boolean) + (modifier-keys-are-sticky keyboard boolean) + (no-redraw-on-reenter display boolean) + (scroll-on-clipped-lines display boolean) + (truncate-partial-width-windows display boolean) + (visible-bell sound boolean) + (x-allow-sendevents x boolean) + (zmacs-regions editing-basics boolean) + ;; integer + (auto-save-interval auto-save integer) + (bell-volume sound integer) + (echo-keystrokes keyboard integer) + (gc-cons-threshold alloc integer) + (next-screen-context-lines display integer) + (scroll-step windows integer) + (window-min-height windows integer) + (window-min-width windows integer) + ;; object + (auto-save-file-format auto-save + (choice (const :tag "Normal" t) + (repeat (symbol :tag "Format")))) + (completion-ignored-extensions minibuffer + (repeat + (string :format "%v"))) + (debug-ignored-errors debug (repeat (choice :format "%v" + (symbol :tag "Class") + regexp))) + (debug-on-error debug (choice (const :tag "off" nil) + (const :tag "Always" t) + (repeat :menu-tag "When" + :value (nil) + (symbol + :tag "Condition")))) + (debug-on-signal debug (choice (const :tag "off" nil) + (const :tag "Always" t) + (repeat :menu-tag "When" + :value (nil) + (symbol + :tag "Condition")))) + (exec-path processes-basics (repeat + (choice :tag "Directory" + (const :tag "Default" nil) + (directory :format "%v")))) + (file-name-handler-alist data (repeat + (cons regexp + (function :tag "Handler")))) + (shell-file-name execute file) + (stack-trace-on-error debug (choice (const :tag "off" nil) + (const :tag "Always" t) + (repeat :menu-tag "When" + :value (nil) + (symbol + :tag "Condition")))) + (stack-trace-on-signal debug (choice (const :tag "off" nil) + (const :tag "Always" t) + (repeat :menu-tag "When" + :value (nil) + (symbol + :tag "Condition")))) + ;; buffer-local + (case-fold-search matching boolean) + (ctl-arrow display (choice (integer 160) + (sexp :tag "160 (default)" + :format "%t\n"))) + (fill-column fill integer) + (left-margin fill integer) + (tab-width editing-basics integer) + (truncate-lines display boolean) + ;; not documented as user-options, but should still be + ;; customizable: + (bar-cursor display (choice (const :tag "Block Cursor" nil) + (const :tag "Bar Cursor (1 pixel)" t) + (sexp :tag "Bar Cursor (2 pixels)" + :format "%t\n" 'other))) + (default-frame-plist frames (repeat + (list :inline t + :format "%v" + (symbol :tag "Parameter") + (sexp :tag "Value")))) + (disable-auto-save-when-buffer-shrinks auto-save boolean) + (find-file-use-truenames find-file boolean) + (find-file-compare-truenames find-file boolean) + (focus-follows-mouse x boolean) + (help-char keyboard character) + (max-lisp-eval-depth limits integer) + (max-specpdl-size limits integer) + (meta-prefix-char keyboard character) + (parse-sexp-ignore-comments editing-basics boolean) + (selective-display display + (choice (const :tag "off" nil) + (integer :tag "space" + :format "%v" + 1) + (const :tag "on" t))) + (selective-display-ellipses display boolean) + (signal-error-on-buffer-boundary internal boolean) + (temp-buffer-show-function + windows (radio (function-item :tag "Temp Buffers Always in Same Frame" + :format "%t\n" + show-temp-buffer-in-current-frame) + (const :tag "Temp Buffers Like Other Buffers" nil) + (function :tag "Other"))) + (undo-threshold undo integer) + (undo-high-threshold undo integer) + (words-include-escapes editing-basics boolean) + ;; These are from replace.el, which is loaded too early + ;; to be customizable. + (case-replace matching boolean) + (query-replace-highlight matching boolean) + (list-matching-lines-default-context-lines matching integer))) + this symbol group type) + (while all + (setq this (car all) + all (cdr all) + symbol (nth 0 this) + group (nth 1 this) + type (nth 2 this)) + (if (not (boundp symbol)) + ;; This is loaded so early, there is no message + (if (fboundp 'message) + ;; If variables are removed from C code, give an error here! + (message "Intrinsic `%S' not bound" symbol)) + ;; This is called before any user can have changed the value. + (put symbol 'standard-value + (list (custom-start-quote (default-value symbol)))) + ;; Add it to the right group. + (custom-add-to-group group symbol 'custom-variable) + ;; Set the type. + (put symbol 'custom-type type)))) + +;; This is to prevent it from being reloaded by `cus-load.el'. +(provide 'cus-start) + +;;; cus-start.el ends here. diff -r 2947057885e5 -r a2f645c6b9f8 lisp/custom/custom-load.el --- a/lisp/custom/custom-load.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/custom/custom-load.el Mon Aug 13 09:59:05 2007 +0200 @@ -1,7 +1,13 @@ +;;; custom-load.el --- automatically extracted custom dependencies + +;; Created by SL Baur on Sat Sep 27 08:13:41 1997 + +;;; Code: + (custom-put 'extensions 'custom-loads '("wid-edit")) (custom-put 'custom-buffer 'custom-loads '("cus-edit")) (custom-put 'custom-faces 'custom-loads '("cus-edit")) -(custom-put 'widgets 'custom-loads '("wid-browse" "wid-edit")) +(custom-put 'widgets 'custom-loads '("wid-edit" "wid-browse")) (custom-put 'environment 'custom-loads '("cus-edit")) (custom-put 'custom-menu 'custom-loads '("cus-edit")) (custom-put 'internal 'custom-loads '("cus-edit")) @@ -10,7 +16,7 @@ (custom-put 'help 'custom-loads '("cus-edit")) (custom-put 'widget-browse 'custom-loads '("wid-browse")) (custom-put 'widget-documentation 'custom-loads '("wid-edit")) -(custom-put 'customize 'custom-loads '("cus-edit" "wid-edit" "cus-face")) +(custom-put 'customize 'custom-loads '("cus-edit" "wid-edit")) (custom-put 'custom-browse 'custom-loads '("cus-edit")) (custom-put 'abbrev 'custom-loads '("cus-edit")) (custom-put 'programming 'custom-loads '("cus-edit")) @@ -21,9 +27,11 @@ (custom-put 'widget-faces 'custom-loads '("wid-edit")) (custom-put 'languages 'custom-loads '("cus-edit")) (custom-put 'custom-magic-faces 'custom-loads '("cus-edit")) -(custom-put 'faces 'custom-loads '("cus-edit" "wid-edit")) +(custom-put 'faces 'custom-loads '("cus-face" "wid-edit" "cus-edit")) (custom-put 'emacs 'custom-loads '("cus-edit")) (custom-put 'processes 'custom-loads '("cus-edit")) (custom-put 'wp 'custom-loads '("cus-edit")) (custom-put 'editing 'custom-loads '("cus-edit")) (custom-put 'i18n 'custom-loads '("cus-edit")) + +;;; custom-load.el ends here diff -r 2947057885e5 -r a2f645c6b9f8 lisp/custom/custom.el --- a/lisp/custom/custom.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/custom/custom.el Mon Aug 13 09:59:05 2007 +0200 @@ -3,24 +3,25 @@ ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen +;; Maintainer: Hrvoje Niksic ;; Keywords: help, faces -;; Version: 1.9960 +;; Version: 1.9960-x ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ -;; This file is part of GNU Emacs. +;; This file is part of XEmacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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. -;; GNU Emacs is distributed in the hope that it will be useful, +;; 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 GNU Emacs; see the file COPYING. If not, write to the +;; along with XEmacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. @@ -33,44 +34,11 @@ ;; `cus-edit.el'. ;; ;; The code implementing face declarations is in `cus-face.el' -;; -;; IMPORTANT: This version of custom is for Emacs 19.34 and XEmacs -;; 19.15 - 20.2 only. If you use Emacs 20.1, XEmacs 20.3, or anything -;; newer, please use the version of custom bundled with your emacs. -;; If you use an older emacs, please upgrade. ;;; Code: (require 'widget) -(define-widget-keywords :initialize :set :get :require :prefix :tag - :load :link :options :type :group) - -;; These autoloads should be deleted eventually. -(unless (fboundp 'load-gc) - ;; From cus-edit.el - (autoload 'customize-set-value "cus-edit" nil t) - (autoload 'customize-set-variable "cus-edit" nil t) - (autoload 'customize "cus-edit" nil t) - (autoload 'customize-browse "cus-edit" nil t) - (autoload 'customize-group "cus-edit" nil t) - (autoload 'customize-group-other-window "cus-edit" nil t) - (autoload 'customize-variable "cus-edit" nil t) - (autoload 'customize-variable-other-window "cus-edit" nil t) - (autoload 'customize-face "cus-edit" nil t) - (autoload 'customize-face-other-window "cus-edit" nil t) - (autoload 'customize-apropos "cus-edit" nil t) - (autoload 'customize-customized "cus-edit" nil t) - (autoload 'customize-saved "cus-edit" nil t) - (autoload 'custom-buffer-create "cus-edit") - (autoload 'custom-make-dependencies "cus-edit") - (autoload 'custom-menu-create "cus-edit") - (autoload 'customize-menu-create "cus-edit") - - ;; From cus-face.el - (autoload 'custom-declare-face "cus-face") - (autoload 'custom-set-faces "cus-face")) - (defvar custom-define-hook nil ;; Customize information for this option is in `cus-edit.el'. "Hook called after defining each customize option.") @@ -166,9 +134,9 @@ ((eq keyword :options) (if (get symbol 'custom-options) ;; Slow safe code to avoid duplicates. - (mapcar (lambda (option) - (custom-add-option symbol option)) - value) + (mapc (lambda (option) + (custom-add-option symbol option)) + value) ;; Fast code for the common case. (put symbol 'custom-options (copy-sequence value)))) (t @@ -269,11 +237,11 @@ "Like `defgroup', but SYMBOL is evaluated as a normal argument." (while members (apply 'custom-add-to-group symbol (car members)) - (setq members (cdr members))) + (pop members)) (put symbol 'custom-group (nconc members (get symbol 'custom-group))) (when doc (put symbol 'group-documentation doc)) - (while args + (while args (let ((arg (car args))) (setq args (cdr args)) (unless (symbolp arg) @@ -315,6 +283,10 @@ information." `(custom-declare-group (quote ,symbol) ,members ,doc ,@args)) +;; This is preloaded very early, so we avoid using CL features. +(defvar custom-group-hash-table (make-hashtable 300 'eq) + "Hash-table of non-empty groups.") + (defun custom-add-to-group (group option widget) "To existing GROUP add a new OPTION of type WIDGET. If there already is an entry for that option, overwrite it." @@ -322,7 +294,8 @@ (old (assq option members))) (if old (setcar (cdr old) widget) - (put group 'custom-group (nconc members (list (list option widget))))))) + (put group 'custom-group (nconc members (list (list option widget)))))) + (puthash group t custom-group-hash-table)) ;;; Properties. @@ -407,7 +380,7 @@ (funcall set symbol (eval value)))) (when requests (put symbol 'custom-requests requests) - (mapcar 'require requests)) + (mapc 'require requests)) (setq args (cdr args))) ;; Old format, a plist of SYMBOL VALUE pairs. (message "Warning: old format `custom-set-variables'") diff -r 2947057885e5 -r a2f645c6b9f8 lisp/custom/wid-edit.el --- a/lisp/custom/wid-edit.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/custom/wid-edit.el Mon Aug 13 09:59:05 2007 +0200 @@ -3,24 +3,25 @@ ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen +;; Maintainer: Hrvoje Niksic ;; Keywords: extensions -;; Version: 1.9960 +;; Version: 1.9960-x ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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. -;; GNU Emacs is distributed in the hope that it will be useful, +;; 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 GNU Emacs; see the file COPYING. If not, write to the +;; along with XEmacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. @@ -28,79 +29,19 @@ ;; ;; See `widget.el'. + ;;; Code: (require 'widget) -(eval-when-compile (require 'cl)) - -;;; Compatibility. - -(eval-and-compile - (autoload 'pp-to-string "pp") - (autoload 'Info-goto-node "info") - (autoload 'finder-commentary "finder" nil t) - - (when (string-match "XEmacs" emacs-version) - (condition-case nil - (require 'overlay) - (error (load-library "x-overlay")))) - - (if (string-match "XEmacs" emacs-version) - (defun widget-event-point (event) - "Character position of the end of event if that exists, or nil." - (if (mouse-event-p event) - (event-point event) - nil)) - (defun widget-event-point (event) - "Character position of the end of event if that exists, or nil." - (posn-point (event-end event)))) - - (defalias 'widget-read-event (if (string-match "XEmacs" emacs-version) - 'next-event - 'read-event)) - - ;; The following should go away when bundled with Emacs. - (condition-case () - (require 'custom) - (error nil)) - - (unless (and (featurep 'custom) (fboundp 'custom-declare-variable)) - ;; We have the old custom-library, hack around it! - (defmacro defgroup (&rest args) nil) - (defmacro defcustom (var value doc &rest args) - (` (defvar (, var) (, value) (, doc)))) - (defmacro defface (&rest args) nil) - (define-widget-keywords :prefix :tag :load :link :options :type :group) - (when (fboundp 'copy-face) - (copy-face 'default 'widget-documentation-face) - (copy-face 'bold 'widget-button-face) - (copy-face 'italic 'widget-field-face))) - - (unless (fboundp 'button-release-event-p) - ;; XEmacs function missing from Emacs. - (defun button-release-event-p (event) - "Non-nil if EVENT is a mouse-button-release event object." - (and (eventp event) - (memq (event-basic-type event) '(mouse-1 mouse-2 mouse-3)) - (or (memq 'click (event-modifiers event)) - (memq 'drag (event-modifiers event)))))) - - (unless (fboundp 'functionp) - ;; Missing from Emacs 19.34 and earlier. - (defun functionp (object) - "Non-nil of OBJECT is a type of object that can be called as a function." - (or (subrp object) (byte-code-function-p object) - (eq (car-safe object) 'lambda) - (and (symbolp object) (fboundp object))))) - - (unless (fboundp 'error-message-string) - ;; Emacs function missing in XEmacs. - (defun error-message-string (obj) - "Convert an error value to an error message." - (let ((buf (get-buffer-create " *error-message*"))) - (erase-buffer buf) - (display-error obj buf) - (buffer-string buf))))) + +(autoload 'pp-to-string "pp") +(autoload 'finder-commentary "finder" nil t) + +(defun widget-event-point (event) + "Character position of the end of event if that exists, or nil." + (if (mouse-event-p event) + (event-point event) + nil)) ;;; Customization. @@ -162,57 +103,66 @@ "Face used for editable fields." :group 'widget-faces) -(defface widget-single-line-field-face '((((class grayscale color) - (background light)) - (:background "gray85")) - (((class grayscale color) - (background dark)) - (:background "dim gray")) - (t - (:italic t))) - "Face used for editable fields spanning only a single line." - :group 'widget-faces) - -(defvar widget-single-line-display-table - (let ((table (make-display-table))) - (aset table 9 "^I") - (aset table 10 "^J") - table) - "Display table used for single-line editable fields.") - -(when (fboundp 'set-face-display-table) - (set-face-display-table 'widget-single-line-field-face - widget-single-line-display-table)) - +;; Currently unused +;(defface widget-single-line-field-face '((((class grayscale color) +; (background light)) +; (:background "gray85")) +; (((class grayscale color) +; (background dark)) +; (:background "dim gray")) +; (t +; (:italic t))) +; "Face used for editable fields spanning only a single line." +; :group 'widget-faces) +; +;(defvar widget-single-line-display-table +; (let ((table (make-display-table))) +; (aset table 9 "^I") +; (aset table 10 "^J") +; table) +; "Display table used for single-line editable fields.") +; +;(set-face-display-table 'widget-single-line-field-face +; widget-single-line-display-table) + + +;; Some functions from this file have been ported to C for speed. +;; Setting this to t (*before* loading wid-edit.el) will make them +;; shadow the subrs. It should be used only for debugging purposes. +(defvar widget-shadow-subrs nil) + + ;;; Utility functions. ;; ;; These are not really widget specific. -(defsubst widget-plist-member (plist prop) - ;; Return non-nil if PLIST has the property PROP. - ;; PLIST is a property list, which is a list of the form - ;; (PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol. - ;; Unlike `plist-get', this allows you to distinguish between a missing - ;; property and a property with the value nil. - ;; The value is actually the tail of PLIST whose car is PROP. - (while (and plist (not (eq (car plist) prop))) - (setq plist (cdr (cdr plist)))) - plist) +(when (or (not (fboundp 'widget-plist-member)) + widget-shadow-subrs) + ;; Recoded in C, for efficiency. It used to be a defsubst, but old + ;; compiled code won't fail -- it will just be slower. + (defun widget-plist-member (plist prop) + ;; Return non-nil if PLIST has the property PROP. + ;; PLIST is a property list, which is a list of the form + ;; (PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol. + ;; Unlike `plist-get', this allows you to distinguish between a missing + ;; property and a property with the value nil. + ;; The value is actually the tail of PLIST whose car is PROP. + (while (and plist (not (eq (car plist) prop))) + (setq plist (cddr plist))) + plist)) (defun widget-princ-to-string (object) ;; Return string representation of OBJECT, any Lisp object. ;; No quoting characters are used; no delimiters are printed around ;; the contents of strings. - (save-excursion - (set-buffer (get-buffer-create " *widget-tmp*")) + (with-current-buffer (get-buffer-create " *widget-tmp*") (erase-buffer) - (let ((standard-output (current-buffer))) - (princ object)) + (princ object (current-buffer)) (buffer-string))) (defun widget-clear-undo () "Clear all undo information." - (buffer-disable-undo (current-buffer)) + (buffer-disable-undo) (buffer-enable-undo)) (defcustom widget-menu-max-size 40 @@ -221,7 +171,7 @@ :group 'widgets :type 'integer) -(defcustom widget-menu-minibuffer-flag (string-match "XEmacs" emacs-version) +(defcustom widget-menu-minibuffer-flag nil "*Control how to ask for a choice from the keyboard. Non-nil means use the minibuffer; nil means read a single character." @@ -242,72 +192,54 @@ mouse event, and the number of elements in items is less than `widget-menu-max-size', a popup menu will be used, otherwise the minibuffer." - (cond ((and (< (length items) widget-menu-max-size) - event (fboundp 'x-popup-menu) window-system) - ;; We are in Emacs-19, pressed by the mouse - (x-popup-menu event - (list title (cons "" items)))) - ((and (< (length items) widget-menu-max-size) - event (fboundp 'popup-menu) window-system) - ;; We are in XEmacs, pressed by the mouse + (cond ((and (< (length items) widget-menu-max-size) + event + (console-on-window-system-p)) + ;; Pressed by the mouse. (let ((val (get-popup-menu-response (cons title - (mapcar - (function - (lambda (x) - (if (stringp x) - (vector x nil nil) - (vector (car x) (list (car x)) t)))) - items))))) + (mapcar (lambda (x) + (if (stringp x) + (vector x nil nil) + (vector (car x) (list (car x)) t))) + items))))) (setq val (and val (listp (event-object val)) (stringp (car-safe (event-object val))) (car (event-object val)))) (cdr (assoc val items)))) - (widget-menu-minibuffer-flag - ;; Read the choice of name from the minibuffer. - (setq items (widget-remove-if 'stringp items)) - (let ((val (completing-read (concat title ": ") items nil t))) - (if (stringp val) - (let ((try (try-completion val items))) - (when (stringp try) - (setq val try)) - (cdr (assoc val items))) - nil))) - (t + ((and (not widget-menu-minibuffer-flag) + ;; Can't handle more than 10 items (as many digits) + (<= (length items) 10)) ;; Construct a menu of the choices ;; and then use it for prompting for a single character. - (let* ((overriding-terminal-local-map - (make-sparse-keymap)) - map choice (next-digit ?0) - some-choice-enabled - value) + (let* ((overriding-terminal-local-map (make-sparse-keymap)) + (map (make-sparse-keymap title)) + (next-digit ?0) + some-choice-enabled value) ;; Define SPC as a prefix char to get to this menu. - (define-key overriding-terminal-local-map " " - (setq map (make-sparse-keymap title))) - (save-excursion - (set-buffer (get-buffer-create " widget-choose")) + (define-key overriding-terminal-local-map " " map) + (with-current-buffer (get-buffer-create " widget-choose") (erase-buffer) (insert "Available choices:\n\n") - (while items - (setq choice (car items) items (cdr items)) - (if (consp choice) - (let* ((name (car choice)) - (function (cdr choice))) - (insert (format "%c = %s\n" next-digit name)) - (define-key map (vector next-digit) function) - (setq some-choice-enabled t))) + (dolist (choice items) + (when (consp choice) + (let* ((name (car choice)) + (function (cdr choice))) + (insert (format "%c = %s\n" next-digit name)) + (define-key map (vector next-digit) function) + (setq some-choice-enabled t))) ;; Allocate digits to disabled alternatives ;; so that the digit of a given alternative never varies. - (setq next-digit (1+ next-digit))) + (incf next-digit)) (insert "\nC-g = Quit")) (or some-choice-enabled (error "None of the choices is currently meaningful")) (define-key map [?\C-g] 'keyboard-quit) (define-key map [t] 'keyboard-quit) - (setcdr map (nreverse (cdr map))) + ;(setcdr map (nreverse (cdr map))) ;; Unread a SPC to lead to our new menu. - (setq unread-command-events (cons ?\ unread-command-events)) + (push (character-to-event ?\ ) unread-command-events) ;; Read a char with the menu, and return the result ;; that corresponds to it. (save-window-excursion @@ -315,35 +247,33 @@ (let ((cursor-in-echo-area t)) (setq value (lookup-key overriding-terminal-local-map - (read-key-sequence title) t)))) + (read-key-sequence (concat title ": ") t))))) + (message "") (when (eq value 'keyboard-quit) (error "Canceled")) - value)))) - -(defun widget-remove-if (predictate list) - (let (result (tail list)) - (while tail - (or (funcall predictate (car tail)) - (setq result (cons (car tail) result))) - (setq tail (cdr tail))) - (nreverse result))) - + value)) + (t + ;; Read the choice of name from the minibuffer. + (setq items (remove-if 'stringp items)) + (let ((val (completing-read (concat title ": ") items nil t))) + (if (stringp val) + (let ((try (try-completion val items))) + (when (stringp try) + (setq val try)) + (cdr (assoc val items))) + nil))))) + + ;;; Widget text specifications. ;; ;; These functions are for specifying text properties. -(defcustom widget-field-add-space - (or t - ;; It shouldn't be necessary in 20.3, but I need to debug it first. - (< emacs-major-version 20) - (and (eq emacs-major-version 20) - (< emacs-minor-version 3)) - (not (string-match "XEmacs" emacs-version))) +(defcustom widget-field-add-space t + ;; Setting this to nil might be available, once some problems are resolved. "Non-nil means add extra space at the end of editable text fields. -This is needed on all versions of Emacs, and on XEmacs before 20.3. -If you don't add the space, it will become impossible to edit a zero -size field." +This is needed on all versions of Emacs. If you don't add the space, +it will become impossible to edit a zero size field." :type 'boolean :group 'widgets) @@ -366,40 +296,41 @@ (forward-char 1)) ;; Terminating space is not part of the field, but necessary in ;; order for local-map to work. Remove next sexp if local-map works - ;; at the end of the overlay. + ;; at the end of the extent. (widget-field-add-space (insert-and-inherit " "))) (setq to (point))) (let ((map (widget-get widget :keymap)) (face (or (widget-get widget :value-face) 'widget-field-face)) (help-echo (widget-get widget :help-echo)) - (overlay (make-overlay from to nil - nil (or (not widget-field-add-space) - (widget-get widget :size))))) + (extent (make-extent from to))) (unless (or (stringp help-echo) (null help-echo)) (setq help-echo 'widget-mouse-help)) - (widget-put widget :field-overlay overlay) - (overlay-put overlay 'detachable nil) - (overlay-put overlay 'field widget) - (overlay-put overlay 'local-map map) - (overlay-put overlay 'keymap map) - (overlay-put overlay 'face face) - (overlay-put overlay 'balloon-help help-echo) - (overlay-put overlay 'help-echo help-echo))) + (widget-put widget :field-extent extent) + (and (or (not widget-field-add-space) + (widget-get widget :size)) + (set-extent-property extent 'end-closed t)) + (set-extent-property extent 'detachable nil) + (set-extent-property extent 'field widget) + (set-extent-property extent 'keymap map) + (set-extent-property extent 'face face) + (set-extent-property extent 'balloon-help help-echo) + (set-extent-property extent 'help-echo help-echo))) (defun widget-specify-button (widget from to) "Specify button for WIDGET between FROM and TO." (let ((face (widget-apply widget :button-face-get)) (help-echo (widget-get widget :help-echo)) - (overlay (make-overlay from to nil t nil))) - (widget-put widget :button-overlay overlay) + (extent (make-extent from to))) + (widget-put widget :button-extent extent) (unless (or (null help-echo) (stringp help-echo)) (setq help-echo 'widget-mouse-help)) - (overlay-put overlay 'button widget) - (overlay-put overlay 'mouse-face widget-mouse-face) - (overlay-put overlay 'balloon-help help-echo) - (overlay-put overlay 'help-echo help-echo) - (overlay-put overlay 'face face))) + (set-extent-property extent 'start-open t) + (set-extent-property extent 'button widget) + (set-extent-property extent 'mouse-face widget-mouse-face) + (set-extent-property extent 'balloon-help help-echo) + (set-extent-property extent 'help-echo help-echo) + (set-extent-property extent 'face face))) (defun widget-mouse-help (extent) "Find mouse help string for button in extent." @@ -407,7 +338,7 @@ (help-echo (and widget (widget-get widget :help-echo)))) (cond ((stringp help-echo) help-echo) - ((and (symbolp help-echo) (fboundp help-echo) + ((and (functionp help-echo) (stringp (setq help-echo (funcall help-echo widget)))) help-echo) (t @@ -416,33 +347,34 @@ (defun widget-specify-sample (widget from to) ;; Specify sample for WIDGET between FROM and TO. (let ((face (widget-apply widget :sample-face-get)) - (overlay (make-overlay from to nil t nil))) - (overlay-put overlay 'face face) - (widget-put widget :sample-overlay overlay))) + (extent (make-extent from to nil))) + (set-extent-property extent 'start-open t) + (set-extent-property extent 'face face) + (widget-put widget :sample-extent extent))) (defun widget-specify-doc (widget from to) ;; Specify documentation for WIDGET between FROM and TO. - (let ((overlay (make-overlay from to nil t nil))) - (overlay-put overlay 'widget-doc widget) - (overlay-put overlay 'face widget-documentation-face) - (widget-put widget :doc-overlay overlay))) + (let ((extent (make-extent from to))) + (set-extent-property extent 'start-open t) + (set-extent-property extent 'widget-doc widget) + (set-extent-property extent 'face widget-documentation-face) + (widget-put widget :doc-extent extent))) (defmacro widget-specify-insert (&rest form) ;; Execute FORM without inheriting any text properties. - (` - (save-restriction + `(save-restriction (let ((inhibit-read-only t) - result before-change-functions after-change-functions) (insert "<>") (narrow-to-region (- (point) 2) (point)) (goto-char (1+ (point-min))) - (setq result (progn (,@ form))) - (delete-region (point-min) (1+ (point-min))) - (delete-region (1- (point-max)) (point-max)) - (goto-char (point-max)) - result)))) + ;; We use `prog1' instead of a `result' variable, as the latter + ;; confuses the byte-compiler in some cases (a warning). + (prog1 (progn ,@form) + (delete-region (point-min) (1+ (point-min))) + (delete-region (1- (point-max)) (point-max)) + (goto-char (point-max)))))) (defface widget-inactive-face '((((class grayscale color) (background dark)) @@ -458,56 +390,65 @@ (defun widget-specify-inactive (widget from to) "Make WIDGET inactive for user modifications." (unless (widget-get widget :inactive) - (let ((overlay (make-overlay from to nil t nil))) - (overlay-put overlay 'face 'widget-inactive-face) + (let ((extent (make-extent from to))) + (set-extent-property extent 'start-open t) + (set-extent-property extent 'face 'widget-inactive-face) ;; This is disabled, as it makes the mouse cursor change shape. - ;; (overlay-put overlay 'mouse-face 'widget-inactive-face) - (overlay-put overlay 'evaporate t) - (overlay-put overlay 'priority 100) - (overlay-put overlay (if (string-match "XEmacs" emacs-version) - 'read-only - 'modification-hooks) '(widget-overlay-inactive)) - (widget-put widget :inactive overlay)))) - -(defun widget-overlay-inactive (&rest junk) - "Ignoring the arguments, signal an error." - (unless inhibit-read-only - (error "Attempt to modify inactive widget"))) + ;(set-extent-property extent 'mouse-face 'widget-inactive-face) + ;; ...actually, in XEmacs, we can easily choose our own pointer + ;; shapes. However, the mouse-face of the "inner" extent will + ;; still be drawn. + (set-extent-property extent 'detachable t) + (set-extent-property extent 'priority 100) + (set-extent-property extent 'read-only 't) + (widget-put widget :inactive extent)))) + +;; We don't have modification functions, so this is unused. +;(defun widget-overlay-inactive (&rest junk) +; "Ignoring the arguments, signal an error." +; (unless inhibit-read-only +; (error "Attempt to modify inactive widget"))) (defun widget-specify-active (widget) "Make WIDGET active for user modifications." (let ((inactive (widget-get widget :inactive))) (when inactive - (delete-overlay inactive) + (delete-extent inactive) (widget-put widget :inactive nil)))) + ;;; Widget Properties. -(defsubst widget-type (widget) +(defun widget-type (widget) "Return the type of WIDGET, a symbol." (car widget)) -(defun widget-put (widget property value) - "In WIDGET set PROPERTY to VALUE. +(when (or (not (fboundp 'widget-put)) + widget-shadow-subrs) + (defun widget-put (widget property value) + "In WIDGET set PROPERTY to VALUE. The value can later be retrived with `widget-get'." - (setcdr widget (plist-put (cdr widget) property value))) - -(defun widget-get (widget property) - "In WIDGET, get the value of PROPERTY. + (setcdr widget (plist-put (cdr widget) property value)))) + +;; Recoded in C, for efficiency: +(when (or (not (fboundp 'widget-get)) + widget-shadow-subrs) + (defun widget-get (widget property) + "In WIDGET, get the value of PROPERTY. The value could either be specified when the widget was created, or later with `widget-put'." - (let ((missing t) - value tmp) - (while missing - (cond ((setq tmp (widget-plist-member (cdr widget) property)) - (setq value (car (cdr tmp)) - missing nil)) - ((setq tmp (car widget)) - (setq widget (get tmp 'widget-type))) - (t - (setq missing nil)))) - value)) + (let ((missing t) + value tmp) + (while missing + (cond ((setq tmp (widget-plist-member (cdr widget) property)) + (setq value (car (cdr tmp)) + missing nil)) + ((setq tmp (car widget)) + (setq widget (get tmp 'widget-type))) + (t + (setq missing nil)))) + value))) (defun widget-get-indirect (widget property) "In WIDGET, get the value of PROPERTY. @@ -526,11 +467,13 @@ (widget-member (get (car widget) 'widget-type) property)) (t nil))) -;;;###autoload -(defun widget-apply (widget property &rest args) - "Apply the value of WIDGET's PROPERTY to the widget itself. +(when (or (not (fboundp 'widget-apply)) + widget-shadow-subrs) + ;;This is in C, so don't ###utoload + (defun widget-apply (widget property &rest args) + "Apply the value of WIDGET's PROPERTY to the widget itself. ARGS are passed as extra arguments to the function." - (apply (widget-get widget property) widget args)) + (apply (widget-get widget property) widget args))) (defun widget-value (widget) "Extract the current value of WIDGET." @@ -558,6 +501,7 @@ (widget-apply widget :action event) (error "Attempt to perform action on inactive widget"))) + ;;; Helper functions. ;; ;; These are widget specific. @@ -597,21 +541,16 @@ The arguments MAPARG, and BUFFER default to nil and (current-buffer), respectively." - (let ((cur (point-min)) - (widget nil) - ;; (parent nil) - (overlays (if buffer - (save-excursion (set-buffer buffer) (overlay-lists)) - (overlay-lists)))) - (setq overlays (append (car overlays) (cdr overlays))) - (while (setq cur (pop overlays)) - (setq widget (overlay-get cur 'button)) - (if (and widget (funcall function widget maparg)) - (setq overlays nil))))) - + (map-extents (lambda (extent ignore) + ;; If FUNCTION returns non-nil, we bail out + (funcall function (extent-property extent 'button) maparg)) + nil nil nil nil nil + 'button)) + + ;;; Glyphs. -(defcustom widget-glyph-directory (concat data-directory "custom/") +(defcustom widget-glyph-directory (locate-data-directory "custom") "Where widget glyphs are located. If this variable is nil, widget will try to locate the directory automatically." @@ -633,48 +572,52 @@ (repeat :tag "Suffixes" (string :format "%v"))))) +(defvar widget-glyph-cache nil + "Cache of glyphs associated with strings (files).") + (defun widget-glyph-find (image tag) "Create a glyph corresponding to IMAGE with string TAG as fallback. -IMAGE should either already be a glyph, or be a file name sans -extension (xpm, xbm, gif, jpg, or png) located in -`widget-glyph-directory'." - (cond ((not (and image - (string-match "XEmacs" emacs-version) - widget-glyph-enable - (fboundp 'make-glyph) - (fboundp 'locate-file) - image)) - ;; We don't want or can't use glyphs. +IMAGE can already be a glyph, or a file name sans extension (xpm, + xbm, gif, jpg, or png) located in `widget-glyph-directory', or + in one of the data directories. +It can also be a valid image instantiator, in which case it will be + used to make the glyph, with an additional TAG string fallback. +If IMAGE is a list, it will be given unchanged to `make-glyph'." + (cond ((not (and image widget-glyph-enable)) + ;; We don't want to use glyphs. nil) - ((and (fboundp 'glyphp) - (glyphp image)) + ((glyphp image) ;; Already a glyph. Use it. image) ((stringp image) - ;; A string. Look it up in relevant directories. - (let* ((dirlist (list (or widget-glyph-directory - (concat data-directory - "custom/")) - data-directory)) - (formats widget-image-conversion) - file) - (while (and formats (not file)) - (when (valid-image-instantiator-format-p (car (car formats))) - (setq file (locate-file image dirlist - (mapconcat 'identity - (cdr (car formats)) - ":")))) - (unless file - (setq formats (cdr formats)))) - (and file - ;; We create a glyph with the file as the default image - ;; instantiator, and the TAG fallback - (make-glyph (list (vector (car (car formats)) ':file file) - (vector 'string ':data tag)))))) + ;; A string. Look it up in the cache first... + (or (lax-plist-get widget-glyph-cache image) + ;; ...and then in the relevant directories + (let* ((dirlist (cons (or widget-glyph-directory + (locate-data-directory "custom")) + data-directory-list)) + (formats widget-image-conversion) + file) + (while (and formats (not file)) + (when (valid-image-instantiator-format-p (caar formats)) + (setq file (locate-file image dirlist + (mapconcat 'identity (cdar formats) + ":")))) + (unless file + (pop formats))) + (when file + ;; We create a glyph with the file as the default image + ;; instantiator, and the TAG fallback + (let ((glyph (make-glyph `([,(caar formats) :file ,file] + [string :data ,tag])))) + ;; Cache the glyph + (setq widget-glyph-cache + (lax-plist-put widget-glyph-cache image glyph)) + ;; ...and return it + glyph))))) ((valid-instantiator-p image 'image) ;; A valid image instantiator (e.g. [gif :file "somefile"] etc.) - (make-glyph (list image - (vector 'string ':data tag)))) + (make-glyph `(,image [string :data ,tag]))) ((consp image) ;; This could be virtually anything. Let `make-glyph' sort it out. (make-glyph image)) @@ -684,25 +627,20 @@ (defun widget-glyph-insert (widget tag image &optional down inactive) "In WIDGET, insert the text TAG or, if supported, IMAGE. -IMAGE should either be a glyph, an image instantiator, or an image file +IMAGE should either be a glyph, an image instantiator, an image file name sans extension (xpm, xbm, gif, jpg, or png) located in -`widget-glyph-directory'. +`widget-glyph-directory', or anything else allowed by +`widget-glyph-find'. Optional arguments DOWN and INACTIVE is used instead of IMAGE when the glyph is pressed or inactive, respectively. -WARNING: If you call this with a glyph, and you want the user to be -able to invoke the glyph, make sure it is unique. If you use the -same glyph for multiple widgets, invoking any of the glyphs will -cause the last created widget to be invoked. - Instead of an instantiator, you can also use a list of instantiators, or whatever `make-glyph' will accept. However, in that case you must provide the fallback TAG as a part of the instantiator yourself." (let ((glyph (widget-glyph-find image tag))) (if glyph - (widget-glyph-insert-glyph widget - glyph + (widget-glyph-insert-glyph widget glyph (widget-glyph-find down tag) (widget-glyph-find inactive tag)) (insert tag)))) @@ -711,27 +649,23 @@ "In WIDGET, insert GLYPH. If optional arguments DOWN and INACTIVE are given, they should be glyphs used when the widget is pushed and inactive, respectively." - (when widget - (set-glyph-property glyph 'widget widget) - (when down - (set-glyph-property down 'widget widget)) - (when inactive - (set-glyph-property inactive 'widget widget))) (insert "*") - (let ((ext (make-extent (point) (1- (point)))) + (let ((extent (make-extent (point) (1- (point)))) (help-echo (and widget (widget-get widget :help-echo)))) - (set-extent-property ext 'invisible t) - (set-extent-property ext 'start-open t) - (set-extent-property ext 'end-open t) - (set-extent-end-glyph ext glyph) + (set-extent-property extent 'widget widget) + (set-extent-property extent 'invisible t) + (set-extent-property extent 'start-open t) + (set-extent-property extent 'end-open t) + (set-extent-end-glyph extent glyph) (when help-echo - (set-extent-property ext 'balloon-help help-echo) - (set-extent-property ext 'help-echo help-echo))) + (set-extent-property extent 'balloon-help help-echo) + (set-extent-property extent 'help-echo help-echo))) (when widget (widget-put widget :glyph-up glyph) (when down (widget-put widget :glyph-down down)) (when inactive (widget-put widget :glyph-inactive inactive)))) + ;;; Buttons. (defgroup widget-button nil @@ -748,6 +682,7 @@ :type 'string :group 'widget-button) + ;;; Creating Widgets. ;;;###autoload @@ -840,7 +775,7 @@ (let ((value (widget-get widget :value))) (widget-put widget :value (widget-apply widget :value-to-internal value)))) - ;; Return the newly create widget. + ;; Return the newly created widget. widget)) (defun widget-insert (&rest args) @@ -879,26 +814,30 @@ (apply 'widget-convert-text type from to from to args)) (defun widget-leave-text (widget) - "Remove markers and overlays from WIDGET and its children." + "Remove markers and extents from WIDGET and its children." (let ((from (widget-get widget :from)) (to (widget-get widget :to)) - (button (widget-get widget :button-overlay)) - (sample (widget-get widget :sample-overlay)) - (doc (widget-get widget :doc-overlay)) - (field (widget-get widget :field-overlay)) + (button (widget-get widget :button-extent)) + (sample (widget-get widget :sample-extent)) + (doc (widget-get widget :doc-extent)) + (field (widget-get widget :field-extent)) (children (widget-get widget :children))) (set-marker from nil) (set-marker to nil) + ;; Maybe we should delete the extents here? As this code doesn't + ;; remove them from widget structures, maybe it's safer to just + ;; detach them. That's what `delete-overlay' did. (when button - (delete-overlay button)) + (detach-extent button)) (when sample - (delete-overlay sample)) + (detach-extent sample)) (when doc - (delete-overlay doc)) + (detach-extent doc)) (when field - (delete-overlay field)) - (mapcar 'widget-leave-text children))) - + (detach-extent field)) + (mapc 'widget-leave-text children))) + + ;;; Keymap and Commands. (defvar widget-keymap nil @@ -907,15 +846,13 @@ (unless widget-keymap (setq widget-keymap (make-sparse-keymap)) - (define-key widget-keymap "\t" 'widget-forward) + (define-key widget-keymap [tab] 'widget-forward) (define-key widget-keymap [(shift tab)] 'widget-backward) + (define-key widget-keymap [(meta tab)] 'widget-backward) (define-key widget-keymap [backtab] 'widget-backward) - (if (string-match "XEmacs" emacs-version) - (progn - ;;Glyph support. - (define-key widget-keymap [button1] 'widget-button1-click) - (define-key widget-keymap [button2] 'widget-button-click)) - (define-key widget-keymap [down-mouse-2] 'widget-button-click)) + ;;Glyph support. + (define-key widget-keymap [button1] 'widget-button1-click) + (define-key widget-keymap [button2] 'widget-button-click) (define-key widget-keymap "\C-m" 'widget-button-press)) (defvar widget-global-map global-map @@ -926,26 +863,27 @@ "Keymap used inside an editable field.") (unless widget-field-keymap - (setq widget-field-keymap (copy-keymap widget-keymap)) - (unless (string-match "XEmacs" (emacs-version)) - (define-key widget-field-keymap [menu-bar] 'nil)) + (setq widget-field-keymap (make-sparse-keymap)) + (set-keymap-parents widget-field-keymap global-map) (define-key widget-field-keymap "\C-k" 'widget-kill-line) - (define-key widget-field-keymap "\M-\t" 'widget-complete) + (define-key widget-field-keymap [(meta tab)] 'widget-complete) + (define-key widget-field-keymap [tab] 'widget-forward) + (define-key widget-field-keymap [(shift tab)] 'widget-backward) (define-key widget-field-keymap "\C-m" 'widget-field-activate) (define-key widget-field-keymap "\C-a" 'widget-beginning-of-line) (define-key widget-field-keymap "\C-e" 'widget-end-of-line) - (set-keymap-parent widget-field-keymap global-map)) + (define-key widget-field-keymap "\C-t" 'widget-transpose-chars)) (defvar widget-text-keymap nil "Keymap used inside a text field.") (unless widget-text-keymap - (setq widget-text-keymap (copy-keymap widget-keymap)) - (unless (string-match "XEmacs" (emacs-version)) - (define-key widget-text-keymap [menu-bar] 'nil)) + (setq widget-text-keymap (make-sparse-keymap)) + (set-keymap-parents widget-field-keymap global-map) (define-key widget-text-keymap "\C-a" 'widget-beginning-of-line) (define-key widget-text-keymap "\C-e" 'widget-end-of-line) - (set-keymap-parent widget-text-keymap global-map)) + (define-key widget-text-keymap "\C-t" 'widget-transpose-chars)) + (defun widget-field-activate (pos &optional event) "Invoke the ediable field at point." @@ -967,61 +905,54 @@ (defun widget-button-click (event) "Invoke button below mouse pointer." (interactive "@e") - (cond ((and (fboundp 'event-glyph) - (event-glyph event)) + (cond ((event-glyph event) (widget-glyph-click event)) ((widget-event-point event) (let* ((pos (widget-event-point event)) (button (get-char-property pos 'button))) (if button - (let* ((overlay (widget-get button :button-overlay)) - (face (overlay-get overlay 'face)) - (mouse-face (overlay-get overlay 'mouse-face))) + (let* ((extent (widget-get button :button-extent)) + (face (extent-property extent 'face)) + (mouse-face (extent-property extent 'mouse-face))) (unwind-protect - (let ((track-mouse t)) - (overlay-put overlay - 'face 'widget-button-pressed-face) - (overlay-put overlay - 'mouse-face 'widget-button-pressed-face) + (progn + (set-extent-property extent 'face + 'widget-button-pressed-face) + (set-extent-property extent 'mouse-face + 'widget-button-pressed-face) (unless (widget-apply button :mouse-down-action event) (while (not (button-release-event-p event)) - (setq event (widget-read-event) + (setq event (next-event) pos (widget-event-point event)) (if (and pos (eq (get-char-property pos 'button) button)) - (progn - (overlay-put overlay - 'face - 'widget-button-pressed-face) - (overlay-put overlay - 'mouse-face - 'widget-button-pressed-face)) - (overlay-put overlay 'face face) - (overlay-put overlay 'mouse-face mouse-face)))) + (progn + (set-extent-property extent 'face + 'widget-button-pressed-face) + (set-extent-property extent 'mouse-face + 'widget-button-pressed-face)) + (set-extent-property extent 'face face) + (set-extent-property extent + 'mouse-face mouse-face)))) (when (and pos (eq (get-char-property pos 'button) button)) (widget-apply-action button event))) - (overlay-put overlay 'face face) - (overlay-put overlay 'mouse-face mouse-face))) + (set-extent-property extent 'face face) + (set-extent-property extent 'mouse-face mouse-face))) (let ((up t) command) ;; Find the global command to run, and check whether it ;; is bound to an up event. (cond ((setq command ;down event - (lookup-key widget-global-map [ button2 ])) - (setq up nil)) - ((setq command ;down event - (lookup-key widget-global-map [ down-mouse-2 ])) + (lookup-key widget-global-map [button2])) (setq up nil)) ((setq command ;up event - (lookup-key widget-global-map [ button2up ]))) - ((setq command ;up event - (lookup-key widget-global-map [ mouse-2])))) + (lookup-key widget-global-map [button2up])))) (when up ;; Don't execute up events twice. (while (not (button-release-event-p event)) - (setq event (widget-read-event)))) + (setq event (next-event)))) (when command (call-interactively command)))))) (t @@ -1030,16 +961,17 @@ (defun widget-button1-click (event) "Invoke glyph below mouse pointer." (interactive "@e") - (if (and (fboundp 'event-glyph) - (event-glyph event)) + (if (event-glyph event) (widget-glyph-click event) - (call-interactively (lookup-key widget-global-map (this-command-keys))))) + (let ((command (lookup-key widget-global-map (this-command-keys)))) + (and (commandp command) + (call-interactively command))))) (defun widget-glyph-click (event) "Handle click on a glyph." (let* ((glyph (event-glyph event)) - (widget (glyph-property glyph 'widget)) (extent (event-glyph-extent event)) + (widget (extent-property extent 'widget)) (down-glyph (or (and widget (widget-get widget :glyph-down)) glyph)) (up-glyph (or (and widget (widget-get widget :glyph-up)) glyph)) (last event)) @@ -1054,7 +986,7 @@ (set-extent-property extent 'end-glyph up-glyph)) ;; Apply widget action. (when (eq extent (event-glyph-extent last)) - (let ((widget (glyph-property (event-glyph event) 'widget))) + (let ((widget (extent-property (event-glyph-extent event) 'widget))) (cond ((null widget) (message "You clicked on a glyph.")) ((not (widget-apply widget :active)) @@ -1077,8 +1009,7 @@ POS defaults to the value of (point)." (unless pos (setq pos (point))) - (let ((widget (or (get-char-property (point) 'button) - (get-char-property (point) 'field)))) + (let ((widget (widget-at pos))) (if widget (let ((order (widget-get widget :tab-order))) (if order @@ -1088,27 +1019,61 @@ widget)) nil))) -(defcustom widget-use-overlay-change (string-match "XEmacs" emacs-version) - "If non-nil, use overlay change functions to tab around in the buffer. -This is much faster, but doesn't work reliably on Emacs 19.34." - :type 'boolean - :group 'widgets) +;; Return the button or field extent at point. +(defun widget-button-or-field-extent (pos) + (or (and (get-char-property pos 'button) + (widget-get (get-char-property pos 'button) + :button-extent)) + (and (get-char-property pos 'field) + (widget-get (get-char-property pos 'field) + :field-extent)))) + +(defun widget-next-button-or-field (pos) + "Find the next button, or field, and return its start position. +If none is found, return (point-max). +Internal function, don't use it outside `wid-edit'." + (let* ((at-point (widget-button-or-field-extent pos)) + (extent (map-extents + (lambda (ext ignore) + (if (or (extent-property ext 'button) + (extent-property ext 'field)) + ext + nil)) + nil (if at-point (extent-end-position at-point) pos) nil))) + (if extent + (extent-start-position extent) + (point-max)))) + +(defun widget-previous-button-or-field (pos) + "Find the previous button, or field, and return its start position. +If none is found, return (point-min). +Internal function, don't use it outside `wid-edit'." + (let* ((at-point (widget-button-or-field-extent pos)) + previous-extent) + (map-extents + (lambda (ext ignore) + (when (or (extent-property ext 'button) + (extent-property ext 'field)) + (if (eq ext at-point) + previous-extent + (setq previous-extent ext) + nil))) + nil nil pos) + (if previous-extent + (extent-start-position previous-extent) + (point-min)))) (defun widget-move (arg) "Move point to the ARG next field or button. ARG may be negative to move backward." - (or (bobp) (> arg 0) (backward-char)) (let ((pos (point)) (number arg) (old (widget-tabable-at))) ;; Forward. (while (> arg 0) - (cond ((eobp) - (goto-char (point-min))) - (widget-use-overlay-change - (goto-char (next-overlay-change (point)))) - (t - (forward-char 1))) + (goto-char (if (eobp) + (point-min) + (widget-next-button-or-field (point)))) (and (eq pos (point)) (eq arg number) (error "No buttons or fields found")) @@ -1119,23 +1084,19 @@ (setq old new))))) ;; Backward. (while (< arg 0) - (cond ((bobp) - (goto-char (point-max))) - (widget-use-overlay-change - (goto-char (previous-overlay-change (point)))) - (t - (backward-char 1))) + (goto-char (if (bobp) + (point-max) + (widget-previous-button-or-field (point)))) (and (eq pos (point)) (eq arg number) (error "No buttons or fields found")) (let ((new (widget-tabable-at))) (when new (unless (eq new old) - (setq arg (1+ arg)))))) + (incf arg))))) (let ((new (widget-tabable-at))) - (while (eq (widget-tabable-at) new) - (backward-char))) - (forward-char)) + (goto-char (extent-start-position (or (widget-get new :button-extent) + (widget-get new :field-extent)))))) (widget-echo-help (point)) (run-hooks 'widget-move-hook)) @@ -1155,25 +1116,21 @@ (defun widget-beginning-of-line () "Go to beginning of field or beginning of line, whichever is first." - (interactive) + (interactive "_") (let* ((field (widget-field-find (point))) (start (and field (widget-field-start field)))) (if (and start (not (eq start (point)))) (goto-char start) - (call-interactively 'beginning-of-line))) - ;; XEmacs: preserve the region - (setq zmacs-region-stays t)) + (call-interactively 'beginning-of-line)))) (defun widget-end-of-line () "Go to end of field or end of line, whichever is first." - (interactive) + (interactive "_") (let* ((field (widget-field-find (point))) (end (and field (widget-field-end field)))) (if (and end (not (eq end (point)))) (goto-char end) - (call-interactively 'end-of-line))) - ;; XEmacs: preserve the region - (setq zmacs-region-stays t)) + (call-interactively 'end-of-line)))) (defun widget-kill-line () "Kill to end of field or end of line, whichever is first." @@ -1185,6 +1142,26 @@ (kill-region (point) end) (call-interactively 'kill-line)))) +(defun widget-transpose-chars (arg) + "Like `transpose-chars', but works correctly at end of widget." + (interactive "*P") + (let* ((field (widget-field-find (point))) + (start (and field (widget-field-start field))) + (end (and field (widget-field-end field))) + (last-non-space (and start end + (save-excursion + (goto-char end) + (skip-chars-backward " \t\n" start) + (point))))) + (if (and last-non-space + (= last-non-space (1+ start))) + ;; 1-character field + nil + (when (and (null arg) + (= last-non-space (point))) + (forward-char -1)) + (transpose-chars arg)))) + (defcustom widget-complete-field (lookup-key global-map "\M-\t") "Default function to call for completion inside fields." :options '(ispell-complete-word complete-tag lisp-complete-symbol) @@ -1200,6 +1177,7 @@ (widget-apply field :complete) (error "Not in an editable field")))) + ;;; Setting up the buffer. (defvar widget-field-new nil) @@ -1220,12 +1198,11 @@ (setq field (car widget-field-new) widget-field-new (cdr widget-field-new) widget-field-list (cons field widget-field-list)) - (let ((from (car (widget-get field :field-overlay))) - (to (cdr (widget-get field :field-overlay)))) - (widget-specify-field field - (marker-position from) (marker-position to)) - (set-marker from nil) - (set-marker to nil)))) + (let ((extent (widget-get field :field-extent))) + (widget-specify-field field + (extent-start-position extent) + (extent-end-position extent)) + (delete-extent extent)))) (widget-clear-undo) (widget-add-change)) @@ -1239,22 +1216,22 @@ (defun widget-field-buffer (widget) "Return the start of WIDGET's editing field." - (let ((overlay (widget-get widget :field-overlay))) - (and overlay (overlay-buffer overlay)))) + (let ((extent (widget-get widget :field-extent))) + (and extent (extent-object extent)))) (defun widget-field-start (widget) "Return the start of WIDGET's editing field." - (let ((overlay (widget-get widget :field-overlay))) - (and overlay (overlay-start overlay)))) + (let ((extent (widget-get widget :field-extent))) + (and extent (extent-start-position extent)))) (defun widget-field-end (widget) "Return the end of WIDGET's editing field." - (let ((overlay (widget-get widget :field-overlay))) - ;; Don't subtract one if local-map works at the end of the overlay. - (and overlay (if (or widget-field-add-space - (null (widget-get widget :size))) - (1- (overlay-end overlay)) - (overlay-end overlay))))) + (let ((extent (widget-get widget :field-extent))) + ;; Don't subtract one if local-map works at the end of the extent. + (and extent (if (or widget-field-add-space + (null (widget-get widget :size))) + (1- (extent-end-position extent)) + (extent-end-position extent))))) (defun widget-field-find (pos) "Return the field at POS. @@ -1340,10 +1317,11 @@ (unless (eq old secret) (subst-char-in-region begin (1+ begin) old secret) (put-text-property begin (1+ begin) 'secret old)) - (setq begin (1+ begin))))))) + (incf begin)))))) (widget-apply field :notify field))) (error (debug "After Change")))) + ;;; Widget Functions ;; ;; These functions are used in the definition of multiple widgets. @@ -1355,9 +1333,9 @@ (defun widget-children-value-delete (widget) "Delete all :children and :buttons in WIDGET." - (mapcar 'widget-delete (widget-get widget :children)) + (mapc 'widget-delete (widget-get widget :children)) (widget-put widget :children nil) - (mapcar 'widget-delete (widget-get widget :buttons)) + (mapc 'widget-delete (widget-get widget :buttons)) (widget-put widget :buttons nil)) (defun widget-children-validate (widget) @@ -1453,7 +1431,7 @@ ((eq escape ?n) (when (widget-get widget :indent) (insert "\n") - (insert-char ? (widget-get widget :indent)))) + (insert-char ?\ (widget-get widget :indent)))) ((eq escape ?t) (let ((glyph (widget-get widget :tag-glyph)) (tag (widget-get widget :tag))) @@ -1477,7 +1455,7 @@ (if (and button-begin (not button-end)) (widget-apply widget :value-create) (setq value-pos (point)))) - (t + (t (widget-apply widget :format-handler escape))))) ;; Specify button, sample, and doc, and insert value. (and button-begin button-end @@ -1553,22 +1531,22 @@ ;; Remove widget from the buffer. (let ((from (widget-get widget :from)) (to (widget-get widget :to)) - (inactive-overlay (widget-get widget :inactive)) - (button-overlay (widget-get widget :button-overlay)) - (sample-overlay (widget-get widget :sample-overlay)) - (doc-overlay (widget-get widget :doc-overlay)) + (inactive-extent (widget-get widget :inactive)) + (button-extent (widget-get widget :button-extent)) + (sample-extent (widget-get widget :sample-extent)) + (doc-extent (widget-get widget :doc-extent)) before-change-functions after-change-functions (inhibit-read-only t)) (widget-apply widget :value-delete) - (when inactive-overlay - (delete-overlay inactive-overlay)) - (when button-overlay - (delete-overlay button-overlay)) - (when sample-overlay - (delete-overlay sample-overlay)) - (when doc-overlay - (delete-overlay doc-overlay)) + (when inactive-extent + (detach-extent inactive-extent)) + (when button-extent + (detach-extent button-extent)) + (when sample-extent + (detach-extent sample-extent)) + (when doc-extent + (detach-extent doc-extent)) (when (< from to) ;; Kludge: this doesn't need to be true for empty formats. (delete-region from to)) @@ -1690,7 +1668,7 @@ ;;; The `push-button' Widget. -(defcustom widget-push-button-gui t +(defcustom widget-push-button-gui widget-glyph-enable "If non nil, use GUI push buttons when available." :group 'widgets :type 'boolean) @@ -1722,28 +1700,26 @@ (tag-glyph (widget-get widget :tag-glyph)) (text (concat widget-push-button-prefix tag widget-push-button-suffix)) - (gui (cdr (assoc tag widget-push-button-cache)))) + (gui-glyphs (lax-plist-get widget-push-button-cache tag))) (cond (tag-glyph (widget-glyph-insert widget text tag-glyph)) - ((and (fboundp 'make-gui-button) - (fboundp 'make-glyph) - widget-push-button-gui - (fboundp 'device-on-window-system-p) - (device-on-window-system-p) - (string-match "XEmacs" emacs-version)) - (unless gui - (setq gui (make-gui-button tag 'widget-gui-action widget)) - (push (cons tag gui) widget-push-button-cache)) - (widget-glyph-insert-glyph widget - (make-glyph - (list (nth 0 (aref gui 1)) - (vector 'string ':data text))) - (make-glyph - (list (nth 1 (aref gui 1)) - (vector 'string ':data text))) - (make-glyph - (list (nth 2 (aref gui 1)) - (vector 'string ':data text))))) + ;; We must check for console-on-window-system-p here, + ;; because GUI will not work otherwise (it needs RGB + ;; components for colors, and they are not known on TTYs). + ((and widget-push-button-gui + (console-on-window-system-p)) + (unless gui-glyphs + (let ((gui (make-gui-button tag 'widget-gui-action widget))) + (setq + gui-glyphs + (list + (make-glyph `(,(nth 0 (aref gui 1)) [string :data ,text])) + (make-glyph `(,(nth 1 (aref gui 1)) [string :data ,text])) + (make-glyph `(,(nth 2 (aref gui 1)) [string :data ,text])))) + (setq widget-push-button-cache + (lax-plist-put widget-push-button-cache tag gui-glyphs)))) + (widget-glyph-insert-glyph + widget (nth 0 gui-glyphs) (nth 1 gui-glyphs) (nth 2 gui-glyphs))) (t (insert text))))) @@ -1774,8 +1750,12 @@ (define-widget 'info-link 'link "A link to an info file." + :help-echo 'widget-info-link-help-echo :action 'widget-info-link-action) +(defun widget-info-link-help-echo (widget) + (concat "Read the manual entry `" (widget-value widget) "'")) + (defun widget-info-link-action (widget &optional event) "Open the info node specified by WIDGET." (Info-goto-node (widget-value widget))) @@ -1784,8 +1764,12 @@ (define-widget 'url-link 'link "A link to an www page." + :help-echo 'widget-url-link-help-echo :action 'widget-url-link-action) +(defun widget-url-link-help-echo (widget) + (concat "Go to ")) + (defun widget-url-link-action (widget &optional event) "Open the url specified by WIDGET." (require 'browse-url) @@ -1805,18 +1789,22 @@ (define-widget 'emacs-library-link 'link "A link to an Emacs Lisp library file." + :help-echo 'widget-emacs-library-link-help-echo :action 'widget-emacs-library-link-action) +(defun widget-emacs-library-link-help-echo (widget) + (concat "Visit " (widget-value widget))) + (defun widget-emacs-library-link-action (widget &optional event) "Find the Emacs Library file specified by WIDGET." (find-file (locate-library (widget-value widget)))) ;;; The `emacs-commentary-link' Widget. - + (define-widget 'emacs-commentary-link 'link "A link to Commentary in an Emacs Lisp library file." :action 'widget-emacs-commentary-link-action) - + (defun widget-emacs-commentary-link-action (widget &optional event) "Find the Commentary section of the Emacs file specified by WIDGET." (finder-commentary (widget-value widget))) @@ -1845,7 +1833,7 @@ "History of field minibuffer edits.") (defun widget-field-prompt-internal (widget prompt initial history) - ;; Read string for WIDGET promptinhg with PROMPT. + ;; Read string for WIDGET prompting with PROMPT. ;; INITIAL is the initial input and HISTORY is a symbol containing ;; the earlier input. (read-string prompt initial history)) @@ -1864,10 +1852,22 @@ (defvar widget-edit-functions nil) (defun widget-field-action (widget &optional event) - ;; Move to next field. - (widget-forward 1) + ;; Edit the value in the minibuffer. + (let ((invalid (widget-apply widget :validate))) + (let ((prompt (concat (widget-apply widget :menu-tag-get) ": ")) + (value (unless invalid + (widget-value widget)))) + (let ((answer (widget-apply widget :prompt-value prompt value invalid))) + (widget-value-set widget answer))) + (widget-apply widget :notify widget event) + (widget-setup)) (run-hook-with-args 'widget-edit-functions widget)) +;(defun widget-field-action (widget &optional event) +; ;; Move to next field. +; (widget-forward 1) +; (run-hook-with-args 'widget-edit-functions widget)) + (defun widget-field-validate (widget) ;; Valid if the content matches `:valid-regexp'. (save-excursion @@ -1882,31 +1882,31 @@ (let ((size (widget-get widget :size)) (value (widget-get widget :value)) (from (point)) - ;; This is changed to a real overlay in `widget-setup'. We - ;; need the end points to behave differently until - ;; `widget-setup' is called. - (overlay (cons (make-marker) (make-marker)))) - (widget-put widget :field-overlay overlay) + ;; This used to make `field-overlay' a cons of two markers, + ;; and revert them to a real overlay in `widget-setup', + ;; because you can't change overlay insertion type. However, + ;; we can do that with extents. + extent) (insert value) (and size (< (length value) size) (insert-char ?\ (- size (length value)))) (unless (memq widget widget-field-list) - (setq widget-field-new (cons widget widget-field-new))) - (move-marker (cdr overlay) (point)) - (set-marker-insertion-type (cdr overlay) nil) + (push widget widget-field-new)) + (setq extent (make-extent from (point))) + (set-extent-property extent 'end-open t) + (widget-put widget :field-extent extent) (when (null size) (insert ?\n)) - (move-marker (car overlay) from) - (set-marker-insertion-type (car overlay) t))) + (set-extent-property extent 'start-open t))) (defun widget-field-value-delete (widget) ;; Remove the widget from the list of active editing fields. (setq widget-field-list (delq widget widget-field-list)) ;; These are nil if the :format string doesn't contain `%v'. - (let ((overlay (widget-get widget :field-overlay))) - (when overlay - (delete-overlay overlay)))) + (let ((extent (widget-get widget :field-extent))) + (when extent + (detach-extent extent)))) (defun widget-field-value-get (widget) ;; Return current text in editing field. @@ -1917,7 +1917,7 @@ (secret (widget-get widget :secret)) (old (current-buffer))) (if (and from to) - (progn + (progn (set-buffer buffer) (while (and size (not (zerop size)) @@ -1930,7 +1930,7 @@ (while (< (+ from index) to) (aset result index (get-char-property (+ from index) 'secret)) - (setq index (1+ index))))) + (incf index)))) (set-buffer old) result)) (widget-get widget :value)))) @@ -2004,12 +2004,9 @@ ;; Return non-nil if we need a menu. (let ((args (widget-get widget :args)) (old (widget-get widget :choice))) - (cond ((not window-system) + (cond ((not (console-on-window-system-p)) ;; No place to pop up a menu. nil) - ((not (or (fboundp 'x-popup-menu) (fboundp 'popup-menu))) - ;; No way to pop up a menu. - nil) ((< (length args) 2) ;; Empty or singleton list, just return the value. nil) @@ -2236,7 +2233,7 @@ (greedy (setq rest (append rest (list (car values))) values (cdr values))) - (t + (t (setq rest (append rest values) values nil))))) (cons found rest))) @@ -2586,7 +2583,7 @@ found) (while (and value ok) (let ((answer (widget-match-inline type value))) - (if answer + (if answer (setq found (append found (car answer)) value (cdr answer)) (setq ok nil)))) @@ -2738,7 +2735,7 @@ (setq argument (car args) args (cdr args) answer (widget-match-inline argument vals)) - (if answer + (if answer (setq vals (cdr answer) found (append found (car answer))) (setq vals nil @@ -2877,7 +2874,18 @@ (widget-documentation-link-add widget start (point)) (push (widget-create-child-and-convert widget 'visibility - :help-echo "Show or hide rest of the documentation." + :help-echo (lambda (widget) + ;; This can get called directly from + ;; default-mouse-motion-handler, with an + ;; extent argument. + (and (extentp widget) + (setq + widget (widget-at + (extent-start-position widget)))) + (concat + (if (widget-value widget) + "Hide" "Show") + " the rest of the documentation.")) :off "More" :action 'widget-parent-action shown) @@ -3080,40 +3088,41 @@ :prompt-history 'widget-variable-prompt-value-history :tag "Variable") -(when (featurep 'mule) - (defvar widget-coding-system-prompt-value-history nil - "History of input to `widget-coding-system-prompt-value'.") - - (define-widget 'coding-system 'symbol - "A MULE coding-system." - :format "%{%t%}: %v" - :tag "Coding system" - :prompt-history 'widget-coding-system-prompt-value-history - :prompt-value 'widget-coding-system-prompt-value - :action 'widget-coding-system-action) - - (defun widget-coding-system-prompt-value (widget prompt value unbound) - ;; Read coding-system from minibuffer. - (intern - (completing-read (format "%s (default %s) " prompt value) - (mapcar (function - (lambda (sym) - (list (symbol-name sym)) - )) - (coding-system-list))))) - - (defun widget-coding-system-action (widget &optional event) - ;; Read a file name from the minibuffer. - (let ((answer - (widget-coding-system-prompt-value - widget - (widget-apply widget :menu-tag-get) - (widget-value widget) - t))) - (widget-value-set widget answer) - (widget-apply widget :notify widget event) - (widget-setup))) - ) +;; This part issues a warning when compiling without Mule. Is there a +;; way of shutting it up? +;; +;; OK, I'll simply comment the whole thing out, until someone decides +;; to do something with it. +;(defvar widget-coding-system-prompt-value-history nil +; "History of input to `widget-coding-system-prompt-value'.") + +;(define-widget 'coding-system 'symbol +; "A MULE coding-system." +; :format "%{%t%}: %v" +; :tag "Coding system" +; :prompt-history 'widget-coding-system-prompt-value-history +; :prompt-value 'widget-coding-system-prompt-value +; :action 'widget-coding-system-action) + +;(defun widget-coding-system-prompt-value (widget prompt value unbound) +; ;; Read coding-system from minibuffer. +; (intern +; (completing-read (format "%s (default %s) " prompt value) +; (mapcar (lambda (sym) +; (list (symbol-name sym))) +; (coding-system-list))))) + +;(defun widget-coding-system-action (widget &optional event) +; ;; Read a file name from the minibuffer. +; (let ((answer +; (widget-coding-system-prompt-value +; widget +; (widget-apply widget :menu-tag-get) +; (widget-value widget) +; t))) +; (widget-value-set widget answer) +; (widget-apply widget :notify widget event) +; (widget-setup))) (define-widget 'sexp 'editable-field "An arbitrary lisp expression." @@ -3234,9 +3243,7 @@ (aref value 0) value)) :match (lambda (widget value) - (if (fboundp 'characterp) - (characterp value) - (integerp value)))) + (characterp value))) (define-widget 'list 'group "A lisp list." @@ -3371,7 +3378,7 @@ (list (widget-color-choice-list)) (completion (try-completion prefix list))) (cond ((eq completion t) - (message "Exact match.")) + (message "Exact match")) ((null completion) (error "Can't find completion for \"%s\"" prefix)) ((not (string-equal prefix completion)) @@ -3388,25 +3395,16 @@ (widget-value widget) (error (widget-get widget :value)))) (symbol (intern (concat "fg:" value)))) - (if (string-match "XEmacs" emacs-version) - (prog1 symbol - (or (find-face symbol) - (set-face-foreground (make-face symbol) value))) - (condition-case nil - (facemenu-get-face symbol) - (error 'default))))) + (prog1 symbol + (or (find-face symbol) + (set-face-foreground (make-face symbol) value))))) (defvar widget-color-choice-list nil) ;; Variable holding the possible colors. (defun widget-color-choice-list () - (unless widget-color-choice-list - (setq widget-color-choice-list - (if (fboundp 'read-color-completion-table) - (read-color-completion-table) - (mapcar '(lambda (color) (list color)) - (x-defined-colors))))) - widget-color-choice-list) + (or widget-color-choice-list + (setq widget-color-choice-list (read-color-completion-table)))) (defvar widget-color-history nil "History of entered colors") @@ -3436,45 +3434,11 @@ (widget-apply widget :notify widget event)))) (defun widget-color-notify (widget child &optional event) - "Update the sample, and notofy the parent." - (overlay-put (widget-get widget :sample-overlay) - 'face (widget-apply widget :sample-face-get)) + "Update the sample, and notify the parent." + (set-extent-property (widget-get widget :sample-extent) + 'face (widget-apply widget :sample-face-get)) (widget-default-notify widget child event)) -;;; The Help Echo - -(defun widget-echo-help-mouse () - "Display the help message for the widget under the mouse. -Enable with (run-with-idle-timer 1 t 'widget-echo-help-mouse)" - (let* ((pos (mouse-position)) - (frame (car pos)) - (x (car (cdr pos))) - (y (cdr (cdr pos))) - (win (window-at x y frame)) - (where (coordinates-in-window-p (cons x y) win))) - (when (consp where) - (save-window-excursion - (progn ; save-excursion - (select-window win) - (let* ((result (compute-motion (window-start win) - '(0 . 0) - (window-end win) - where - (window-width win) - (cons (window-hscroll) 0) - win))) - (when (and (eq (nth 1 result) x) - (eq (nth 2 result) y)) - (widget-echo-help (nth 0 result)))))))) - (unless track-mouse - (setq track-mouse t) - (add-hook 'post-command-hook 'widget-stop-mouse-tracking))) - -(defun widget-stop-mouse-tracking (&rest args) - "Stop the mouse tracking done while idle." - (remove-hook 'post-command-hook 'widget-stop-mouse-tracking) - (setq track-mouse nil)) - (defun widget-at (pos) "The button or field at POS." (or (get-char-property pos 'button) @@ -3486,7 +3450,7 @@ (help-echo (and widget (widget-get widget :help-echo)))) (cond ((stringp help-echo) (message "%s" help-echo)) - ((and (symbolp help-echo) (fboundp help-echo) + ((and (functionp help-echo) (stringp (setq help-echo (funcall help-echo widget)))) (message "%s" help-echo))))) diff -r 2947057885e5 -r a2f645c6b9f8 lisp/custom/widget-example.el --- a/lisp/custom/widget-example.el Mon Aug 13 09:58:32 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,97 +0,0 @@ -;;; widget-example.el -- example of using the widget library - -;; Copyright (C) 1996 Free Software Foundation, Inc. -;; -;; Author: Per Abrahamsen -;; Keywords: help, extensions, faces, hypermedia -;; Version: 1.9960 -;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ - -(require 'widget) - -(require 'wid-edit) -(eval-when-compile (require 'cl)) - -(defvar widget-example-repeat) - -(defun widget-example () - "Create the widgets from the Widget manual." - (interactive) - (switch-to-buffer "*Widget Example*") - (kill-all-local-variables) - (make-local-variable 'widget-example-repeat) - (let ((inhibit-read-only t)) - (erase-buffer)) - (let ((all (overlay-lists))) - ;; Delete all the overlays. - (mapcar 'delete-overlay (car all)) - (mapcar 'delete-overlay (cdr all))) - (widget-insert "Here is some documentation.\n\n") - (widget-create 'editable-field - :size 12 - :format "Name: %v " - "My Name") - (widget-create 'menu-choice - :tag "Choose" - :value "This" - :help-echo "Choose me, please!" - :notify (lambda (widget &rest ignore) - (message "%s is a good choice!" - (widget-value widget))) - '(item :tag "This option" :value "This") - '(choice-item "That option") - '(editable-field :menu-tag "No option" "Thus option")) - (widget-insert "Address: ") - (widget-create 'editable-field - "Some Place\nIn some City\nSome country.") - (widget-insert "\nSee also ") - (widget-create 'link - :notify (lambda (&rest ignore) - (widget-value-set widget-example-repeat - '("En" "To" "Tre")) - (widget-setup)) - "other work") - (widget-insert " for more information.\n\nNumbers: count to three below\n") - (setq widget-example-repeat - (widget-create 'editable-list - :entry-format "%i %d %v" - :notify (lambda (widget &rest ignore) - (let ((old (widget-get widget - ':example-length)) - (new (length (widget-value widget)))) - (unless (eq old new) - (widget-put widget ':example-length new) - (message "You can count to %d." new)))) - :value '("One" "Eh, two?" "Five!") - '(editable-field :value "three"))) - (widget-insert "\n\nSelect multiple:\n\n") - (widget-create 'checkbox t) - (widget-insert " This\n") - (widget-create 'checkbox nil) - (widget-insert " That\n") - (widget-create 'checkbox - :notify (lambda (&rest ignore) (message "Tickle")) - t) - (widget-insert " Thus\n\nSelect one:\n\n") - (widget-create 'radio-button-choice - :value "One" - :notify (lambda (widget &rest ignore) - (message "You selected %s" - (widget-value widget))) - '(item "One") '(item "Anthor One.") '(item "A Final One.")) - (widget-insert "\n") - (widget-create 'push-button - :notify (lambda (&rest ignore) - (if (= (length (widget-value widget-example-repeat)) - 3) - (message "Congratulation!") - (error "Three was the count!"))) - "Apply Form") - (widget-insert " ") - (widget-create 'push-button - :notify (lambda (&rest ignore) - (widget-example)) - "Reset Form") - (widget-insert "\n") - (use-local-map widget-keymap) - (widget-setup)) diff -r 2947057885e5 -r a2f645c6b9f8 lisp/custom/widget.el --- a/lisp/custom/widget.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/custom/widget.el Mon Aug 13 09:59:05 2007 +0200 @@ -3,24 +3,25 @@ ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen +;; Maintainer: Hrvoje Niksic ;; Keywords: help, extensions, faces, hypermedia -;; Version: 1.9960 +;; Version: 1.9960-x ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ -;; This file is part of GNU Emacs. +;; This file is part of XEmacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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. -;; GNU Emacs is distributed in the hope that it will be useful, +;; 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 GNU Emacs; see the file COPYING. If not, write to the +;; along with XEmacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. @@ -40,49 +41,6 @@ (eval-when-compile (require 'cl)) -(defmacro define-widget-keywords (&rest keys) - (` - (eval-and-compile - (let ((keywords (quote (, keys)))) - (while keywords - (or (boundp (car keywords)) - (set (car keywords) (car keywords))) - (setq keywords (cdr keywords))))))) - -(define-widget-keywords :doc-overlay :sample-overlay - :match-alternatives :documentation-indent - :complete-function :complete :button-overlay - :field-overlay - :documentation-shown :button-prefix - :button-suffix :mouse-down-action :glyph-up :glyph-down :glyph-inactive - :prompt-internal :prompt-history :prompt-match - :prompt-value :deactivate :active - :inactive :activate :sibling-args :delete-button-args - :insert-button-args :append-button-args :button-args - :tag-glyph :off-glyph :on-glyph :valid-regexp - :secret :sample-face :sample-face-get :case-fold - :create :convert-widget :format :value-create :offset :extra-offset - :tag :doc :from :to :args :value :action - :value-set :value-delete :match :parent :delete :menu-tag-get - :value-get :choice :void :menu-tag :on :off :on-type :off-type - :notify :entry-format :button :children :buttons :insert-before - :delete-at :format-handler :widget :value-pos :value-to-internal - :indent :size :value-to-external :validate :error :directory - :must-match :type-error :value-inline :inline :match-inline :greedy - :button-face-get :button-face :value-face :keymap :entry-from - :entry-to :help-echo :documentation-property :tab-order) - -;; These autoloads should be deleted when the file is added to Emacs. -(unless (fboundp 'load-gc) - (autoload 'widget-apply "wid-edit") - (autoload 'widget-create "wid-edit") - (autoload 'widget-insert "wid-edit") - (autoload 'widget-prompt-value "wid-edit") - (autoload 'widget-browse "wid-browse" nil t) - (autoload 'widget-browse-other-window "wid-browse" nil t) - (autoload 'widget-browse-at "wid-browse" nil t) - (autoload 'widget-minor-mode "wid-browse" nil t)) - (defun define-widget (name class doc &rest args) "Define a new widget type named NAME from CLASS. diff -r 2947057885e5 -r a2f645c6b9f8 lisp/edebug/custom-load.el --- a/lisp/edebug/custom-load.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/edebug/custom-load.el Mon Aug 13 09:59:05 2007 +0200 @@ -1,2 +1,10 @@ +;;; custom-load.el --- automatically extracted custom dependencies + +;; Created by SL Baur on Sat Sep 27 08:13:42 1997 + +;;; Code: + (custom-put 'lisp 'custom-loads '("edebug")) (custom-put 'edebug 'custom-loads '("edebug")) + +;;; custom-load.el ends here diff -r 2947057885e5 -r a2f645c6b9f8 lisp/ediff/custom-load.el --- a/lisp/ediff/custom-load.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/ediff/custom-load.el Mon Aug 13 09:59:05 2007 +0200 @@ -1,4 +1,9 @@ -(custom-put 'environment 'custom-loads '(("ediff-wind"))) +;;; custom-load.el --- automatically extracted custom dependencies + +;; Created by SL Baur on Sat Sep 27 08:13:44 1997 + +;;; Code: + (custom-put 'tools 'custom-loads '("ediff")) (custom-put 'ediff-diff 'custom-loads '("ediff-diff")) (custom-put 'frames 'custom-loads '("ediff-wind")) @@ -6,3 +11,5 @@ (custom-put 'ediff-merge 'custom-loads '("ediff-merg")) (custom-put 'ediff-mult 'custom-loads '("ediff-mult")) (custom-put 'ediff 'custom-loads '("ediff-diff" "ediff-init" "ediff-merg" "ediff-mult" "ediff-ptch" "ediff-wind" "ediff")) + +;;; custom-load.el ends here diff -r 2947057885e5 -r a2f645c6b9f8 lisp/efs/custom-load.el --- a/lisp/efs/custom-load.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/efs/custom-load.el Mon Aug 13 09:59:05 2007 +0200 @@ -1,2 +1,10 @@ +;;; custom-load.el --- automatically extracted custom dependencies + +;; Created by SL Baur on Sat Sep 27 08:13:47 1997 + +;;; Code: + (custom-put 'environment 'custom-loads '("dired-faces")) (custom-put 'dired 'custom-loads '("dired-faces")) + +;;; custom-load.el ends here diff -r 2947057885e5 -r a2f645c6b9f8 lisp/emulators/custom-load.el --- a/lisp/emulators/custom-load.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/emulators/custom-load.el Mon Aug 13 09:59:05 2007 +0200 @@ -1,2 +1,10 @@ +;;; custom-load.el --- automatically extracted custom dependencies + +;; Created by SL Baur on Sat Sep 27 08:13:48 1997 + +;;; Code: + (custom-put 'emulations 'custom-loads '("crisp")) (custom-put 'emulations-crisp 'custom-loads '("crisp")) + +;;; custom-load.el ends here diff -r 2947057885e5 -r a2f645c6b9f8 lisp/eterm/custom-load.el --- a/lisp/eterm/custom-load.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/eterm/custom-load.el Mon Aug 13 09:59:05 2007 +0200 @@ -1,3 +1,12 @@ +;;; custom-load.el --- automatically extracted custom dependencies + +;; Created by SL Baur on Sat Sep 27 08:13:49 1997 + +;;; Code: + +(custom-put 'shell 'custom-loads '("term")) (custom-put 'term 'custom-loads '("term")) (custom-put 'processes 'custom-loads '("term")) (custom-put 'unix 'custom-loads '("term")) + +;;; custom-load.el ends here diff -r 2947057885e5 -r a2f645c6b9f8 lisp/games/custom-load.el --- a/lisp/games/custom-load.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/games/custom-load.el Mon Aug 13 09:59:05 2007 +0200 @@ -1,2 +1,10 @@ +;;; custom-load.el --- automatically extracted custom dependencies + +;; Created by SL Baur on Sat Sep 27 08:13:51 1997 + +;;; Code: + (custom-put 'games 'custom-loads '("xmine")) (custom-put 'xmine 'custom-loads '("xmine")) + +;;; custom-load.el ends here diff -r 2947057885e5 -r a2f645c6b9f8 lisp/ilisp/Makefile --- a/lisp/ilisp/Makefile Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/ilisp/Makefile Mon Aug 13 09:59:05 2007 +0200 @@ -28,7 +28,9 @@ EMACS = emacs # The SHELL variable is used only for making the distribution. -SHELL = /bin/csh +#SHELL = /bin/csh +# Tsk, tsk, Though shalt not use csh in distributed scripts. +SHELL = /bin/sh # These are used mostly for packaging the distribution Ilisp_src_dir = $(shell pwd) diff -r 2947057885e5 -r a2f645c6b9f8 lisp/modes/auto-autoloads.el --- a/lisp/modes/auto-autoloads.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/modes/auto-autoloads.el Mon Aug 13 09:59:05 2007 +0200 @@ -250,6 +250,10 @@ ;;;*** +;;;### (autoloads nil "cperl-mode" "modes/cperl-mode.el") + +;;;*** + ;;;### (autoloads (eiffel-mode) "eiffel3" "modes/eiffel3.el") (autoload 'eiffel-mode "eiffel3" "\ @@ -567,7 +571,7 @@ ;;;### (autoloads (ksh-mode) "ksh-mode" "modes/ksh-mode.el") (autoload 'ksh-mode "ksh-mode" "\ -ksh-mode $Revision: 1.10 $ - Major mode for editing (Bourne, Korn or Bourne again) +ksh-mode $Revision: 1.11 $ - Major mode for editing (Bourne, Korn or Bourne again) shell scripts. Special key bindings and commands: \\{ksh-mode-map} @@ -678,6 +682,17 @@ ;;;*** +;;;### (autoloads (turn-on-lazy-shot lazy-shot-mode) "lazy-shot" "modes/lazy-shot.el") + +(autoload 'lazy-shot-mode "lazy-shot" "\ +Toggle Lazy Lock mode. +With arg, turn Lazy Lock mode on if and only if arg is positive." t nil) + +(autoload 'turn-on-lazy-shot "lazy-shot" "\ +Unconditionally turn on Lazy Lock mode." nil nil) + +;;;*** + ;;;### (autoloads (linuxdoc-sgml-mode) "linuxdoc-sgml" "modes/linuxdoc-sgml.el") (autoload 'linuxdoc-sgml-mode "linuxdoc-sgml" "\ @@ -1477,12 +1492,6 @@ (autoload 'mail-other-frame "sendmail" "\ Like `mail' command, but display mail buffer in another frame." t nil) -(define-key ctl-x-map "m" 'mail) - -(define-key ctl-x-4-map "m" 'mail-other-window) - -(define-key ctl-x-5-map "m" 'mail-other-frame) - (add-hook 'same-window-buffer-names "*mail*") ;;;*** @@ -1920,7 +1929,7 @@ (autoload 'vhdl-mode "vhdl-mode" "\ Major mode for editing VHDL code. -vhdl-mode $Revision: 1.10 $ +vhdl-mode $Revision: 1.11 $ To submit a problem report, enter `\\[vhdl-submit-bug-report]' from a vhdl-mode buffer. This automatically sets up a mail buffer with version information already added. You just need to add a description of the diff -r 2947057885e5 -r a2f645c6b9f8 lisp/modes/custom-load.el --- a/lisp/modes/custom-load.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/modes/custom-load.el Mon Aug 13 09:59:05 2007 +0200 @@ -1,3 +1,9 @@ +;;; custom-load.el --- automatically extracted custom dependencies + +;; Created by SL Baur on Sat Sep 27 08:13:57 1997 + +;;; Code: + (custom-put 'extensions 'custom-loads '("auto-show" "strokes")) (custom-put 'message 'custom-loads '("sendmail")) (custom-put 'prolog 'custom-loads '("prolog")) @@ -7,7 +13,6 @@ (custom-put 'pascal 'custom-loads '("pascal")) (custom-put 'tex 'custom-loads '("reftex" "texinfo")) (custom-put 'tcl 'custom-loads '("tcl")) -(custom-put 'environment 'custom-loads '(("rsz-minibuf"))) (custom-put 'icon 'custom-loads '("icon")) (custom-put 'texinfo 'custom-loads '("texinfo")) (custom-put 'xrdb 'custom-loads '("xrdb-mode")) @@ -20,6 +25,7 @@ (custom-put 'reftex 'custom-loads '("reftex")) (custom-put 'outlines 'custom-loads '("hideshow" "outl-mouse" "whitespace-mode")) (custom-put 'f90 'custom-loads '("f90")) +(custom-put 'perl 'custom-loads '("cperl-mode")) (custom-put 'asm 'custom-loads '("asm-mode")) (custom-put 'ada 'custom-loads '("ada-mode")) (custom-put 'reftex-label-support 'custom-loads '("reftex")) @@ -27,6 +33,7 @@ (custom-put 'fortran-comment 'custom-loads '("fortran")) (custom-put 'outl-mouse 'custom-loads '("outl-mouse")) (custom-put 'frames 'custom-loads '("rsz-minibuf")) +(custom-put 'cperl-electric 'custom-loads '("cperl-mode")) (custom-put 'verilog 'custom-loads '("verilog-mode")) (custom-put 'abbrev 'custom-loads '("abbrev")) (custom-put 'f90-indent 'custom-loads '("f90")) @@ -39,11 +46,14 @@ (custom-put 'simula 'custom-loads '("simula")) (custom-put 'archive-arc 'custom-loads '("arc-mode")) (custom-put 'fortran 'custom-loads '("f90" "fortran")) +(custom-put 'cperl-faces 'custom-loads '("cperl-mode")) (custom-put 'resize-minibuffer 'custom-loads '("rsz-minibuf")) -(custom-put 'languages 'custom-loads '("ada-mode" "asm-mode" "fortran" "icon" "pascal" "prolog" "rexx-mode" "sh-script" "simula" "tcl" "verilog-mode" "vhdl-mode" "vrml-mode" "winmgr-mode" "xrdb-mode")) +(custom-put 'languages 'custom-loads '("ada-mode" "asm-mode" "cperl-mode" "fortran" "icon" "pascal" "prolog" "rexx-mode" "sh-script" "simula" "tcl" "verilog-mode" "vhdl-mode" "vrml-mode" "winmgr-mode" "xrdb-mode")) +(custom-put 'cperl-indent 'custom-loads '("cperl-mode")) (custom-put 'archive-zoo 'custom-loads '("arc-mode")) (custom-put 'archive-zip 'custom-loads '("arc-mode")) (custom-put 'display 'custom-loads '("auto-show")) +(custom-put 'faces 'custom-loads '("cperl-mode")) (custom-put 'hideshow 'custom-loads '("hideshow")) (custom-put 'vhdl 'custom-loads '("vhdl-mode")) (custom-put 'enriched 'custom-loads '("enriched")) @@ -58,3 +68,5 @@ (custom-put 'winmgr 'custom-loads '("winmgr-mode")) (custom-put 'unix 'custom-loads '("sh-script")) (custom-put 'c 'custom-loads '("cmacexp")) + +;;; custom-load.el ends here diff -r 2947057885e5 -r a2f645c6b9f8 lisp/modes/lazy-shot.el --- a/lisp/modes/lazy-shot.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/modes/lazy-shot.el Mon Aug 13 09:59:05 2007 +0200 @@ -77,21 +77,24 @@ "Lazy lock the extent when it has become visisble" (let ((start (extent-start-position extent)) (end (extent-end-position extent)) - (buffer (extent-buffer extent))) + (buffer (extent-object extent))) (delete-extent extent) - (save-excursion - ;; This magic should really go into font-lock-fonity-region - (goto-char start) - (unless (bolp) - (beginning-of-line) - (setq start (point))) - (goto-char end) - (unless (bolp) - (forward-line) - (setq end (point))) - (message "Lazy-shot fontifying from %s to %s in %s" start end buffer) - (save-match-data - (font-lock-fontify-region start end))))) + (with-current-buffer buffer + (save-excursion + ;; This magic should really go into font-lock-fonity-region + (goto-char start) + (unless (bolp) + (beginning-of-line) + (setq start (point))) + (goto-char end) + (unless (bolp) + (forward-line) + (setq end (point))) + (display-message 'progress + (format "Lazy-shot fontifying from %s to %s in %s" + start end buffer)) + (save-match-data + (font-lock-fontify-region start end)))))) (defun lazy-shot-install-extent (spos epos &optional buffer) "Make an extent that will lazy-shot if it is displayed" diff -r 2947057885e5 -r a2f645c6b9f8 lisp/modes/reftex.el --- a/lisp/modes/reftex.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/modes/reftex.el Mon Aug 13 09:59:05 2007 +0200 @@ -538,10 +538,12 @@ (defgroup reftex-label-support nil "Support for creation, insertion and referencing of labels in LaTeX." + :prefix "reftex-" :group 'reftex) (defgroup reftex-defining-label-environments nil "Definition of environments and macros to do with label." + :prefix "reftex-" :group 'reftex-label-support) @@ -707,6 +709,7 @@ (defgroup reftex-making-and-inserting-labels nil "Options on how to create new labels." + :prefix "reftex-" :group 'reftex-label-support) (defcustom reftex-insert-label-flags '("s" "sft") @@ -802,6 +805,7 @@ (defgroup reftex-referencing-labels nil "Options on how to reference labels." + :prefix "reftex-" :group 'reftex-label-support) (defcustom reftex-label-menu-flags '(t t nil nil nil nil) @@ -859,6 +863,7 @@ (defgroup reftex-citation-support nil "Support for referencing bibliographic data with BibTeX." + :prefix "reftex-" :group 'reftex) (defcustom reftex-bibpath-environment-variables '("BIBINPUTS" "TEXBIB") @@ -940,6 +945,7 @@ (defgroup reftex-table-of-contents-browser nil "A multifile table of contents browser." + :prefix "reftex-" :group 'reftex) (defcustom reftex-toc-follow-mode nil @@ -953,6 +959,7 @@ (defgroup reftex-miscellaneous-configurations nil "Collection of further configurations." + :prefix "reftex-" :group 'reftex) (defcustom reftex-extra-bindings nil diff -r 2947057885e5 -r a2f645c6b9f8 lisp/modes/sendmail.el --- a/lisp/modes/sendmail.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/modes/sendmail.el Mon Aug 13 09:59:05 2007 +0200 @@ -1268,12 +1268,6 @@ (pop-to-buffer "*mail*")) (mail noerase to subject in-reply-to cc replybuffer sendactions)) -;;; Do not execute these when sendmail.el is loaded, -;;; only in loaddefs.el. -;;;###autoload (define-key ctl-x-map "m" 'mail) -;;;###autoload (define-key ctl-x-4-map "m" 'mail-other-window) -;;;###autoload (define-key ctl-x-5-map "m" 'mail-other-frame) - ;;;###autoload (add-hook 'same-window-buffer-names "*mail*") ;;; Do not add anything but external entries on this page. diff -r 2947057885e5 -r a2f645c6b9f8 lisp/mule/arabic-hooks.el diff -r 2947057885e5 -r a2f645c6b9f8 lisp/mule/arabic.el diff -r 2947057885e5 -r a2f645c6b9f8 lisp/mule/ethiopic-hooks.el diff -r 2947057885e5 -r a2f645c6b9f8 lisp/mule/ethiopic.el diff -r 2947057885e5 -r a2f645c6b9f8 lisp/mule/visual-mode.el diff -r 2947057885e5 -r a2f645c6b9f8 lisp/packages/auto-autoloads.el --- a/lisp/packages/auto-autoloads.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/packages/auto-autoloads.el Mon Aug 13 09:59:05 2007 +0200 @@ -668,7 +668,7 @@ (defcustom tags-always-exact nil "*If this variable is non-nil, then tags always looks for exact matches." :type 'boolean :group 'etags) -(defcustom tag-table-alist nil "*A list which determines which tags files should be active for a \ngiven buffer. This is not really an association list, in that all \nelements are checked. The CAR of each element of this list is a \npattern against which the buffer's file name is compared; if it \nmatches, then the CDR of the list should be the name of the tags\ntable to use. If more than one element of this list matches the\nbuffer's file name, then all of the associated tags tables will be\nused. Earlier ones will be searched first.\n\nIf the CAR of elements of this list are strings, then they are treated\nas regular-expressions against which the file is compared (like the\nauto-mode-alist). If they are not strings, then they are evaluated.\nIf they evaluate to non-nil, then the current buffer is considered to\nmatch.\n\nIf the CDR of the elements of this list are strings, then they are\nassumed to name a TAGS file. If they name a directory, then the string\n\"TAGS\" is appended to them to get the file name. If they are not \nstrings, then they are evaluated, and must return an appropriate string.\n\nFor example:\n (setq tag-table-alist\n '((\"/usr/src/public/perl/\" . \"/usr/src/public/perl/perl-3.0/\")\n (\"\\\\.el$\" . \"/usr/local/emacs/src/\")\n (\"/jbw/gnu/\" . \"/usr15/degree/stud/jbw/gnu/\")\n (\"\" . \"/usr/local/emacs/src/\")\n ))\n\nThis means that anything in the /usr/src/public/perl/ directory should use\nthe TAGS file /usr/src/public/perl/perl-3.0/TAGS; and file ending in .el should\nuse the TAGS file /usr/local/emacs/src/TAGS; and anything in or below the\ndirectory /jbw/gnu/ should use the TAGS file /usr15/degree/stud/jbw/gnu/TAGS.\nA file called something like \"/usr/jbw/foo.el\" would use both the TAGS files\n/usr/local/emacs/src/TAGS and /usr15/degree/stud/jbw/gnu/TAGS (in that order)\nbecause it matches both patterns.\n\nIf the buffer-local variable `buffer-tag-table' is set, then it names a tags\ntable that is searched before all others when find-tag is executed from this\nbuffer.\n\nIf there is a file called \"TAGS\" in the same directory as the file in \nquestion, then that tags file will always be used as well (after the\n`buffer-tag-table' but before the tables specified by this list.)\n\nIf the variable tags-file-name is set, then the tags file it names will apply\nto all buffers (for backwards compatibility.) It is searched first.\n" :type '(repeat (cons regexp sexp)) :group 'etags) +(defcustom tag-table-alist nil "*A list which determines which tags files are active for a buffer.\nThis is not really an association list, in that all elements are\nchecked. The CAR of each element of this list is a pattern against\nwhich the buffer's file name is compared; if it matches, then the CDR\nof the list should be the name of the tags table to use. If more than\none element of this list matches the buffer's file name, then all of\nthe associated tags tables will be used. Earlier ones will be\nsearched first.\n\nIf the CAR of elements of this list are strings, then they are treated\nas regular-expressions against which the file is compared (like the\nauto-mode-alist). If they are not strings, then they are evaluated.\nIf they evaluate to non-nil, then the current buffer is considered to\nmatch.\n\nIf the CDR of the elements of this list are strings, then they are\nassumed to name a TAGS file. If they name a directory, then the string\n\"TAGS\" is appended to them to get the file name. If they are not \nstrings, then they are evaluated, and must return an appropriate string.\n\nFor example:\n (setq tag-table-alist\n '((\"/usr/src/public/perl/\" . \"/usr/src/public/perl/perl-3.0/\")\n (\"\\\\.el$\" . \"/usr/local/emacs/src/\")\n (\"/jbw/gnu/\" . \"/usr15/degree/stud/jbw/gnu/\")\n (\"\" . \"/usr/local/emacs/src/\")\n ))\n\nThis means that anything in the /usr/src/public/perl/ directory should use\nthe TAGS file /usr/src/public/perl/perl-3.0/TAGS; and file ending in .el should\nuse the TAGS file /usr/local/emacs/src/TAGS; and anything in or below the\ndirectory /jbw/gnu/ should use the TAGS file /usr15/degree/stud/jbw/gnu/TAGS.\nA file called something like \"/usr/jbw/foo.el\" would use both the TAGS files\n/usr/local/emacs/src/TAGS and /usr15/degree/stud/jbw/gnu/TAGS (in that order)\nbecause it matches both patterns.\n\nIf the buffer-local variable `buffer-tag-table' is set, then it names a tags\ntable that is searched before all others when find-tag is executed from this\nbuffer.\n\nIf there is a file called \"TAGS\" in the same directory as the file in \nquestion, then that tags file will always be used as well (after the\n`buffer-tag-table' but before the tables specified by this list.)\n\nIf the variable tags-file-name is set, then the tags file it names will apply\nto all buffers (for backwards compatibility.) It is searched first.\n" :type '(repeat (cons (choice :value "" (regexp :tag "Buffer regexp") (function :tag "Expression")) (string :tag "Tag file or directory"))) :group 'etags) (autoload 'visit-tags-table "etags" "\ Tell tags commands to use tags table file FILE first. @@ -1599,6 +1599,38 @@ ;;;*** +;;;### (autoloads (iswitchb-buffer-other-frame iswitchb-display-buffer iswitchb-buffer-other-window iswitchb-buffer iswitchb-default-keybindings) "iswitchb" "packages/iswitchb.el") + +(autoload 'iswitchb-default-keybindings "iswitchb" "\ +Set up default keybindings for `iswitchb-buffer'. +Call this function to override the normal bindings." t nil) + +(autoload 'iswitchb-buffer "iswitchb" "\ +Switch to another buffer. + +The buffer name is selected interactively by typing a substring. The +buffer is displayed according to `iswitchb-default-method' -- the +default is to show it in the same window, unless it is already visible +in another frame. +For details of keybindings, do `\\[describe-function] iswitchb'." t nil) + +(autoload 'iswitchb-buffer-other-window "iswitchb" "\ +Switch to another buffer and show it in another window. +The buffer name is selected interactively by typing a substring. +For details of keybindings, do `\\[describe-function] iswitchb'." t nil) + +(autoload 'iswitchb-display-buffer "iswitchb" "\ +Display a buffer in another window but don't select it. +The buffer name is selected interactively by typing a substring. +For details of keybindings, do `\\[describe-function] iswitchb'." t nil) + +(autoload 'iswitchb-buffer-other-frame "iswitchb" "\ +Switch to another buffer and show it in another frame. +The buffer name is selected interactively by typing a substring. +For details of keybindings, do `\\[describe-function] iswitchb'." t nil) + +;;;*** + ;;;### (autoloads (jka-compr-install toggle-auto-compression jka-compr-load) "jka-compr" "packages/jka-compr.el") (autoload 'jka-compr-load "jka-compr" "\ diff -r 2947057885e5 -r a2f645c6b9f8 lisp/packages/auto-save.el --- a/lisp/packages/auto-save.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/packages/auto-save.el Mon Aug 13 09:59:05 2007 +0200 @@ -2,7 +2,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; File: auto-save.el -;; Version: $Revision: 1.5 $ +;; Version: $Revision: 1.6 $ ;; RCS: ;; Description: Safer autosaving with support for efs and /tmp. ;; This version of auto-save is designed to work with efs, @@ -11,7 +11,7 @@ ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defconst auto-save-version (substring "$Revision: 1.5 $" 11 -2) +(defconst auto-save-version (substring "$Revision: 1.6 $" 11 -2) "Version number of auto-save.") ;;; Copyright (C) 1992 by Sebastian Kremer @@ -100,7 +100,7 @@ ;;;; CUSTOMIZATION ===================================================== (defgroup auto-save nil - "Autosaving with support for efs and /tmp" + "Autosaving with support for efs and /tmp." :group 'data) (put 'auto-save-interval 'custom-type 'integer) @@ -149,7 +149,7 @@ See also variables `auto-save-directory-fallback', `efs-auto-save' and `efs-auto-save-remotely'." - :type '(choice (const :tag "same as file" nil) + :type '(choice (const :tag "Same as file" nil) directory) :group 'auto-save) @@ -175,7 +175,7 @@ Special value 'always deletes those files silently." :type '(choice (const :tag "on" t) (const :tag "off" nil) - (const :tag "delete silently" always)) + (const :tag "Delete silently" always)) :group 'auto-save) ;;;; end of customization diff -r 2947057885e5 -r a2f645c6b9f8 lisp/packages/completion.el --- a/lisp/packages/completion.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/packages/completion.el Mon Aug 13 09:59:05 2007 +0200 @@ -1898,7 +1898,9 @@ ;;(global-set-key "\M-\r" 'complete) ;;(global-set-key [?\C-\r] 'complete) ;;(define-key function-key-map [C-return] [?\C-\r]) -(global-set-key '(meta return) 'complete) +;; Hyperbole binds this key globally and does much more with it, +;; so use the other binding instead. -- Bob Weiner, Altrasoft, 08/15/97 +;; (global-set-key '(meta return) 'complete) (global-set-key '(control return) 'complete) ;; XEmacs: #### still need to take care of function-key-map @@ -2488,6 +2490,7 @@ ;; Kill region patch ;;----------------------------------------------- +;; Modified for InfoDock and XEmacs by Bob Weiner, Altrasoft, 08/15/97. (defun completion-kill-region (&optional beg end) "Kill between point and mark. The text is deleted but saved in the kill ring. @@ -2502,7 +2505,10 @@ the text killed this time appends to the text killed last time to make one entry in the kill ring. Patched to remove the most recent completion." - (interactive "r") + (interactive + (if buffer-read-only (barf-if-buffer-read-only) + (if (region-exists-p) + (list (region-beginning) (region-end))))) (cond ((eq last-command 'complete) (delete-region (point) cmpl-last-insert-location) (insert cmpl-original-string) @@ -2510,6 +2516,7 @@ (cmpl-statistics-block (record-complete-failed))) (t + (setq this-command 'kill-region) (kill-region beg end)))) (global-set-key "\C-w" 'completion-kill-region) diff -r 2947057885e5 -r a2f645c6b9f8 lisp/packages/custom-load.el --- a/lisp/packages/custom-load.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/packages/custom-load.el Mon Aug 13 09:59:05 2007 +0200 @@ -1,4 +1,10 @@ -(custom-put 'extensions 'custom-loads '("page-ext" "time-stamp")) +;;; custom-load.el --- automatically extracted custom dependencies + +;; Created by SL Baur on Sat Sep 27 08:14:08 1997 + +;;; Code: + +(custom-put 'extensions 'custom-loads '("iswitchb" "page-ext" "time-stamp")) (custom-put 'change-log 'custom-loads '("add-log")) (custom-put 'filladapt 'custom-loads '("filladapt")) (custom-put 'copyright 'custom-loads '("upd-copyr")) @@ -10,7 +16,7 @@ (custom-put 'igrep 'custom-loads '("igrep")) (custom-put 'menu 'custom-loads '("recent-files")) (custom-put 'minibuffer 'custom-loads '("icomplete")) -(custom-put 'environment 'custom-loads '(("balloon-help" "desktop") ("icomplete") "gnuserv")) +(custom-put 'environment 'custom-loads '("gnuserv")) (custom-put 'texinfo 'custom-loads '("texnfo-tex")) (custom-put 'terminals 'custom-loads '("gnuserv")) (custom-put 'auto-save 'custom-loads '("auto-save")) @@ -60,10 +66,11 @@ (custom-put 'metamail 'custom-loads '("metamail")) (custom-put 'icomplete 'custom-loads '("icomplete")) (custom-put 'compilation 'custom-loads '("compile")) +(custom-put 'iswitchb 'custom-loads '("iswitchb")) (custom-put 'makeinfo 'custom-loads '("makeinfo")) (custom-put 'fume 'custom-loads '("func-menu")) (custom-put 'auto-insert 'custom-loads '("autoinsert")) -(custom-put 'files 'custom-loads '("recent-files")) +(custom-put 'files 'custom-loads '("auto-save" "recent-files")) (custom-put 'fast-lock 'custom-loads '("fast-lock")) (custom-put 'gnuserv 'custom-loads '("gnuserv")) (custom-put 'ps-print-horizontal 'custom-loads '("ps-print")) @@ -88,3 +95,5 @@ (custom-put 'info 'custom-loads '("info")) (custom-put 'unix 'custom-loads '("tar-mode")) (custom-put 'c 'custom-loads '("func-menu")) + +;;; custom-load.el ends here diff -r 2947057885e5 -r a2f645c6b9f8 lisp/packages/font-lock.el --- a/lisp/packages/font-lock.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/packages/font-lock.el Mon Aug 13 09:59:05 2007 +0200 @@ -109,9 +109,8 @@ ;; Further comments from the FSF: ;; Nasty regexps of the form "bar\\(\\|lo\\)\\|f\\(oo\\|u\\(\\|bar\\)\\)\\|lo" -;; are made thusly: (make-regexp '("foo" "fu" "fubar" "bar" "barlo" "lo")) for -;; efficiency. See /pub/gnu/emacs/elisp-archive/functions/make-regexp.el.Z on -;; archive.cis.ohio-state.edu for this and other functions. +;; are made thusly: (regexp-opt '("foo" "fu" "fubar" "bar" "barlo" "lo")) for +;; efficiency. ;; What is fontification for? You might say, "It's to make my code look nice." ;; I think it should be for adding information in the form of cues. These cues @@ -1623,28 +1622,30 @@ ;; ;; Control structures. ELisp and CLisp combined. ;; - ;;(make-regexp - ;; '("cond" "if" "while" "let\\*?" "prog[nv12*]?" "catch" "throw" - ;; "save-restriction" "save-excursion" "save-window-excursion" + ;;(regexp-opt + ;; '("cond" "if" "while" "let" "let*" "prog" "progn" "prog1" + ;; "prog2" "progv" "catch" "throw" "save-restriction" + ;; "save-excursion" "save-window-excursion" ;; "save-current-buffer" "with-current-buffer" - ;; "with-temp-file" "with-output-to-.+" + ;; "with-temp-file" "with-temp-buffer" "with-output-to-string" + ;; "with-string-as-buffer-contents" ;; "save-selected-window" "save-match-data" "unwind-protect" ;; "condition-case" "track-mouse" "autoload" ;; "eval-after-load" "eval-and-compile" "eval-when-compile" - ;; "when" "unless" "do" "flet" "labels" "lambda" - ;; "return" "return-from")) - ;; + ;; "when" "unless" "do" "dolist" "dotimes" "flet" "labels" + ;; "lambda" "return" "return-from")) (cons (concat "(\\(" - "autoload\\|c\\(atch\\|ond\\(\\|ition-case\\)\\)\\|do\\|" - "eval-\\(a\\(fter-load\\|nd-compile\\)\\|when-compile\\)\\|" - "flet\\|if\\|l\\(a\\(bels\\|mbda\\)\\|et\\*?\\)\\|prog[nv12*]?\\|" - "return\\(\\|-from\\)\\|save-\\(current-buffer\\|excursion\\|" - "match-data\\|restriction\\|selected-window\\|window-excursion\\)\\|" - "t\\(hrow\\|rack-mouse\\)\\|un\\(less\\|wind-protect\\)\\|" - "w\\(h\\(en\\|ile\\)\\|ith-\\(current-buffer\\|output-to-.+\\|" - "temp-file\\)\\)" + "autoload\\|c\\(atch\\|ond\\(ition-case\\)?\\)\\|do\\(list\\|" + "times\\)?\\|eval-\\(a\\(fter-load\\|nd-compile\\)\\|when-compile\\)\\|" + "flet\\|if\\|l\\(a\\(bels\\|mbda\\)\\|et\\*?\\)\\|" + "prog[nv12\\*]?\\|return\\(-from\\)?\\|save-\\(current-buffer\\|" + "excursion\\|match-data\\|restriction\\|selected-window\\|" + "window-excursion\\)\\|t\\(hrow\\|rack-mouse\\)\\|un\\(less\\|" + "wind-protect\\)\\|w\\(h\\(en\\|ile\\)\\|ith-\\(current-buffer\\|" + "output-to-string\\|string-as-buffer-contents\\|temp-\\(buffer\\|" + "file\\)\\)\\)" "\\)\\>") 1) ;; ;; Words inside \\[] tend to be for `substitute-command-keys'. @@ -1732,7 +1733,7 @@ nil t)) ;; ;; Control structures. -;(make-regexp '("begin" "call-with-current-continuation" "call/cc" +;(regexp-opt '("begin" "call-with-current-continuation" "call/cc" ; "call-with-input-file" "call-with-output-file" "case" "cond" ; "do" "else" "for-each" "if" "lambda" ; "let\\*?" "let-syntax" "letrec" "letrec-syntax" diff -r 2947057885e5 -r a2f645c6b9f8 lisp/packages/gnuserv.el --- a/lisp/packages/gnuserv.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/packages/gnuserv.el Mon Aug 13 09:59:05 2007 +0200 @@ -1,9 +1,9 @@ ;;; gnuserv.el --- Lisp interface code between Emacs and gnuserv ;; Copyright (C) 1989-1997 Free Software Foundation, Inc. -;; Version: 3.10 +;; Version: 3.9 ;; Author: Andy Norman (ange@hplb.hpl.hp.com), originally based on server.el -;; Hrvoje Niksic , rewritten from scratch in May 1997 +;; Hrvoje Niksic ;; Maintainer: Jan Vroonhof , ;; Hrvoje Niksic ;; Keywords: environment, processes, terminals @@ -63,6 +63,12 @@ ;; Mukherjee, Ben Wing and Jan Vroonhof. It was completely rewritten ;; (labeled as version 3) by Hrvoje Niksic in May 1997. +;; Jan Vroonhof July/1996 +;; ported the server-temp-file-regexp feature from server.el +;; ported server hooks from server.el +;; ported kill-*-query functions from server.el (and made it optional) +;; synced other behaviour with server.el +;; ;; Jan Vroonhof ;; Customized. ;; @@ -72,9 +78,6 @@ ;; ;; Mike Scheidler July, 1997 ;; Added 'Done' button to the menubar. -;; -;; Hrvoje Niksic Sep/1997 -;; More pervasive changes. ;;; Code: @@ -89,8 +92,7 @@ ;; Provide the old variables as aliases, to avoid breaking .emacs ;; files. However, they are obsolete and should be converted to the ;; new forms. This ugly crock must be before the variable -;; declaration, or the scheme fails. I'd prefer if we could junk this -;; sh*t, but I guess the users will appreciate compatibility. Uh... +;; declaration, or the scheme fails. (define-obsolete-variable-alias 'server-frame 'gnuserv-frame) (define-obsolete-variable-alias 'server-done-function @@ -107,50 +109,29 @@ 'gnuserv-done-hook) (define-obsolete-variable-alias 'server-kill-quietly 'gnuserv-kill-quietly) +(define-obsolete-variable-alias 'server-temp-file-regexp + 'gnuserv-temp-file-regexp) +(define-obsolete-variable-alias 'server-make-temp-file-backup + 'gnuserv-make-temp-file-backup) ;;;###autoload -(defcustom gnuserv-frame 'new - "*Determines what frame will be used to display all edited files. -Legal values are: - `new' -- a new frame will be created for each file edited; - `current' -- the currently selected frame will be used; - `main' -- \"main\" Emacs frame will be used; - `visible' -- a visible frame will be used, or a new one created; - `special' -- a special Gnuserv frame will be created, and used for - all gnuserv-edited files; - frame -- that particular frame will be used. - -If gnuclient is called using the `-nw' method (from a TTY device), the - behaviour will be as if gnuserv-frame were `new'. -This variable is read by `gnuserv-frame-default-function'. If you - change `gnuserv-frame-function' to anything else, this variable will - have no effect." +(defcustom gnuserv-frame nil + "*The frame to be used to display all edited files. +If nil, then a new frame is created for each file edited. +If t, then the currently selected frame will be used. +If a function, then this will be called with a symbol `x' or `tty' as the +only argument, and its return value will be interpreted as above." :tag "Gnuserv Frame" - ;; Compatibility - :type '(radio (const :tag "Create new frame each time" new) - (const :tag "Use currently selected frame" current) - (const :tag "Use main Emacs frame" main) - (const :tag "Use visible frame, otherwise create new" visible) - (const :tag "Create special Gnuserv frame and use it" special)) - :group 'gnuserv) - -(defcustom gnuserv-frame-properties nil - "*Properties of the frame in which gnuclient buffers are displayed. -Note that this is in effect only for frames created by -`gnuserv-frame-default-function'." - :type '(repeat (group :inline t - (symbol :tag "Property") - (sexp :tag "Value"))) - :group 'gnuserv) - -(defcustom gnuserv-frame-function 'gnuserv-frame-default-function - "*Function to return the appropriate frame for use by gnuclient. -The function will be called with two arguments: the first one as - described by `gnuserv-frame', and the second one as the device to - create the frame on. -The function must return a valid frame object." - :type 'function - :group 'gnuserv) + :type '(radio (const :tag "Create new frame each time" nil) + (const :tag "Use selected frame" t) + (function-item :tag "Use main Emacs frame" + gnuserv-main-frame-function) + (function-item :tag "Use visible frame, otherwise create new" + gnuserv-visible-frame-function) + (function-item :tag "Create special Gnuserv frame and use it" + gnuserv-special-frame-function) + (function :tag "Other")) + :group 'gnuserv) (defcustom gnuserv-done-function 'kill-buffer "*Function used to remove a buffer after editing. @@ -161,6 +142,15 @@ (function :tag "Other")) :group 'gnuserv) +(defcustom gnuserv-done-temp-file-function 'kill-buffer + "*Function used to remove a temporary buffer after editing. +It is called with one BUFFER argument. Functions such as `kill-buffer' and +`bury-buffer' are good values. See also `gnuserv-done-temp-file-function'." + :type '(radio (function-item kill-buffer) + (function-item bury-buffer) + (function :tag "Other")) + :group 'gnuserv) + (defcustom gnuserv-find-file-function 'find-file "*Function to visit a file with. It takes one argument, a file name to visit." @@ -207,6 +197,17 @@ :type 'boolean :group 'gnuserv) +(defcustom gnuserv-temp-file-regexp "^/tmp/Re\\|/draft$" + "*Regexp which should match filenames of temporary files deleted +and reused by the programs that invoke the Emacs server." + :type 'regexp + :group 'gnuserv) + +(defcustom gnuserv-make-temp-file-backup nil + "*Non-nil makes the server backup temporary files also." + :type 'boolean + :group 'gnuserv) + ;;; Internal variables: @@ -229,7 +230,7 @@ (device nil) (frame nil)) -(defvar gnuserv-process nil +(defvar gnuserv-process nil "The current gnuserv process.") (defvar gnuserv-string "" @@ -245,53 +246,43 @@ (defvar gnuserv-devices nil "List of devices created by clients.") -;; We want the client-infested buffers to have some modeline -;; identification, so we'll make a "minor mode". We don't use -;; `add-minor-mode', as we don't want it to be togglable. -(defvar gnuserv-minor-mode nil) - -(make-variable-buffer-local 'gnuserv-mode) -(pushnew '(gnuserv-minor-mode " Server") minor-mode-alist :test 'equal) - (defvar gnuserv-special-frame nil "Frame created specially for Server.") +;; We want the client-infested buffers to have some modeline +;; identification, so we'll make a "minor mode". +(defvar gnuserv-minor-mode nil) +(make-variable-buffer-local 'gnuserv-mode) +(pushnew '(gnuserv-minor-mode " Server") minor-mode-alist + :test 'equal) + -;; Creating gnuserv frame. +;; Sample gnuserv-frame functions + +(defun gnuserv-main-frame-function (type) + "Returns a sensible value for the main Emacs frame." + (if (eq type 'x) + (car (frame-list)) + nil)) -(defun gnuserv-frame-default-function (arg device) - "Default function to create Gnuserv frames. -See the documentation of `gnuserv-frame' for instructions how to -customize it." - ;; If we are on TTY, act as if `new' was given. - (if (not (device-on-window-system-p)) - (gnuserv-frame-default-function 'new device) - (cond - ((or (eq arg 'new) - ;; nil for back-compat - (eq arg nil)) - (make-frame gnuserv-frame-properties device)) - ((or (eq arg 'current) - ;; t for back-compat - (eq arg t)) - (selected-frame)) - ((eq arg 'main) - (car (frame-list))) - ((eq arg 'visible) - (cond ((car (filtered-frame-list 'frame-totally-visible-p device))) - ((car (filtered-frame-list (lambda (frame) - ;; eq t as in not 'hidden - (eq (frame-visible-p frame) t)) - device))) - (t (make-frame gnuserv-frame-properties device)))) - ((eq arg 'special) - (unless (frame-live-p gnuserv-special-frame) - (setq gnuserv-special-frame - (make-frame gnuserv-frame-properties device)))) - ((frame-live-p arg) - arg) - (t - (error "Invalid argument %s" arg))))) +(defun gnuserv-visible-frame-function (type) + "Returns a frame if there is a frame that is truly visible, nil otherwise. +This is meant in the X sense, so it will not return frames that are on another +visual screen. Totally visible frames are preferred. If none found, return nil." + (if (eq type 'x) + (cond ((car (filtered-frame-list 'frame-totally-visible-p + (selected-device)))) + ((car (filtered-frame-list (lambda (frame) + ;; eq t as in not 'hidden + (eq t (frame-visible-p frame))) + (selected-device))))) + nil)) + +(defun gnuserv-special-frame-function (type) + "Creates a special frame for Gnuserv and returns it on later invocations." + (unless (frame-live-p gnuserv-special-frame) + (setq gnuserv-special-frame (make-frame))) + gnuserv-special-frame) ;;; Communication functions @@ -411,17 +402,29 @@ (t (error "Invalid flag %s" flag)))) flags) (let* ((old-device-num (length (device-list))) - (old-frame-num (length (frame-list))) - (device (case (car type) + (new-frame nil) + (dest-frame (if (functionp gnuserv-frame) + (funcall gnuserv-frame (car type)) + gnuserv-frame)) + ;; The gnuserv-frame dependencies are ugly. + (device (cond ((frame-live-p dest-frame) + (frame-device dest-frame)) + ((null dest-frame) + (case (car type) (tty (apply 'make-tty-device (cdr type))) (x (make-x-device (cadr type))) (t (error "Invalid device type")))) - (frame (funcall gnuserv-frame-function gnuserv-frame device)) + (t + (selected-device)))) + (frame (cond ((frame-live-p dest-frame) + dest-frame) + ((null dest-frame) + (setq new-frame (make-frame nil device)) + new-frame) + (t (selected-frame)))) (client (make-gnuclient :id gnuserv-current-client :device device - :frame (if (= (length (frame-list)) - old-frame-num) - nil frame)))) + :frame new-frame))) (setq gnuserv-current-client nil) ;; If the device was created by this client, push it to the list. (and (/= old-device-num (length (device-list))) @@ -432,7 +435,6 @@ (while list (let ((line (caar list)) (path (cdar list))) (select-frame frame) - (raise-frame frame) ;; Visit the file. (funcall (if view gnuserv-view-file-function @@ -444,9 +446,10 @@ (pushnew (current-buffer) (gnuclient-buffers client)) (setq gnuserv-minor-mode t) ;; Add the "Done" button to the menubar, only in this buffer. - (when (boundp 'current-menubar) - (set-buffer-menubar current-menubar) - (add-menu-button nil ["Done" gnuserv-edit t]))) + (if (boundp 'current-menubar) + (progn (set-buffer-menubar current-menubar) + (add-menu-button nil ["Done" gnuserv-edit t])) + )) (run-hooks 'gnuserv-visit-hook) (pop list))) (cond @@ -460,19 +463,19 @@ (t ;; Else, the client gets a vote. (push client gnuserv-clients) - ;; Explain buffer exit options. If client-frame is non-nil, - ;; the user can exit via `delete-frame'. OTOH, if FLAGS are - ;; nil and there are some buffers, the user can exit via + ;; Explain buffer exit options. If dest-frame is nil, the + ;; user can exit via `delete-frame'. OTOH, if FLAGS are nil + ;; and there are some buffers, the user can exit via ;; `gnuserv-edit'. (if (and (not (or quick view)) (gnuclient-buffers client)) (message "%s" (substitute-command-keys "Type `\\[gnuserv-edit]' to finish editing")) - (and (gnuclient-frame client) - (message "%s" - (substitute-command-keys - "Type `\\[delete-frame]' to finish editing"))))))))) + (or dest-frame + (message "%s" + (substitute-command-keys + "Type `\\[delete-frame]' to finish editing"))))))))) ;;; Functions that hook into Emacs in various way to enable operation @@ -486,9 +489,10 @@ (defun gnuserv-buffer-clients (buffer) "Returns a list of clients to which BUFFER belongs." (let (res) - (dolist (client gnuserv-clients res) + (dolist (client gnuserv-clients) (when (memq buffer (gnuclient-buffers client)) - (push client res))))) + (push client res))) + res)) ;; Like `gnuserv-buffer-clients', but returns a boolean; doesn't ;; collect a list. @@ -549,6 +553,16 @@ (add-hook 'delete-device-hook 'gnuserv-check-device) +(defun gnuserv-temp-file-p (buffer) + "Return non-nil if BUFFER contains a file considered temporary. +These are files whose names suggest they are repeatedly +reused to pass information to another program. + +The variable `gnuserv-temp-file-regexp' controls which filenames +are considered temporary." + (and (buffer-file-name buffer) + (string-match gnuserv-temp-file-regexp (buffer-file-name buffer)))) + (defun gnuserv-kill-client (client &optional leave-frame) "Kill the gnuclient CLIENT. This will do away with all the associated buffers. If LEAVE-FRAME, @@ -594,7 +608,10 @@ ;; Delete the menu button. (if (boundp 'current-menubar) (delete-menu-item '("Done"))) - (funcall gnuserv-done-function buffer))) + (funcall (if (gnuserv-temp-file-p buffer) + gnuserv-done-temp-file-function + gnuserv-done-function) + buffer))) ;;; Higher-level functions @@ -633,9 +650,15 @@ (unless (gnuserv-buffer-p buffer) (error "%s does not belong to a gnuserv client" buffer)) ;; Backup/ask query. - (if (and (buffer-modified-p) - (y-or-n-p (concat "Save file " buffer-file-name "? "))) - (save-buffer buffer)) + (if (gnuserv-temp-file-p buffer) + ;; For a temp file, save, and do NOT make a non-numeric backup + ;; Why does server.el explicitly back up temporary files? + (let ((version-control nil) + (buffer-backed-up (not gnuserv-make-temp-file-backup))) + (save-buffer)) + (if (and (buffer-modified-p) + (y-or-n-p (concat "Save file " buffer-file-name "? "))) + (save-buffer buffer))) (gnuserv-buffer-done-1 buffer)) ;; Called by `gnuserv-start-1' to clean everything. Hooked into @@ -692,9 +715,10 @@ ;;;###autoload (defun gnuserv-start (&optional leave-dead) "Allow this Emacs process to be a server for client processes. - This starts a gnuserv communications subprocess through which - client \"editors\" (gnuclient and gnudoit) can send editing commands to - this Emacs job. See the gnuserv(1) manual page for more details. +This starts a gnuserv communications subprocess through which +client \"editors\" (gnuclient and gnudoit) can send editing commands to +this Emacs job. See the gnuserv(1) manual page for more details. + Prefix arg means just kill any existing server communications subprocess." (interactive "P") (and gnuserv-process @@ -703,14 +727,21 @@ (gnuserv-start-1 leave-dead)) (defun gnuserv-edit (&optional count) - "Mark the current gnuserv buffer as \"done\", and switch to next one. + "Mark the current gnuserv editing buffer as \"done\", and switch to next one. + Run with a numeric prefix argument, repeat the operation that number - of times. If given a universal prefix argument, close all the buffers - of this buffer's clients. -The `gnuserv-done-function' (`kill-buffer' by default) is called to - dispose of the buffer after marking it as done. -When all of a client's buffers are marked as \"done\", the client is - notified." +of times. If given a universal prefix argument, close all the buffers +of this buffer's clients. + +The `gnuserv-done-function' (bound to `kill-buffer' by default) is +called to dispose of the buffer after marking it as done. + +Files that match `gnuserv-temp-file-regexp' are considered temporary and +are saved unconditionally and backed up if `gnuserv-make-temp-file-backup' +is non-nil. They are disposed of using `gnuserv-done-temp-file-function' +(also bound to `kill-buffer' by default). + +When all of a client's buffers are marked as \"done\", the client is notified." (interactive "P") (when (null count) (setq count 1)) diff -r 2947057885e5 -r a2f645c6b9f8 lisp/packages/iswitchb.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/packages/iswitchb.el Mon Aug 13 09:59:05 2007 +0200 @@ -0,0 +1,1302 @@ +;;; iswitchb.el --- switch between buffers using substrings + +;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. + +;; Author: Stephen Eglen +;; Maintainer: Stephen Eglen +;; Keywords: extensions +;; location: http://www.cogs.susx.ac.uk/users/stephene/emacs +;; RCS: $Id: iswitchb.el,v 1.1 1997/09/27 16:57:40 steve Exp $ + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Installation: + +;; To get the functions in this package bound to keys, do +;; (iswitchb-default-keybindings) + +;;; Commentary: + +;; As you type in a substring, the list of buffers currently matching +;; the substring are displayed as you type. The list is ordered so +;; that the most recent buffers visited come at the start of the list. +;; The buffer at the start of the list will be the one visited when +;; you press return. By typing more of the substring, the list is +;; narrowed down so that gradually the buffer you want will be at the +;; top of the list. Alternatively, you can use C-s an C-r to rotate +;; buffer names in the list until the one you want is at the top of +;; the list. Completion is also available so that you can see what is +;; common to all of the matching buffers as you type. + +;; This code is similar to a couple of other packages. Michael R Cook +;; for help with the +;; first version of this package, iswitch-buffer. Thanks also to many +;; others for testing earlier versions. + +;;; Code: + +;; Set up the custom library. +;; taken from http://www.dina.kvl.dk/~abraham/custom/ +(eval-and-compile + (condition-case () + (require 'custom) + (error nil)) + (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) + nil ;; We've got what we needed + ;; We have the old custom-library, hack around it! + (defmacro defgroup (&rest args) + nil) + (defmacro defcustom (var value doc &rest args) + (` (defvar (, var) (, value) (, doc)))))) + +;;; User Variables +;; +;; These are some things you might want to change. + +(defgroup iswitchb nil + "switch between buffers using substrings." + :group 'extensions + ;; These links are to be added in later versions of custom and + ;; so are currently commented out. + :link '(emacs-commentary-link :tag "Commentary" "iswitchb.el") + :link '(emacs-library-link :tag "Lisp File" "iswitchb.el") +) + + +(defcustom iswitchb-case case-fold-search + "*Non-nil if searching of buffer names should ignore case." + :type 'boolean + :group 'iswitchb) + +(defcustom iswitchb-buffer-ignore + '("^ ") + "*List of regexps or functions matching buffer names to ignore. +For example, traditional behavior is not to list buffers whose names begin +with a space, for which the regexp is `^ '. See the source file for +example functions that filter buffernames." + :type '(repeat regexp) + :group 'iswitchb) + + +;;; Examples for setting the value of iswitchb-buffer-ignore +;(defun -c-mode (name) +; "Ignore all c mode buffers -- example function for iswitchb." +; (save-excursion +; (set-buffer name) +; (string-match "^C$" mode-name))) + +;(setq iswitchb-buffer-ignore '("^ " ignore-c-mode)) +;(setq iswitchb-buffer-ignore '("^ " "\\.c$" "\\.h$")) + +(defcustom iswitchb-default-method 'always-frame + "*How to switch to new buffer when using `iswitchb-buffer'. +Possible values: +`samewindow' Show new buffer in same window +`otherwindow' Show new buffer in another window (same frame) +`display' Display buffer in another window without switching to it +`otherframe' Show new buffer in another frame +`maybe-frame' If a buffer is visible in another frame, prompt to ask if you + you want to see the buffer in the same window of the current + frame or in the other frame. +`always-frame' If a buffer is visible in another frame, raise that + frame. Otherwise, visit the buffer in the same window." + :type '(choice (const :tag "samewindow" samewindow) + (const :tag "otherwindow" otherwindow) + (const :tag "display" display) + (const :tag "otherframe" otherframe) + (const :tag "maybe-frame" maybe-frame) + (const :tag "always-frame" always-frame)) + :group 'iswitchb) + + +(defcustom iswitchb-regexp nil + "*Non-nil means that `iswitchb' will do regexp matching. +Value can be toggled within `iswitchb'." + :type 'boolean + :group 'iswitchb) + + +(defcustom iswitchb-newbuffer t + "*Non-nil means create new buffer if no buffer matches substring. +See also `iswitchb-prompt-newbuffer'." + :type 'boolean + :group 'iswitchb) + + +(defcustom iswitchb-prompt-newbuffer t + "*Non-nil means prompt user to confirm before creating new buffer. +See also `iswitchb-newbuffer'." + :type 'boolean + :group 'iswitchb) + + +(defcustom iswitchb-define-mode-map-hook nil + "*Hook to define keys in `iswitchb-mode-map' for extra keybindings." + :type 'hook + :group 'iswitchb) + + + +(defcustom iswitchb-use-fonts t + "*Non-nil means use fonts for showing first match." + :type 'boolean + :group 'iswitchb) + + +(defcustom iswitchb-make-buflist-hook nil + "*Hook to run when list of matching buffers is created." + :type 'hook + :group 'iswitchb) + + + +(defvar iswitchb-method nil + "*Stores the method for viewing the selected buffer. +Its value is one of `samewindow', `otherwindow', `display', `otherframe', +`maybe-frame' or `always-frame'. See `iswitchb-default-method' for +details of values.") + +(defvar iswitchb-all-frames 'visible + "*Argument to pass to `walk-windows' when finding visible buffers. +See documentation of `walk-windows' for useful values.") + + + +;; Do we need the variable iswitchb-use-mycompletion? + + +;;; Internal Variables +(defvar iswitchb-minibuffer-setup-hook nil + "Iswitchb-specific customization of minibuffer setup. + +This hook is run during minibuffer setup iff `iswitchb' will be active. +It is intended for use in customizing iswitchb for interoperation +with other packages. For instance: + + \(add-hook 'iswitchb-minibuffer-setup-hook + \(function + \(lambda () + \(make-local-variable 'resize-minibuffer-window-max-height) + \(setq resize-minibuffer-window-max-height 3)))) + +will constrain rsz-mini to a maximum minibuffer height of 3 lines when +iswitchb is running. Copied from `icomplete-minibuffer-setup-hook'.") + +(defvar iswitchb-eoinput 1 + "Point where minibuffer input ends and completion info begins. +Copied from `icomplete-eoinput'.") +(make-variable-buffer-local 'iswitchb-eoinput) + + +(defvar iswitchb-buflist nil + "Stores the current list of buffers that will be searched through. +The list is ordered, so that the most recent buffers come first, +although by default, the buffers visible in the current frame are put +at the end of the list. Created by `iswitchb-make-buflist'.") + +;; todo -- is this necessary? + +(defvar iswitchb-use-mycompletion nil + "Non-nil means use `iswitchb-buffer' completion feedback. +Should only be set to t by iswitchb functions, so that it doesn't +interfere with other minibuffer usage.") + +(defvar iswitchb-change-word-sub nil + "Private variable used by `iswitchb-word-matching-substring'.") + + +(defvar iswitchb-common-match-string nil + "Stores the string that is common to all matching buffers.") + + +(defvar iswitchb-rescan nil + "Non-nil means we need to regenerate the list of matching buffers.") + +(defvar iswitchb-text nil + "Stores the users string as it is typed in.") + +(defvar iswitchb-matches nil + "List of buffers currenly matching `iswitchb-text'.") + +(defvar iswitchb-mode-map nil + "Keymap for `iswitchb-buffer'.") + +(defvar iswitchb-history nil + "History of buffers selected using `iswitchb-buffer'.") + +(defvar iswitchb-exit nil + "Flag to monitor how `iswitchb-buffer' exits. +If equal to `takeprompt', we use the prompt as the buffer name to be +selected.") + +(defvar iswitchb-buffer-ignore-orig nil + "Stores original value of `iswitchb-buffer-ignore'.") + +(defvar iswitchb-xemacs (string-match "XEmacs" (emacs-version)) + "Non-nil if we are running XEmacs. Otherwise, assume we are running Emacs.") + + +;;; FUNCTIONS + + +;;; ISWITCHB KEYMAP +(defun iswitchb-define-mode-map () + "Set up the keymap for `iswitchb-buffer'." + (interactive) + (let (map) + ;; generated every time so that it can inheret new functions. + ;;(or iswitchb-mode-map + + (setq map (copy-keymap minibuffer-local-map)) + (define-key map "?" 'iswitchb-completion-help) + (define-key map "\C-s" 'iswitchb-next-match) + (define-key map "\C-r" 'iswitchb-prev-match) + (define-key map "\t" 'iswitchb-complete) + (define-key map "\C-j" 'iswitchb-select-buffer-text) + (define-key map "\C-t" 'iswitchb-toggle-regexp) + (define-key map "\C-x\C-f" 'iswitchb-find-file) + ;;(define-key map "\C-a" 'iswitchb-toggle-ignore) + (define-key map "\C-c" 'iswitchb-toggle-case) + (define-key map "\C-k" 'iswitchb-kill-buffer) + (setq iswitchb-mode-map map) + (run-hooks 'iswitchb-define-mode-map-hook) + )) + + + +;;; MAIN FUNCTION +(defun iswitchb () + "Switch to buffer matching a substring. +As you type in a string, all of the buffers matching the string are +displayed. When you have found the buffer you want, it can then be +selected. As you type, most keys have their normal keybindings, +except for the following: +\\ + +RET Select the buffer at the front of the list of matches. If the +list is empty, possibly prompt to create new buffer. + +\\[iswitchb-select-buffer-text] Select the current prompt as the buffer. +If no buffer is found, prompt for a new one. + +\\[iswitchb-next-match] Put the first element at the end of the list. +\\[iswitchb-prev-match] Put the last element at the start of the list. +\\[iswitchb-complete] Complete a common suffix to the current string that +matches all buffers. If there is only one match, select that buffer. +If there is no common suffix, show a list of all matching buffers +in a separate window. +\\[iswitchb-toggle-regexp] Toggle rexep searching. +\\[iswitchb-toggle-case] Toggle case-sensitive searching of buffer names. +\\[iswitchb-completion-help] Show list of matching buffers in separate window. +\\[iswitchb-find-file] Exit iswitchb and drop into find-file. +\\[iswitchb-kill-buffer] Kill buffer at head of buffer list." + ;;\\[iswitchb-toggle-ignore] Toggle ignoring certain buffers (see \ + ;;`iswitchb-buffer-ignore') + + (let + ( + prompt + buf-sel + iswitchb-final-text + (minibuffer-confirm-incomplete nil) ;XEmacs todo: prevent `;confirm' + (icomplete-mode nil) ;; prevent icomplete starting up + ;; can only use fonts if they have been bound. + (iswitchb-use-fonts (and iswitchb-use-fonts + (boundp 'font-lock-comment-face) + (boundp 'font-lock-function-name-face))) + ) + + (iswitchb-define-mode-map) + (setq iswitchb-exit nil) + (setq iswitchb-rescan t) + (setq iswitchb-text "") + (iswitchb-set-matches) + (setq prompt (format "iswitch ")) + (iswitchb-make-buflist) + (let + ((minibuffer-local-completion-map iswitchb-mode-map)) + ;; prompt the user for the buffer name + (setq iswitchb-final-text (completing-read prompt + ;;nil + '(("dummy".1)) + ;;("2".2) ("3".3)) + nil nil + nil;init string + 'iswitchb-history))) + + ;;(message "chosen text %s" iswitchb-final-text) + ;; Choose the buffer name: either the text typed in, or the head + ;; of the list of matches + + (cond ( (eq iswitchb-exit 'findfile) + (call-interactively 'find-file)) + + (t + (if (or + (eq iswitchb-exit 'takeprompt) + (null iswitchb-matches)) + (setq buf-sel iswitchb-final-text) + ;; else take head of list + (setq buf-sel (car iswitchb-matches))) + + ;; Or possibly choose the default buffer + (if (equal iswitchb-final-text "") + (setq buf-sel (car iswitchb-matches))) + + ;; View the buffer + (message "go to buf %s" buf-sel) + ;; Check buf-sel is non-nil. + (if buf-sel + (if (get-buffer buf-sel) + ;; buffer exists, so view it and then exit + (iswitchb-visit-buffer buf-sel) + ;; else buffer doesnt exist + (iswitchb-possible-new-buffer buf-sel))) + )) + + )) + + +;;; COMPLETION CODE + +(defun iswitchb-set-common-completion () + "Find common completion of `iswitchb-text' in `iswitchb-matches'. +The result is stored in `iswitchb-common-match-string'." + + (let* (val) + (setq iswitchb-common-match-string nil) + (if (and iswitchb-matches + (stringp iswitchb-text) + (> (length iswitchb-text) 0)) + (if (setq val (iswitchb-find-common-substring + iswitchb-matches iswitchb-text)) + (setq iswitchb-common-match-string val))) + val + )) + + +(defun iswitchb-complete () + "Try and complete the current pattern amongst the buffer names." + (interactive) + (let (res) + (cond ((not iswitchb-matches) + (iswitchb-completion-help) + ) + + ((eq 1 (length iswitchb-matches)) + ;; only one choice, so select it. + (exit-minibuffer)) + + (t + ;; else there could be some completions + + (setq res (iswitchb-find-common-substring + iswitchb-matches iswitchb-text)) + (if (and (not (memq res '(t nil))) + (not (equal res iswitchb-text))) + ;; found something to complete, so put it in the minibuff. + (progn + (setq iswitchb-rescan nil) + (delete-region (point-min) (point)) + (insert res)) + ;; else nothing to complete + (iswitchb-completion-help) + ) + ) + ))) + + + +;;; TOGGLE FUNCTIONS + +(defun iswitchb-toggle-case () + "Toggle the value of `iswitchb-case'." + (interactive) + (setq iswitchb-case (not iswitchb-case)) + ;; ask for list to be regenerated. + (setq iswitchb-rescan t) + ) + +(defun iswitchb-toggle-regexp () + "Toggle the value of `iswitchb-regexp'." + (interactive) + (setq iswitchb-regexp (not iswitchb-regexp)) + ;; ask for list to be regenerated. + (setq iswitchb-rescan t) + ) + + +(defun iswitchb-toggle-ignore () + "Toggle ignoring buffers specified with `iswitchb-buffer-ignore'." + (interactive) + (if iswitchb-buffer-ignore + (progn + (setq iswitchb-buffer-ignore-orig iswitchb-buffer-ignore) + (setq iswitchb-buffer-ignore nil) + ) + ;; else + (setq iswitchb-buffer-ignore iswitchb-buffer-ignore-orig) + ) + ;; ask for list to be regenerated. + (setq iswitchb-rescan t) + ) + + +(defun iswitchb-select-buffer-text () + "Select the buffer named by the prompt. +If no buffer exactly matching the prompt exists, maybe create a new one." + (interactive) + (setq iswitchb-exit 'takeprompt) + (exit-minibuffer)) + + + +(defun iswitchb-find-file () + "Drop into find-file from buffer switching." + (interactive) + (setq iswitchb-exit 'findfile) + (exit-minibuffer)) + +(defun iswitchb-next-match () + "Put first element of `iswitchb-matches' at the end of the list." + (interactive) + (let ((next (cadr iswitchb-matches))) + (setq iswitchb-buflist (iswitchb-chop iswitchb-buflist next)) + (setq iswitchb-rescan t) + )) + +(defun iswitchb-prev-match () + "Put last element of `iswitchb-matches' at the front of the list." + (interactive) + (let ((prev (car (last iswitchb-matches)))) + (setq iswitchb-buflist (iswitchb-chop iswitchb-buflist prev)) + (setq iswitchb-rescan t) + )) + + + + +(defun iswitchb-chop (list elem) + "Remove all elements before ELEM and put them at the end of LIST." + (let ((ret nil) + (next nil) + (sofar nil)) + (while (not ret) + (setq next (car list)) + (if (equal next elem) + (setq ret (append list (nreverse sofar))) + ;; else + (progn + (setq list (cdr list)) + (setq sofar (cons next sofar))))) + ret)) + + + + +;;; CREATE LIST OF ALL CURRENT BUFFERS + + +(defun iswitchb-make-buflist () + "Set `iswitchb-buflist' to the current list of buffers. +Currently visible buffers are put at the end of the list. +The hook `iswitchb-make-buflist-hook' is run after the list has been +created to allow the user to further modify the order of the buffer names +in this list." + (setq iswitchb-buflist + (let* ((iswitchb-current-buffers (iswitchb-get-buffers-in-frames)) + (buflist + (delq nil + (mapcar + (lambda (x) + (let ((b-name (buffer-name x))) + (if (not + (or + (iswitchb-ignore-buffername-p b-name) + (memq b-name iswitchb-current-buffers))) + b-name))) + (buffer-list))))) + (nconc buflist iswitchb-current-buffers) + (run-hooks 'iswitchb-make-buflist-hook) + buflist))) + +(defun iswitchb-to-end (lst) + "Move the elements from LST to the end of BUFLIST." + (mapcar + (lambda (elem) + (setq buflist (delq elem buflist))) + lst) + (nconc buflist lst)) + + + +(defun iswitchb-get-buffers-in-frames (&optional current) + "Return the list of buffers that are visible in the current frame. +If optional argument `current' is given, restrict searching to the +current frame, rather than all frames, regardless of value of +`iswitchb-all-frames'." + (let ((iswitchb-bufs-in-frame nil)) + (walk-windows 'iswitchb-get-bufname nil + (if current + nil + iswitchb-all-frames)) + iswitchb-bufs-in-frame)) + + +(defun iswitchb-get-bufname (win) + "Used by `iswitchb-get-buffers-in-frames' to walk through all windows." + (let ((buf (buffer-name (window-buffer win)))) + (if (not (member buf iswitchb-bufs-in-frame)) + ;; Only add buf if it is not already in list. + ;; This prevents same buf in two different windows being + ;; put into the list twice. + (setq iswitchb-bufs-in-frame + (cons buf iswitchb-bufs-in-frame))))) + + +;;; FIND MATCHING BUFFERS + + +(defun iswitchb-set-matches () + "Set `iswitchb-matches' to the list of buffers matching prompt." + (if iswitchb-rescan + (setq iswitchb-matches + (let* ((buflist iswitchb-buflist) + ) + (iswitchb-get-matched-buffers iswitchb-text iswitchb-regexp + buflist))))) + +(defun iswitchb-get-matched-buffers (regexp + &optional string-format buffer-list) + "Return buffers matching REGEXP. +If STRING-FORMAT is non-nil, consider REGEXP as string. +BUFFER-LIST can be list of buffers or list of strings." + (let* ((case-fold-search iswitchb-case) + ;; need reverse since we are building up list backwards + (list (reverse buffer-list)) + (do-string (stringp (car list))) + name + ret + ) + (mapcar + (lambda (x) + + (if do-string + (setq name x) ;We already have the name + (setq name (buffer-name x))) + + (cond + ((and (or (and string-format (string-match regexp name)) + (and (null string-format) + (string-match (regexp-quote regexp) name))) + + ;; todo (not (iswitchb-ignore-buffername-p name)) + ) + (setq ret (cons name ret)) + ))) + list) + ret + )) + + + + +(defun iswitchb-ignore-buffername-p (bufname) + "Return t if the buffer BUFNAME should be ignored." + (let ((data (match-data)) + (re-list iswitchb-buffer-ignore) + ignorep + nextstr + ) + (while re-list + (setq nextstr (car re-list)) + (cond + ((stringp nextstr) + (if (string-match nextstr bufname) + (progn + (setq ignorep t) + (setq re-list nil)))) + ((fboundp nextstr) + (if (funcall nextstr bufname) + (progn + (setq ignorep t) + (setq re-list nil)) + )) + ) + (setq re-list (cdr re-list))) + (store-match-data data) + + ;; return the result + ignorep) + ) + + + +(defun iswitchb-word-matching-substring (word) + "Return part of WORD before 1st match to `iswitchb-change-word-sub'. +If `iswitchb-change-word-sub' cannot be found in WORD, return nil." + (let ((case-fold-search iswitchb-case)) + (let ((m (string-match iswitchb-change-word-sub word))) + (if m + (substring word m) + ;; else no match + nil)))) + + + + + + +(defun iswitchb-find-common-substring (lis subs) + "Return common string following SUBS in each element of LIS." + (let (res + alist + iswitchb-change-word-sub + ) + (setq iswitchb-change-word-sub + (if iswitchb-regexp + subs + (regexp-quote subs))) + (setq res (mapcar 'iswitchb-word-matching-substring lis)) + (setq res (delq nil res)) ;; remove any nil elements (shouldnt happen) + (setq alist (mapcar 'iswitchb-makealist res)) ;; could use an OBARRAY + + ;; try-completion returns t if there is an exact match. + (let ((completion-ignore-case iswitchb-case)) + + (try-completion subs alist) + ))) + + +(defun iswitchb-makealist (res) + "Return dotted pair (RES . 1)." + (cons res 1)) + +;; from Wayne Mesard +(defun iswitchb-rotate-list (lis) + "Destructively removes the last element from LIS. +Return the modified list with the last element prepended to it." + (if (<= (length lis) 1) + lis + (let ((las lis) + (prev lis)) + (while (consp (cdr las)) + (setq prev las + las (cdr las))) + (setcdr prev nil) + (cons (car las) lis)) + )) + + +(defun iswitchb-completion-help () + "Show possible completions in a *Buffer Completions* buffer." + ;; we could allow this buffer to be used to select match, but I think + ;; choose-completion-string will need redefining, so it just inserts + ;; choice with out any previous input. + (interactive) + (setq iswitchb-rescan nil) + (let ((completion-setup-hook nil) ;disable fancy highlight/selection. + ) + (with-output-to-temp-buffer "*Buffer Completions*" + (if iswitchb-xemacs + + ;; XEmacs extents are put on by default, doesn't seem to be + ;; any way of switching them off. + (display-completion-list (if iswitchb-matches + iswitchb-matches + iswitchb-buflist) + :help-string "iswitchb " + :activate-callback + '(lambda (x y z) + (message "doesnt work yet, sorry!"))) + ;; else running Emacs + (display-completion-list (if iswitchb-matches + iswitchb-matches + iswitchb-buflist)) + )))) + + +;;; KILL CURRENT BUFFER + +(defun iswitchb-kill-buffer () + "Kill the buffer at the head of `iswtichb-matches'." + (interactive) + (let ( (enable-recursive-minibuffers t) + buf) + + (setq buf (car iswitchb-matches)) + ;; check to see if buf is non-nil. + (if buf + (progn + (kill-buffer buf) + + ;; Check if buffer exists. XEmacs gnuserv.el makes alias + ;; for kill-buffer which does not return t if buffer is + ;; killed, so we can't rely on kill-buffer return value. + (if (get-buffer buf) + ;; buffer couldn't be killed. + (setq iswitchb-rescan t) + ;; else buffer was killed so remove name from list. + (setq iswitchb-buflist (delq buf iswitchb-buflist))))))) + + +;;; VISIT CHOSEN BUFFER +(defun iswitchb-visit-buffer (buffer) + "Visit buffer named BUFFER according to `iswitchb-method'." + (let* (win newframe) + (cond + ((eq iswitchb-method 'samewindow) + (switch-to-buffer buffer)) + + ((memq iswitchb-method '(always-frame maybe-frame)) + (cond + ((and (setq win (iswitchb-window-buffer-p buffer)) + (or (eq iswitchb-method 'always-frame) + (y-or-n-p "Jump to frame? "))) + (setq newframe (window-frame win)) + (raise-frame newframe) + (select-frame newframe) + (select-window win) + (if (not iswitchb-xemacs) + ;; reposition mouse to make frame active. not needed in XEmacs + ;; This line came from the other-frame defun in Emacs. + (set-mouse-position (selected-frame) (1- (frame-width)) 0)) + ) + (t + ;; No buffer in other frames... + (switch-to-buffer buffer) + ))) + + + + ((eq iswitchb-method 'otherwindow) + (switch-to-buffer-other-window buffer)) + + ((eq iswitchb-method 'display) + (display-buffer buffer)) + + ((eq iswitchb-method 'otherframe) + (progn + (switch-to-buffer-other-frame buffer) + (if (not iswitchb-xemacs) + (set-mouse-position (selected-frame) (1- (frame-width)) 0)) + ) + ) ))) + +(defun iswitchb-possible-new-buffer (buf) + "Possibly create and visit a new buffer called BUF." + + (let ((newbufcreated)) + (if (and iswitchb-newbuffer + (or + (not iswitchb-prompt-newbuffer) + + (and iswitchb-prompt-newbuffer + (y-or-n-p + (format + "No buffer matching `%s', create one? " + buf))))) + ;; then create a new buffer + (progn + (setq newbufcreated (get-buffer-create buf)) + (if (fboundp 'set-buffer-major-mode) + (set-buffer-major-mode newbufcreated)) + (iswitchb-visit-buffer newbufcreated)) + + ;; else wont create new buffer + (message (format "no buffer matching `%s'" buf)) + ))) + +(defun iswitchb-window-buffer-p (buffer) + "Return window pointer if BUFFER is visible in another frame. +If BUFFER is visible in the current frame, return nil." + (interactive) + (let ((blist (iswitchb-get-buffers-in-frames 'current))) + ;;If the buffer is visible in current frame, return nil + (if (memq buffer blist) + nil + ;; maybe in other frame... + (get-buffer-window buffer 'visible) + ))) + +;;;###autoload +(defun iswitchb-default-keybindings () + "Set up default keybindings for `iswitchb-buffer'. +Call this function to override the normal bindings." + (interactive) + (global-set-key (read-kbd-macro "C-x b") 'iswitchb-buffer) + (global-set-key (read-kbd-macro "C-x 4 b") 'iswitchb-buffer-other-window) + (global-set-key (read-kbd-macro "C-x 4 C-o") 'iswitchb-display-buffer) + (global-set-key (read-kbd-macro "C-x 5 b") 'iswitchb-buffer-other-frame)) + + + +;;;###autoload +(defun iswitchb-buffer () + "Switch to another buffer. + +The buffer name is selected interactively by typing a substring. The +buffer is displayed according to `iswitchb-default-method' -- the +default is to show it in the same window, unless it is already visible +in another frame. +For details of keybindings, do `\\[describe-function] iswitchb'." + (interactive) + (setq iswitchb-method iswitchb-default-method) + (iswitchb-entry)) + + +;;;###autoload +(defun iswitchb-buffer-other-window () + "Switch to another buffer and show it in another window. +The buffer name is selected interactively by typing a substring. +For details of keybindings, do `\\[describe-function] iswitchb'." + (interactive) + (setq iswitchb-method 'otherwindow) + (iswitchb-entry)) + + + +;;;###autoload +(defun iswitchb-display-buffer () + "Display a buffer in another window but don't select it. +The buffer name is selected interactively by typing a substring. +For details of keybindings, do `\\[describe-function] iswitchb'." + (interactive) + (setq iswitchb-method 'display) + (iswitchb-entry)) + + + +;;;###autoload +(defun iswitchb-buffer-other-frame () + "Switch to another buffer and show it in another frame. +The buffer name is selected interactively by typing a substring. +For details of keybindings, do `\\[describe-function] iswitchb'." + (interactive) + (setq iswitchb-method 'otherframe) + (iswitchb-entry)) + + + +(defun iswitchb-entry () + "Simply fall into `iswitchb' -- the main function." + (iswitchb)) + + + + + +;;; XEmacs hack for showing default buffer + +;; The first time we enter the minibuffer, Emacs puts up the default +;; buffer to switch to, but XEmacs doesnt -- presumably there is a +;; subtle difference in the two versions of post-command-hook. The +;; default is shown for both whenever we delete all of our text +;; though, indicating its just a problem the first time we enter the +;; function. To solve this, we use another entry hook for emacs to +;; show the default the first time we enter the minibuffer. + +(defun iswitchb-init-Xemacs-trick () + "Display default buffer when first entering minibuffer. +This is a hack for XEmacs, and should really be handled by `iswitchb-exhibit'." + (if (iswitchb-entryfn-p) + (progn + (iswitchb-exhibit) + (goto-char (point-min))))) + + +;; add this hook for XEmacs only. +(if iswitchb-xemacs + (add-hook 'iswitchb-minibuffer-setup-hook + 'iswitchb-init-Xemacs-trick)) + + +;;; XEmacs / backspace key +;; For some reason, if the backspace key is pressed in xemacs, the +;; line gets confused, so I've added a simple key definition to make +;; backspace act like the normal delete key. + +(defun iswitchb-xemacs-backspacekey () + "Bind backspace to `backward-delete-char'." + (define-key iswitchb-mode-map '[backspace] 'backward-delete-char) + (define-key iswitchb-mode-map '[(meta backspace)] 'backward-kill-word) + ) + + +(if iswitchb-xemacs + (add-hook 'iswitchb-define-mode-map-hook + 'iswitchb-xemacs-backspacekey)) + + + +;;; ICOMPLETE TYPE CODE + +(defun iswitchb-exhibit () + "Find matching buffers and display a list in the minibuffer. +Copied from `icomplete-exhibit' with two changes: +1. It prints a default buffer name when there is no text yet entered. +2. It calls my completion routine rather than the standard completion." + + (if iswitchb-use-mycompletion + (let ((contents (buffer-substring (point-min)(point-max))) + (buffer-undo-list t)) + (save-excursion + (goto-char (point-max)) + ; Register the end of input, so we + ; know where the extra stuff + ; (match-status info) begins: + (if (not (boundp 'iswitchb-eoinput)) + ;; In case it got wiped out by major mode business: + (make-local-variable 'iswitchb-eoinput)) + (setq iswitchb-eoinput (point)) + ;; Update the list of matches + (setq iswitchb-text contents) + (iswitchb-set-matches) + (setq iswitchb-rescan t) + (iswitchb-set-common-completion) + + ;; Insert the match-status information: + (insert-string + (iswitchb-completions + contents + minibuffer-completion-table + minibuffer-completion-predicate + (not minibuffer-completion-confirm))) + )))) + + + +(defun iswitchb-completions + (name candidates predicate require-match) + "Return the string that is displayed after the user's text. +Modified from `icomplete-completions'." + + (let ((comps iswitchb-matches) + ; "-determined" - only one candidate + (open-bracket-determined (if require-match "(" "[")) + (close-bracket-determined (if require-match ")" "]")) + ;"-prospects" - more than one candidate + (open-bracket-prospects "{") + (close-bracket-prospects "}") + first + ) + + (if (and iswitchb-use-fonts comps) + (progn + (setq first (car comps)) + (setq first (format "%s" first)) + (put-text-property 0 (length first) 'face + (if (eq (length comps) 1) + 'font-lock-comment-face + 'font-lock-function-name-face) + first) + (setq comps (cons first (cdr comps))) + )) + + (cond ((null comps) (format " %sNo match%s" + open-bracket-determined + close-bracket-determined)) + + ((null (cdr comps)) ;one match + (concat (if (and (> (length (car comps)) + (length name))) + (concat open-bracket-determined + ;; when there is one match, show the + ;; matching buffer name in full + (car comps) + close-bracket-determined) + "") + (if (not iswitchb-use-fonts) " [Matched]") + )) + (t ;multiple matches + (let* ( + ;;(most (try-completion name candidates predicate)) + (most nil) + (most-len (length most)) + most-is-exact + first + (alternatives + (apply + (function concat) + (cdr (apply + (function nconc) + (mapcar '(lambda (com) + (if (= (length com) most-len) + ;; Most is one exact match, + ;; note that and leave out + ;; for later indication: + (progn + (setq most-is-exact t) + ()) + (list "," + (substring com + most-len)))) + comps)))))) + + (concat + + ;; put in common completion item -- what you get by + ;; pressing tab + (if (> (length iswitchb-common-match-string) (length name)) + (concat open-bracket-determined + (substring iswitchb-common-match-string + (length name)) + close-bracket-determined) + ) + ;; end of partial matches... + + ;; think this bit can be ignored. + (and (> most-len (length name)) + (concat open-bracket-determined + (substring most (length name)) + close-bracket-determined)) + + ;; list all alternatives + open-bracket-prospects + (if most-is-exact + (concat "," alternatives) + alternatives) + close-bracket-prospects))) + ))) + +(defun iswitchb-minibuffer-setup () + "Set up minibuffer for `iswitchb-buffer'. +Copied from `icomplete-minibuffer-setup-hook'." + (if (iswitchb-entryfn-p) + (progn + + (make-local-variable 'iswitchb-use-mycompletion) + (setq iswitchb-use-mycompletion t) + (make-local-hook 'pre-command-hook) + (add-hook 'pre-command-hook + 'iswitchb-pre-command + nil t) + (make-local-hook 'post-command-hook) + (add-hook 'post-command-hook + 'iswitchb-post-command + nil t) + + (run-hooks 'iswitchb-minibuffer-setup-hook) + ) + )) + + +(defun iswitchb-pre-command () + "Run before command in `iswitchb-buffer'." + (iswitchb-tidy)) + + +(defun iswitchb-post-command () + "Run after command in `iswitchb-buffer'." + (iswitchb-exhibit) + ) + + + +(defun iswitchb-tidy () + "Remove completions display, if any, prior to new user input. +Copied from `icomplete-tidy'." + + (if (and (boundp 'iswitchb-eoinput) + iswitchb-eoinput) + + (if (> iswitchb-eoinput (point-max)) + ;; Oops, got rug pulled out from under us - reinit: + (setq iswitchb-eoinput (point-max)) + (let ((buffer-undo-list buffer-undo-list )) ; prevent entry + (delete-region iswitchb-eoinput (point-max)))) + + ;; Reestablish the local variable 'cause minibuffer-setup is weird: + (make-local-variable 'iswitchb-eoinput) + (setq iswitchb-eoinput 1))) + + +(defun iswitchb-entryfn-p () + "Return non-nil if `this-command' shows we are using `iswitchb-buffer'." + (and (symbolp this-command) ; ignore lambda functions + (memq this-command + '(iswitchb-buffer + iswitchb-buffer-other-frame + iswitchb-display-buffer + iswitchb-buffer-other-window)))) + + + + +(defun iswitchb-summaries-to-end () + "Move the summaries to the end of the list. +This is an example function which can be hooked on to +`iswitchb-make-buflist-hook'. Any buffer matching the regexps +`Summary' or `output\*$'are put to the end of the list." + (let ((summaries (delq nil (mapcar + (lambda (x) + (if (or + (string-match "Summary" x) + (string-match "output\\*$" x)) + x)) + buflist) + ))) + + (iswitchb-to-end summaries))) + + + +;;; HOOKS +(add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup) + +(provide 'iswitchb) + +;;; iswitchb.el ends here diff -r 2947057885e5 -r a2f645c6b9f8 lisp/packages/man.el --- a/lisp/packages/man.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/packages/man.el Mon Aug 13 09:59:05 2007 +0200 @@ -70,19 +70,6 @@ :type 'boolean :group 'man) -(defcustom Manual-buffers-have-stars nil - "*When T, manual page buffers are always named like *man*. -Otherwise, they are not if `buffers-menu-submenus-for-groups-p' is T, -so that Manual-mode buffers will have their own submenu." - :type 'boolean - :group 'man) - -(defcustom Manual-buffers-have-prefix t - "*When non-nil, manual page buffers are named with a prefix of `man '. -Otherwise, their titles do not have this prefix." - :type 'boolean - :group 'man) - ;;Here is information on RosettaMan, from Neal.Becker@comsat.com (Neal Becker): ;;RosettaMan is a filter for UNIX manual pages. It takes as input man @@ -212,20 +199,10 @@ (if (equal section "-k") (setq apropos-mode t)) - (let ((bufname (flet - ((maybe-star () - (if (or Manual-buffers-have-stars - (not buffers-menu-submenus-for-groups-p)) - "*" - ""))) - (if apropos-mode - (concat (maybe-star) "man apropos " topic (maybe-star)) - (concat (maybe-star) - (if Manual-buffers-have-prefix - "man ") - topic - (if section (concat "(" section ")") "") - (maybe-star))))) + (let ((bufname (concat "Man" + (when apropos-mode " apropos") + ": " topic + (when section (concat "(" section ")") ""))) (temp-buffer-show-function (cond ((eq 't Manual-buffer-view-mode) 'view-buffer) @@ -327,7 +304,7 @@ ;; in delete-char alone.) (list 'delete-region '(point) (list '+ '(point) n))) -;; Hint: BS stands form more things than "back space" +;; Hint: BS stands for more things than "back space" (defun Manual-nuke-nroff-bs (&optional apropos-mode) (interactive "*") (if Manual-use-rosetta-man @@ -658,18 +635,10 @@ (setq manpage (buffer-substring (match-beginning 1) (match-end 1))) (setq manpage "???")) - (flet - ((maybe-star () - (if (or Manual-buffers-have-stars - (not buffers-menu-submenus-for-groups-p)) - "*" - ""))) - (setq buffer - (rename-buffer - (generate-new-buffer-name (concat (maybe-star) - manpage - (maybe-star)))))) - (setq buffer-file-name nil) + (setq buffer + (rename-buffer (generate-new-buffer-name + (concat "Man: " manpage))) + buffer-file-name nil) (goto-char (point-min)) (insert (format "%s\n" buf-name)) (goto-char (point-min)) diff -r 2947057885e5 -r a2f645c6b9f8 lisp/prim/about.el --- a/lisp/prim/about.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/prim/about.el Mon Aug 13 09:59:05 2007 +0200 @@ -106,10 +106,11 @@ (or (stringp what) (setq what (cdr (assq what about-url-alist)))) (assert what) - (let ((widget-link-prefix "") (widget-link-suffix "")) - (widget-create 'url-link - :help-echo echo - what))) + (widget-create 'url-link + :button-prefix "" + :button-suffix "" + :help-echo echo + what)) ;; Attach a face to a string, in order to be inserted into the buffer. ;; Make sure that the extent is duplicable, but unique. Returns the @@ -204,6 +205,8 @@ date with recent versions of that product. XEmacs stems from a\n") (widget-create 'link :help-echo "An XEmacs history lesson" :action 'about-collaboration + :button-prefix "" + :button-suffix "" "collaboration") (widget-insert " of Lucid, Inc. with Sun Microsystems, Inc. and the @@ -214,11 +217,16 @@ XEmacs provides a great number of ") (widget-create 'link :help-echo "See a list of the new features" :action 'about-features + :button-prefix "" + :button-suffix "" "new features") (widget-insert ". More details on XEmacs's functionality, including bundled packages, can be obtained through the ") - (widget-create 'info-link :help-echo "Browse the info system" + (widget-create 'info-link + :help-echo "Browse the info system" + :button-prefix "" + :button-suffix "" :tag "info" "(dir)") @@ -236,12 +244,13 @@ (flet ((setup-person (who) (widget-insert "\t* ") - (let* ((widget-link-prefix "") (widget-link-suffix "") - (entry (assq who xemacs-hackers)) + (let* ((entry (assq who xemacs-hackers)) (name (cadr entry)) (address (caddr entry))) (widget-create 'link :help-echo (concat "Find out more about " name) + :button-prefix "" + :button-suffix "" :action 'about-maintainer :tag name :value who) @@ -249,10 +258,11 @@ ;; Setup persons responsible for this release. (mapc 'setup-person '(slb mrb hniksic)) (widget-insert "\n\t* ") - (let ((widget-link-prefix "") (widget-link-suffix "")) - (widget-create 'link :help-echo "A legion of XEmacs hackers" - :action 'about-hackers - "And many other contributors...")) + (widget-create 'link :help-echo "A legion of XEmacs hackers" + :action 'about-hackers + :button-prefix "" + :button-suffix "" + "And many other contributors...") (widget-insert "\n Chuck Thompson was Mr. XEmacs from 19.11 through 19.14. Ben Wing was crucial to each of these releases.\n\n") @@ -860,11 +870,12 @@ (let* ((entry (assq who xemacs-hackers)) (name (cadr entry)) (address (caddr entry))) - (let ((widget-link-prefix "") (widget-link-suffix "")) - (widget-create 'link :help-echo (concat "Find out more about " name) - :action 'about-maintainer - :tag name - :value who)) + (widget-create 'link :help-echo (concat "Find out more about " name) + :action 'about-maintainer + :button-prefix "" + :button-suffix "" + :tag name + :value who) (widget-insert (about-tabs name) (format "<%s>\n%s\n" address shortinfo)))) @@ -1186,6 +1197,7 @@ (print-short "Tore Olsen" "toreo@colargol.idb.hist.no") (print-short "Greg Onufer" "Greg.Onufer@eng.sun.com") (print-short "Achim Oppelt" "aoppelt@theorie3.physik.uni-erlangen.de") + (print-short "Rebecca Ore" "rebecca.ore@op.net") (print-short "Sudeep Kumar Palat" "palat@idt.unit.no") (print-short "Marc Paquette" "Marc.Paquette@Softimage.com") (print-short "Jens-U H Petersen" "petersen@kurims.kyoto-u.ac.jp") diff -r 2947057885e5 -r a2f645c6b9f8 lisp/prim/auto-autoloads.el --- a/lisp/prim/auto-autoloads.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/prim/auto-autoloads.el Mon Aug 13 09:59:05 2007 +0200 @@ -42,18 +42,6 @@ ;;;*** -;;;### (autoloads (custom-make-dependencies) "cus-dep" "prim/cus-dep.el") - -(autoload 'custom-make-dependencies "cus-dep" "\ -Extract custom dependencies from .el files in SUBDIRS. -SUBDIRS is a list of directories. If it is nil, the command-line -arguments are used. If it is a string, only that directory is -processed. This function is especially useful in batch mode. - -Batch usage: xemacs -batch -l cus-dep.el -f custom-make-dependencies DIRS" t nil) - -;;;*** - ;;;### (autoloads (cancel-debug-on-entry debug-on-entry debug) "debug" "prim/debug.el") (autoload 'debug "debug" "\ @@ -230,7 +218,7 @@ (autoload 'disable-command "novice" "\ Require special confirmation to execute COMMAND from now on. -The user's .emacs file is altered so that this will apply +The user's `custom-file' is altered so that this will apply to future sessions." t nil) ;;;*** diff -r 2947057885e5 -r a2f645c6b9f8 lisp/prim/cus-dep.el --- a/lisp/prim/cus-dep.el Mon Aug 13 09:58:32 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,104 +0,0 @@ -;;; cus-dep.el --- Find customization dependencies. -;; -;; Copyright (C) 1997 Free Software Foundation, Inc. -;; -;; Author: Per Abrahamsen , then -;; Richar Stallman , then -;; Hrvoje Niksic -;; Maintainer: Hrvoje Niksic -;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Synched up with: Not synched with FSF. - -;;; Code: - -(require 'cl) -(require 'widget) -(require 'cus-edit) -(require 'cus-face) - -(defconst cusload-base-file "custom-load.el") - -;;;###autoload -(defun custom-make-dependencies (&optional subdirs) - "Extract custom dependencies from .el files in SUBDIRS. -SUBDIRS is a list of directories. If it is nil, the command-line -arguments are used. If it is a string, only that directory is -processed. This function is especially useful in batch mode. - -Batch usage: xemacs -batch -l cus-dep.el -f custom-make-dependencies DIRS" - (interactive "DDirectory: ") - (and (stringp subdirs) - (setq subdirs (list subdirs))) - (or subdirs - (setq subdirs command-line-args-left)) - (setq subdirs (mapcar #'expand-file-name subdirs)) - (with-temp-buffer - (let ((enable-local-eval nil) - (hash (make-hash-table :test 'eq))) - (dolist (dir subdirs) - (message "Processing %s" dir) - (let ((cusload-file (expand-file-name cusload-base-file dir))) - (dolist (file (directory-files dir t "\\`[^=].*\\.el\\'")) - (when (file-exists-p file) - (erase-buffer) - (insert-file-contents file) - (goto-char (point-min)) - (let ((name (file-name-sans-extension - (file-name-nondirectory file)))) - (condition-case nil - (while (re-search-forward - "^(defcustom\\|^(defface\\|^(defgroup" - nil t) - (beginning-of-line) - (let ((expr (read (current-buffer)))) - (eval expr) - (setf (gethash (nth 1 expr) hash) name))) - (error nil))))) - (message "Generating %s..." cusload-base-file) - (with-temp-file cusload-file - (insert ";;; " cusload-base-file - " --- automatically extracted custom dependencies\n" - ";;\n;;; Code:\n\n") - (mapatoms (lambda (sym) - (let ((members (get sym 'custom-group)) - item where found) - (when members - (while members - (setq item (car (car members)) - members (cdr members) - where (gethash item hash)) - (unless (or (null where) - (member where found)) - (if found - (insert " ") -;;; (insert "(custom-add-loads '" (symbol-name sym) - (insert "(custom-put '" (symbol-name sym) - " '(")) - (prin1 where (current-buffer)) - (push where found))) - (when found - (insert "))\n")))))) - (insert "\n;;; custom-load.el ends here\n")) - (clrhash hash)))))) - -(provide 'cus-dep) - -;;; cus-dep.el ends here diff -r 2947057885e5 -r a2f645c6b9f8 lisp/prim/cus-load.el --- a/lisp/prim/cus-load.el Mon Aug 13 09:58:32 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,49 +0,0 @@ -;;; cus-load.el --- Batch load all available cus-load files - -;; Copyright (C) 1997 by Free Software Foundation, Inc. - -;; Author: Steven L Baur -;; Keywords: internal, help, faces - -;; 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, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. - -;;; Synched up with: Not in FSF - -;;; Commentary: - -;; In FSF all of the custom loads are in a single `cus-load' file. -;; However, we have them distributed across directories, with optional -;; incremental loading. Here we simply collect the whole set. - - -;;; Code: - -(defun custom-put (symbol property list) - (let ((loads (get symbol property))) - (dolist (el list) - (unless (member el loads) - (setq loads (nconc loads (list el))))) - (put symbol property loads))) - -(mapc (lambda (dir) - (load (expand-file-name "custom-load" dir) t)) - load-path) - -(provide 'cus-load) - -;;; cus-load.el ends here diff -r 2947057885e5 -r a2f645c6b9f8 lisp/prim/cus-start.el --- a/lisp/prim/cus-start.el Mon Aug 13 09:58:32 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,199 +0,0 @@ -;;; cus-start.el --- define customization properties of builtins. -;; -;; Copyright (C) 1997 Free Software Foundation, Inc. -;; -;; Author: Per Abrahamsen -;; 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, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. - -;;; Synched up with: Not synched with FSF. - -;;; Commentary: -;; -;; The following code is used to define the customization properties -;; for builtin variables, and variables in the packages that are -;; preloaded /very/ early, before custom.el itself (replace.el is such -;; an example). The way it handles custom stuff is dirty, and should -;; be regarded as a last resort. DO NOT add variables here, unless -;; you know what you are doing. - -;; Must be run before the user has changed the value of any options! - - -;;; Code: - -(require 'custom) - -(defun custom-start-quote (sexp) - ;; This is copied from `cus-edit.el'. - "Quote SEXP iff it is not self quoting." - (if (or (memq sexp '(t nil)) - (and (symbolp sexp) - (eq (aref (symbol-name sexp) 0) ?:)) - (and (listp sexp) - (memq (car sexp) '(lambda))) - (stringp sexp) - (numberp sexp) - (and (fboundp 'characterp) - (characterp sexp))) - sexp - (list 'quote sexp))) - -(let ((all '(;; boolean - (abbrev-all-caps abbrev boolean) - (allow-deletion-of-last-visible-frame frames boolean) - (debug-on-quit debug boolean) - (delete-auto-save-files auto-save boolean) - (delete-exited-processes processes-basics boolean) - (indent-tabs-mode editing-basics boolean) - (load-ignore-elc-files maint boolean) - (load-warn-when-source-newer maint boolean) - (load-warn-when-source-only maint boolean) - (modifier-keys-are-sticky keyboard boolean) - (no-redraw-on-reenter display boolean) - (scroll-on-clipped-lines display boolean) - (truncate-partial-width-windows display boolean) - (visible-bell sound boolean) - (x-allow-sendevents x boolean) - (zmacs-regions editing-basics boolean) - ;; integer - (auto-save-interval auto-save integer) - (bell-volume sound integer) - (echo-keystrokes keyboard integer) - (gc-cons-threshold alloc integer) - (next-screen-context-lines display integer) - (scroll-step windows integer) - (window-min-height windows integer) - (window-min-width windows integer) - ;; object - (auto-save-file-format auto-save - (choice (const :tag "Normal" t) - (repeat (symbol :tag "Format")))) - (completion-ignored-extensions minibuffer - (repeat - (string :format "%v"))) - (debug-ignored-errors debug (repeat (choice :format "%v" - (symbol :tag "Class") - regexp))) - (debug-on-error debug (choice (const :tag "off" nil) - (const :tag "Always" t) - (repeat :menu-tag "When" - :value (nil) - (symbol - :tag "Condition")))) - (debug-on-signal debug (choice (const :tag "off" nil) - (const :tag "Always" t) - (repeat :menu-tag "When" - :value (nil) - (symbol - :tag "Condition")))) - (exec-path processes-basics (repeat - (choice :tag "Directory" - (const :tag "Default" nil) - (directory :format "%v")))) - (file-name-handler-alist data (repeat - (cons regexp - (function :tag "Handler")))) - (shell-file-name execute file) - (stack-trace-on-error debug (choice (const :tag "off" nil) - (const :tag "Always" t) - (repeat :menu-tag "When" - :value (nil) - (symbol - :tag "Condition")))) - (stack-trace-on-signal debug (choice (const :tag "off" nil) - (const :tag "Always" t) - (repeat :menu-tag "When" - :value (nil) - (symbol - :tag "Condition")))) - ;; buffer-local - (case-fold-search matching boolean) - (ctl-arrow display (choice (integer 160) - (sexp :tag "160 (default)" - :format "%t\n"))) - (fill-column fill integer) - (left-margin fill integer) - (tab-width editing-basics integer) - (truncate-lines display boolean) - ;; not documented as user-options, but should still be - ;; customizable: - (bar-cursor display (choice (const :tag "Block Cursor" nil) - (const :tag "Bar Cursor (1 pixel)" t) - (sexp :tag "Bar Cursor (2 pixels)" - :format "%t\n" 'other))) - (default-frame-plist frames (repeat - (list :inline t - :format "%v" - (symbol :tag "Parameter") - (sexp :tag "Value")))) - (disable-auto-save-when-buffer-shrinks auto-save boolean) - (find-file-compare-truenames find-file boolean) - (focus-follows-mouse x boolean) - (help-char keyboard character) - (max-lisp-eval-depth limits integer) - (max-specpdl-size limits integer) - (meta-prefix-char keyboard character) - (parse-sexp-ignore-comments editing-basics boolean) - (selective-display display - (choice (const :tag "off" nil) - (integer :tag "space" - :format "%v" - 1) - (const :tag "on" t))) - (selective-display-ellipses display boolean) - (signal-error-on-buffer-boundary internal boolean) - (temp-buffer-show-function - windows (radio (function-item :tag "Temp Buffers Always in Same Frame" - :format "%t\n" - show-temp-buffer-in-current-frame) - (const :tag "Temp Buffers Like Other Buffers" nil) - (function :tag "Other"))) - (undo-threshold undo integer) - (undo-high-threshold undo integer) - (words-include-escapes editing-basics boolean) - ;; These are from replace.el, which is loaded too early - ;; to be customizable. - (case-replace matching boolean) - (query-replace-highlight matching boolean) - (list-matching-lines-default-context-lines matching integer))) - this symbol group type) - (while all - (setq this (car all) - all (cdr all) - symbol (nth 0 this) - group (nth 1 this) - type (nth 2 this)) - (if (not (boundp symbol)) - ;; This is loaded so early, there is no message - (if (fboundp 'message) - ;; If variables are removed from C code, give an error here! - (message "Intrinsic `%S' not bound" symbol)) - ;; This is called before any user can have changed the value. - (put symbol 'standard-value - (list (custom-start-quote (default-value symbol)))) - ;; Add it to the right group. - (custom-add-to-group group symbol 'custom-variable) - ;; Set the type. - (put symbol 'custom-type type)))) - -;; This is to prevent it from being reloaded by `cus-load.el'. -(provide 'cus-start) - -;;; cus-start.el ends here. diff -r 2947057885e5 -r a2f645c6b9f8 lisp/prim/custom-load.el --- a/lisp/prim/custom-load.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/prim/custom-load.el Mon Aug 13 09:59:05 2007 +0200 @@ -1,8 +1,15 @@ +;;; custom-load.el --- automatically extracted custom dependencies + +;; Created by SL Baur on Sat Sep 27 08:14:13 1997 + +;;; Code: + (custom-put 'mouse 'custom-loads '("mouse")) (custom-put 'minibuffer 'custom-loads '("minibuf")) (custom-put 'environment 'custom-loads '("frame" "minibuf" "modeline" "sound")) (custom-put 'sound 'custom-loads '("sound")) (custom-put 'auto-save 'custom-loads '("files")) +(custom-put 'mail 'custom-loads '("simple")) (custom-put 'editing-basics 'custom-loads '("cmdloop" "simple" "files" "lisp")) (custom-put 'help-appearance 'custom-loads '("help")) (custom-put 'lisp 'custom-loads '("lisp")) @@ -24,3 +31,5 @@ (custom-put 'modeline 'custom-loads '("modeline")) (custom-put 'editing 'custom-loads '("simple")) (custom-put 'matching 'custom-loads '("simple" "isearch-mode")) + +;;; custom-load.el ends here diff -r 2947057885e5 -r a2f645c6b9f8 lisp/prim/files.el --- a/lisp/prim/files.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/prim/files.el Mon Aug 13 09:59:05 2007 +0200 @@ -138,6 +138,15 @@ (defvaralias 'find-file-visit-truename 'find-file-use-truenames) (defvaralias 'find-file-existing-other-name 'find-file-compare-truenames) +(defcustom revert-without-query nil + "*Specify which files should be reverted without query. +The value is a list of regular expressions. +If the file name matches one of these regular expressions, +then `revert-buffer' reverts the file without querying +if the file has changed on disk and you have not edited the buffer." + :type 'boolean + :group 'find-file) + (defvar buffer-file-number nil "The device number and file number of the file visited in the current buffer. The value is a list of the form (FILENUM DEVNUM). @@ -993,6 +1002,17 @@ (verify-visited-file-modtime buf) (cond ((not (file-exists-p filename)) (error "File %s no longer exists!" filename)) + ;; Certain files should be reverted automatically + ;; if they have changed on disk and not in the buffer. + ((and (not (buffer-modified-p buf)) + (let (found) + (dolist (rx revert-without-query found) + (when (string-match rx filename) + (setq found t))))) + (with-current-buffer buf + (message "Reverting file %s..." filename) + (revert-buffer t t) + (message "Reverting file %s... done" filename))) ((yes-or-no-p (if (string= (file-name-nondirectory filename) (buffer-name buf)) @@ -1116,9 +1136,16 @@ ;; than when we save the buffer, because we want ;; autosaving to work. (setq buffer-read-only nil) - (if (file-exists-p (file-name-directory (directory-file-name (file-name-directory buffer-file-name)))) - "Use M-x make-dir RET RET to create the directory" - "Use C-u M-x make-dir RET RET to create directory and its parents"))))) + ;; XEmacs + (or (file-exists-p (file-name-directory buffer-file-name)) + (if (yes-or-no-p + (format + "The directory containing %s does not exist. Create? " + (abbreviate-file-name buffer-file-name))) + (make-directory (file-name-directory + buffer-file-name) + t))) + nil)))) (if msg (progn (message msg) @@ -2564,6 +2591,11 @@ (cond ((null file-name) (error "Buffer does not seem to be associated with any file")) ((or noconfirm + (and (not (buffer-modified-p)) + (let (found) + (dolist (rx revert-without-query found) + (when (string-match rx file-name) + (setq found t))))) (yes-or-no-p (format "Revert buffer from file %s? " file-name))) (run-hooks 'before-revert-hook) diff -r 2947057885e5 -r a2f645c6b9f8 lisp/prim/glyphs.el --- a/lisp/prim/glyphs.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/prim/glyphs.el Mon Aug 13 09:59:05 2007 +0200 @@ -611,7 +611,7 @@ ,@(if (featurep 'jpeg) '(("\\.jpe?g\\'" [jpeg :file nil] 2))) ;; all of the JFIF-format JPEG's that I've seen begin with ;; the following. I have no idea if this is standard. - ,@(if (featurep 'jpeg) '(("\\`\377\330\340\000\020JFIF" + ,@(if (featurep 'jpeg) '(("\\`\377\330\377\340\000\020JFIF" [jpeg :data nil] 2))) ,@(if (featurep 'png) '(("\\.png\\'" [png :file nil] 2))) ,@(if (featurep 'png) '(("\\`\211PNG" [png :data nil] 2))) diff -r 2947057885e5 -r a2f645c6b9f8 lisp/prim/help.el --- a/lisp/prim/help.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/prim/help.el Mon Aug 13 09:59:05 2007 +0200 @@ -67,6 +67,7 @@ (define-key help-map "B" 'describe-beta) (define-key help-map "\C-p" 'describe-pointer) +(define-key help-map "C" 'customize) (define-key help-map "c" 'describe-key-briefly) (define-key help-map "k" 'describe-key) @@ -185,7 +186,33 @@ ) (define-key help-mode-map "q" 'help-mode-quit) -(define-key help-mode-map 'delete 'scroll-down) +(define-key help-mode-map "f" 'find-function-at-point) + +(defun describe-function-at-point () + "Describe directly the function at point in the other window." + (interactive) + (let ((symb (function-at-point))) + (when symb + (describe-function symb)))) +(defun describe-variable-at-point () + "Describe directly the variable at point in the other window." + (interactive) + (let ((symb (variable-at-point))) + (when symb + (describe-variable symb)))) +(defun help-next-symbol () + "Move point to the next quoted symbol." + (interactive) + (search-forward "`" nil t)) +(defun help-prev-symbol () + "Move point to the previous quoted symbol." + (interactive) + (search-backward "'" nil t)) +(define-key help-mode-map "d" 'describe-function-at-point) +(define-key help-mode-map "v" 'describe-variable-at-point) +(define-key help-mode-map [tab] 'help-next-symbol) +(define-key help-mode-map [(shift tab)] 'help-prev-symbol) + (defun help-mode-quit () "Exits from help mode, possibly restoring the previous window configuration. @@ -781,12 +808,15 @@ file) (while files (if (memq function (cdr (car files))) - (setq file (car (car files)) files nil)) + (setq file (car (car files)) + files nil)) (setq files (cdr files))) file)) (defun describe-function (function) - "Display the full documentation of FUNCTION (a symbol)." + "Display the full documentation of FUNCTION (a symbol). +When run interactively, it defaults to any function found by the +value of `find-function-function'." (interactive (let* ((fn (funcall find-function-function)) (val (let ((enable-recursive-minibuffers t)) @@ -795,7 +825,7 @@ (format (gettext "Describe function (default %s): ") fn) (gettext "Describe function: ")) - obarray 'fboundp t)))) + obarray 'fboundp t nil 'function-history)))) (list (if (equal val "") fn (intern val))))) (with-displaying-help-buffer (lambda () @@ -1071,7 +1101,7 @@ (if v (format "Describe variable (default %s): " v) (gettext "Describe variable: ")) - obarray 'boundp t)))) + obarray 'boundp t nil 'variable-history)))) (list (if (equal val "") v (intern val))))) (with-displaying-help-buffer (lambda () @@ -1161,7 +1191,9 @@ (defun where-is (definition) "Print message listing key sequences that invoke specified command. -Argument is a command definition, usually a symbol with a function definition." +Argument is a command definition, usually a symbol with a function definition. +When run interactively, it defaults to any function found by the +value of `find-function-function'." (interactive (let ((fn (funcall find-function-function)) (enable-recursive-minibuffers t) @@ -1301,8 +1333,8 @@ ;; find-function stuff (defvar find-function-function 'function-at-point - "*The function used by `find-function' to select the function near -point. + "*The function used by `describe-function', `where-is' and +`find-function' to select the function near point. For example `function-at-point' or `function-called-at-point'.") @@ -1313,16 +1345,15 @@ default.") -(defun find-function-noselect (function &optional path) - "Returns list `(buffer point)' pointing to the definition of FUNCTION. +(defun find-function-noselect (function) + "Returns a pair `(buffer . point)' pointing to the definition of FUNCTION. -Finds the emacs-lisp library containing the definition of FUNCTION -in a buffer and places point before the definition. The buffer is +Finds the Emacs Lisp library containing the definition of FUNCTION +in a buffer and the point of the definition. The buffer is not selected. -If the optional argument PATH is given, the library where FUNCTION is -defined is searched in PATH instead of `load-path' (see -`find-function-source-path')." +The library where FUNCTION is defined is searched for in +`find-function-source-path', if non `nil', otherwise in `load-path'." (and (subrp (symbol-function function)) (error "%s is a primitive function" function)) (if (not function) @@ -1332,11 +1363,11 @@ (while (symbolp def) (or (eq def function) (if aliases - (setq aliases (concat aliases + (setq aliases (concat aliases (format ", which is an alias for %s" (symbol-name def)))) (setq aliases (format "an alias for %s" (symbol-name - def))))) + def))))) (setq function (symbol-function function) def (symbol-function function))) (if aliases @@ -1348,37 +1379,29 @@ ((compiled-function-p def) (substring (compiled-function-annotation def) 0 -4)))) (if (null library) - (error "Can't find library")) - (if (string-match "\\(\\.elc?\\'\\)" library) + (error (format "Don't know where `%s' is defined" function))) + (if (string-match "\\.el\\(c\\)\\'" library) (setq library (substring library 0 (match-beginning 1)))) (let* ((path (or path find-function-source-path)) - (compression (or (rassq 'jka-compr-handler file-name-handler-alist) - (member 'crypt-find-file-hook find-file-hooks))) - (filename (or (locate-library (concat library ".el") - t path) - (locate-library library t path) - (if compression - (or (locate-library (concat library ".el.gz") - t path) - (locate-library (concat library ".gz") - t path)))))) + (filename (or (locate-library (concat library ".el") t path) + (locate-library library t path)))) (if (not filename) (error "The library \"%s\" is not in the path." library)) - (save-excursion - (set-buffer (find-file-noselect filename)) + (with-current-buffer (find-file-noselect filename) (save-match-data (let (;; avoid defconst, defgroup, defvar (any others?) - (re (format "^\\s-*(def[^cgv\W]\\w+\\s-+%s\\s-" function)) + (regexp + (format "^\\s-*(def[^cgv\W]\\w+\\*?\\s-+%s\\s-" function)) (syntable (syntax-table))) (set-syntax-table emacs-lisp-mode-syntax-table) (goto-char (point-min)) (if (prog1 - (re-search-forward re nil t) + (re-search-forward regexp nil t) (set-syntax-table syntable)) (progn - (beginning-of-line) - (list (current-buffer) (point))) - (error "Cannot find definition of %s" function)))))))) + (beginning-of-line) + (cons (current-buffer) (point))) + (error "Cannot find definition of `%s'" function)))))))) (defun function-at-point () (or (condition-case () @@ -1412,70 +1435,72 @@ The function named by `find-function-function' is used to select the default function." (let ((fn (funcall find-function-function)) - (enable-recursive-minibuffers t) + (enable-recursive-minibuffers t) val) (setq val (completing-read (if fn (format "Find function (default %s): " fn) "Find function: ") - obarray 'fboundp t)) + obarray 'fboundp t nil 'function-history)) (list (if (equal val "") fn (intern val))))) +(defun find-function-do-it (function switch-fn) + "find elisp FUNCTION in a buffer and display it with SWITCH-FN. +Point is saved in the buffer if it is one of the current buffers." + (let ((orig-point (point)) + (orig-buffers (buffer-list)) + (buffer-point (find-function-noselect function))) + (if buffer-point + (progn + (funcall switch-fn (car buffer-point)) + (if (memq (car buffer-point) orig-buffers) + (push-mark orig-point)) + (goto-char (cdr buffer-point)) + (recenter 0))))) -(defun find-function (function &optional path) +(defun find-function (function) "Find the definition of the function near point in the current window. -Finds the emacs-lisp library containing the definition of the function -near point (selected by `find-function-function') and places point -before the definition. +Finds the Emacs Lisp library containing the definition of the function +near point (selected by `find-function-function') in a buffer and +places point before the definition. Point is saved in the buffer if +it is one of the current buffers. -If the optional argument PATH is given, the library where FUNCTION is -defined is searched in PATH instead of `load-path'" +The library where FUNCTION is defined is searched for in +`find-function-source-path', if non `nil', otherwise in `load-path'." (interactive (find-function-read-function)) - (let ((buffer-point (find-function-noselect function path))) - (if buffer-point - (progn - (switch-to-buffer (car buffer-point)) - (goto-char (cadr buffer-point)) - (recenter 0))))) + (find-function-do-it function 'switch-to-buffer)) -(defun find-function-other-window (function &optional path) +(defun find-function-other-window (function) "Find the definition of the function near point in the other window. -Finds the emacs-lisp library containing the definition of the function -near point (selected by `find-function-function') and places point -before the definition. +Finds the Emacs Lisp library containing the definition of the function +near point (selected by `find-function-function') in a buffer and +places point before the definition. Point is saved in the buffer if +it is one of the current buffers. -If the optional argument PATH is given, the library where FUNCTION is -defined is searched in PATH instead of `load-path'" +The library where FUNCTION is defined is searched for in +`find-function-source-path', if non `nil', otherwise in `load-path'." (interactive (find-function-read-function)) - (let ((buffer-point (find-function-noselect function path))) - (if buffer-point - (progn - (switch-to-buffer-other-window (car buffer-point)) - (goto-char (cadr buffer-point)) - (recenter 0))))) + (find-function-do-it function 'switch-to-buffer-other-window)) -(defun find-function-other-frame (function &optional path) +(defun find-function-other-frame (function) "Find the definition of the function near point in the another frame. -Finds the emacs-lisp library containing the definition of the function -near point (selected by `find-function-function') and places point -before the definition. +Finds the Emacs Lisp library containing the definition of the function +near point (selected by `find-function-function') in a buffer and +places point before the definition. Point is saved in the buffer if +it is one of the current buffers. -If the optional argument PATH is given, the library where FUNCTION is -defined is searched in PATH instead of `load-path'" +The library where FUNCTION is defined is searched for in +`find-function-source-path', if non `nil', otherwise in `load-path'." (interactive (find-function-read-function)) - (let ((buffer-point (find-function-noselect function path))) - (if buffer-point - (progn - (switch-to-buffer-other-frame (car buffer-point)) - (goto-char (cadr buffer-point)) - (recenter 0))))) + (find-function-do-it function 'switch-to-buffer-other-frame)) (defun find-function-on-key (key) - "Find the function that KEY invokes. KEY is a string." + "Find the function that KEY invokes. KEY is a string. +Point is saved if FUNCTION is in the current buffer." (interactive "kFind function on key: ") (let ((defn (key-or-menu-binding key))) (if (or (null defn) (integerp defn)) @@ -1484,6 +1509,13 @@ (message "runs %s" (prin1-to-string defn)) (find-function-other-window defn))))) +(defun find-function-at-point () + "Find directly the function at point in the other window." + (interactive) + (let ((symb (function-at-point))) + (when symb + (find-function-other-window symb)))) + (define-key ctl-x-map "F" 'find-function) (define-key ctl-x-4-map "F" 'find-function-other-window) (define-key ctl-x-5-map "F" 'find-function-other-frame) diff -r 2947057885e5 -r a2f645c6b9f8 lisp/prim/keydefs.el --- a/lisp/prim/keydefs.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/prim/keydefs.el Mon Aug 13 09:59:05 2007 +0200 @@ -141,8 +141,6 @@ (define-key global-map "\C-x52" 'make-frame) (define-key global-map "\C-x50" 'delete-frame) (define-key global-map "\C-x5o" 'other-frame) -;; XEmacs addition: -(define-key global-map "\C-x5m" 'mail-other-frame) ;; FSFmacs help.el @@ -462,9 +460,9 @@ (define-key global-map "\M-$" 'ispell-word) -(define-key global-map "\C-x4m" 'mail-other-window) - -(define-key global-map "\C-xm" 'mail) +(define-key global-map "\C-xm" 'compose-mail) +(define-key global-map "\C-x4m" 'compose-mail-other-window) +(define-key global-map "\C-x5m" 'compose-mail-other-frame) (define-key global-map "\M-." 'find-tag) diff -r 2947057885e5 -r a2f645c6b9f8 lisp/prim/menubar.el --- a/lisp/prim/menubar.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/prim/menubar.el Mon Aug 13 09:59:05 2007 +0200 @@ -169,7 +169,7 @@ If some menu in the ITEM-PATH-LIST does not exist, an error is signalled." (or (listp item-path-list) (signal 'wrong-type-argument (list 'listp item-path-list))) - (or parent (setq item-path-list (mapcar 'downcase item-path-list))) + (or parent (setq item-path-list (mapcar 'normalize-menu-item-name item-path-list))) (if (not (consp menubar)) nil (let ((rest menubar) @@ -181,7 +181,7 @@ (while rest (if (and (car rest) (equal (car item-path-list) - (downcase (if (vectorp (car rest)) + (normalize-menu-item-name (if (vectorp (car rest)) (aref (car rest) 0) (if (stringp (car rest)) (car rest) @@ -199,7 +199,7 @@ (defun add-menu-item-1 (leaf-p menu-path new-item before) ;; This code looks like it could be cleaned up some more ;; Do we really need 6 calls to find-menu-item? - (when before (setq before (downcase before))) + (when before (setq before (normalize-menu-item-name before))) (let* ((item-name (cond ((vectorp new-item) (aref new-item 0)) ((consp new-item) (car new-item)) diff -r 2947057885e5 -r a2f645c6b9f8 lisp/prim/obsolete.el --- a/lisp/prim/obsolete.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/prim/obsolete.el Mon Aug 13 09:59:05 2007 +0200 @@ -634,12 +634,11 @@ "Convert STRING to a sequence of TYPE which contains characters in STRING. TYPE should be `list' or `vector'. Multibyte characters are concerned." - (cond ((eq type 'list) - (mapcar #'identity string)) - ((eq type 'vector) - (mapcar #'identity string)) - (t - (error "Type must be `list' or `vector'")))) + (ecase type + (list + (mapcar #'identity string)) + (vector + (mapvector #'identity string)))) (defun string-to-list (string) "Return a list of characters in STRING." diff -r 2947057885e5 -r a2f645c6b9f8 lisp/prim/packages.el --- a/lisp/prim/packages.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/prim/packages.el Mon Aug 13 09:59:05 2007 +0200 @@ -37,7 +37,7 @@ "Filename that autoloads are expected to be found in.") (defvar packages-hardcoded-lisp - '("cl-defs" + '( ;; "startup" ) "Lisp packages that are always dumped with XEmacs") @@ -45,7 +45,8 @@ (defvar packages-useful-lisp '("bytecomp" "byte-optimize" - "advice") + "advice" + "shadow") "Lisp packages that need early byte compilation.") (defvar packages-unbytecompiled-lisp diff -r 2947057885e5 -r a2f645c6b9f8 lisp/prim/register.el --- a/lisp/prim/register.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/prim/register.el Mon Aug 13 09:59:05 2007 +0200 @@ -1,4 +1,4 @@ -;;; register.el --- register commands for XEmacs. +;;; register.el --- register commands for Emacs. ;; Copyright (C) 1985, 1993, 1994 Free Software Foundation, Inc. @@ -7,29 +7,29 @@ ;; 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 +;; 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. +;; 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, Inc., 59 Temple Place - Suite 330, Boston, MA -;; 02111-1307, USA. +;; along with XEmacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. -;;; Synched up with: FSF 19.34. +;;; Synched up with: FSF 20.1 ;;; Commentary: ;; This package of functions emulates and somewhat extends the venerable ;; TECO's `register' feature, which permits you to save various useful ;; pieces of buffer state to named variables. The entry points are -;; documented in the XEmacs Reference Manual. +;; documented in the Emacs user's manual. ;;; Code: @@ -38,7 +38,9 @@ NAME is a character (a number). CONTENTS is a string, number, frame configuration, mark or list. A list of strings represents a rectangle. -A list of the form (file . NAME) represents the file named NAME.") +A list of the form (file . NAME) represents the file named NAME. +A list of the form (file-query NAME POSITION) represents position POSITION + in the file named NAME, but query before visiting it.") (defun get-register (reg) "Return contents of Emacs register named REG, or nil if none." @@ -46,7 +48,7 @@ (defun set-register (register value) "Set contents of Emacs register named REGISTER to VALUE. Returns VALUE. -See the documentation of the variable `register-alist' for possible VALUEs." +See the documentation of the variable `register-alist' for possible VALUE." (let ((aelt (assq register register-alist))) (if aelt (setcdr aelt value) @@ -103,9 +105,30 @@ (goto-char val)) ((and (consp val) (eq (car val) 'file)) (find-file (cdr val))) + ((and (consp val) (eq (car val) 'file-query)) + (or (find-buffer-visiting (nth 1 val)) + (y-or-n-p (format "Visit file %s again? " (nth 1 val))) + (error "Register access aborted")) + (find-file (nth 1 val)) + (goto-char (nth 2 val))) (t (error "Register doesn't contain a buffer position or configuration"))))) +;; Turn markers into file-query references when a buffer is killed. +(defun register-swap-out () + (and buffer-file-name + (let ((tail register-alist)) + (while tail + (and (markerp (cdr (car tail))) + (eq (marker-buffer (cdr (car tail))) (current-buffer)) + (setcdr (car tail) + (list 'file-query + buffer-file-name + (marker-position (cdr (car tail)))))) + (setq tail (cdr tail)))))) + +(add-hook 'kill-buffer-hook 'register-swap-out) + ;(defun number-to-register (arg char) ; "Store a number in a register. ;Two args, NUMBER and REGISTER (a character, naming the register). @@ -142,9 +165,10 @@ (if (null val) (message "Register %s is empty" (single-key-description register)) (with-output-to-temp-buffer "*Output*" - (princ (format "Register %s contains " - (single-key-description register))) - (cond + (princ "Register ") + (princ (single-key-description register)) + (princ " contains ") + (cond ((integerp val) (princ val)) @@ -152,17 +176,16 @@ (let ((buf (marker-buffer val))) (if (null buf) (princ "a marker in no buffer") - (princ (format - "a buffer position:\nbuff %s, position %s" - (buffer-name (marker-buffer val)) - (marker-position val)))))) + (princ "a buffer position:\nbuffer ") + (princ (buffer-name buf)) + (princ ", position ") + (princ (marker-position val))))) ((window-configuration-p val) (princ "a window configuration.")) - -;; ((frame-configuration-p val) -;; (princ "a frame configuration.")) + ((frame-configuration-p val) + (princ "a frame configuration.")) ((and (consp val) (eq (car val) 'file)) (princ "the file ") @@ -171,7 +194,7 @@ ((consp val) (princ "the rectangle:\n") - (while val + (while val (princ (car val)) (terpri) (setq val (cdr val)))) @@ -185,7 +208,7 @@ (prin1 val))))))) (defun insert-register (register &optional arg) - "Insert contents of register REGISTER. (REGISTER is a character). + "Insert contents of register REGISTER. (REGISTER is a character.) Normally puts point before and mark after the inserted text. If optional second arg is non-nil, puts mark before and point after. Interactively, second arg is non-nil if prefix arg is supplied." @@ -203,8 +226,7 @@ (princ (marker-position val) (current-buffer))) (t (error "Register does not contain text")))) - ;; XEmacs: don't activate the region. It's annoying. - (if (not arg) (exchange-point-and-mark t))) + (if (not arg) (exchange-point-and-mark))) (defun copy-to-register (register start end &optional delete-flag) "Copy region into register REGISTER. With prefix arg, delete as well. @@ -223,7 +245,7 @@ (or (stringp (get-register register)) (error "Register does not contain text")) (set-register register (concat (get-register register) - (buffer-substring start end))) + (buffer-substring start end))) (if delete-flag (delete-region start end))) (defun prepend-to-register (register start end &optional delete-flag) @@ -235,7 +257,7 @@ (or (stringp (get-register register)) (error "Register does not contain text")) (set-register register (concat (buffer-substring start end) - (get-register register))) + (get-register register))) (if delete-flag (delete-region start end))) (defun copy-rectangle-to-register (register start end &optional delete-flag) diff -r 2947057885e5 -r a2f645c6b9f8 lisp/prim/simple.el --- a/lisp/prim/simple.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/prim/simple.el Mon Aug 13 09:59:05 2007 +0200 @@ -2938,6 +2938,152 @@ (setq alist (cdr alist))) element)) + +(defcustom mail-user-agent 'sendmail-user-agent + "*Your preference for a mail composition package. +Various Emacs Lisp packages (e.g. reporter) require you to compose an +outgoing email message. This variable lets you specify which +mail-sending package you prefer. + +Valid values include: + + sendmail-user-agent -- use the default Emacs Mail package + mh-e-user-agent -- use the Emacs interface to the MH mail system + message-user-agent -- use the GNUS mail sending package + +Additional valid symbols may be available; check with the author of +your package for details." + :type '(radio (function-item :tag "Default Emacs mail" + :format "%t\n" + sendmail-user-agent) + (function-item :tag "Gnus mail sending package" + :format "%t\n" + message-user-agent) + (function :tag "Other")) + :group 'mail) + +(defun define-mail-user-agent (symbol composefunc sendfunc + &optional abortfunc hookvar) + "Define a symbol to identify a mail-sending package for `mail-user-agent'. + +SYMBOL can be any Lisp symbol. Its function definition and/or +value as a variable do not matter for this usage; we use only certain +properties on its property list, to encode the rest of the arguments. + +COMPOSEFUNC is program callable function that composes an outgoing +mail message buffer. This function should set up the basics of the +buffer without requiring user interaction. It should populate the +standard mail headers, leaving the `to:' and `subject:' headers blank +by default. + +COMPOSEFUNC should accept several optional arguments--the same +arguments that `compose-mail' takes. See that function's documentation. + +SENDFUNC is the command a user would run to send the message. + +Optional ABORTFUNC is the command a user would run to abort the +message. For mail packages that don't have a separate abort function, +this can be `kill-buffer' (the equivalent of omitting this argument). + +Optional HOOKVAR is a hook variable that gets run before the message +is actually sent. Callers that use the `mail-user-agent' may +install a hook function temporarily on this hook variable. +If HOOKVAR is nil, `mail-send-hook' is used. + +The properties used on SYMBOL are `composefunc', `sendfunc', +`abortfunc', and `hookvar'." + (put symbol 'composefunc composefunc) + (put symbol 'sendfunc sendfunc) + (put symbol 'abortfunc (or abortfunc 'kill-buffer)) + (put symbol 'hookvar (or hookvar 'mail-send-hook))) + +(define-mail-user-agent 'sendmail-user-agent + 'sendmail-user-agent-compose 'mail-send-and-exit) + +(define-mail-user-agent 'message-user-agent + 'message-mail 'message-send-and-exit + 'message-kill-buffer 'message-send-hook) + +(defun sendmail-user-agent-compose (&optional to subject other-headers continue + switch-function yank-action + send-actions) + (if switch-function + (let ((special-display-buffer-names nil) + (special-display-regexps nil) + (same-window-buffer-names nil) + (same-window-regexps nil)) + (funcall switch-function "*mail*"))) + (let ((cc (cdr (assoc-ignore-case "cc" other-headers))) + (in-reply-to (cdr (assoc-ignore-case "in-reply-to" other-headers)))) + (or (mail continue to subject in-reply-to cc yank-action send-actions) + continue + (error "Message aborted")) + (save-excursion + (goto-char (point-min)) + (search-forward mail-header-separator) + (beginning-of-line) + (while other-headers + (if (not (member (car (car other-headers)) '("in-reply-to" "cc"))) + (insert (car (car other-headers)) ": " + (cdr (car other-headers)) "\n")) + (setq other-headers (cdr other-headers))) + t))) + +(define-mail-user-agent 'mh-e-user-agent + 'mh-smail-batch 'mh-send-letter 'mh-fully-kill-draft + 'mh-before-send-letter-hook) + +(defun compose-mail (&optional to subject other-headers continue + switch-function yank-action send-actions) + "Start composing a mail message to send. +This uses the user's chosen mail composition package +as selected with the variable `mail-user-agent'. +The optional arguments TO and SUBJECT specify recipients +and the initial Subject field, respectively. + +OTHER-HEADERS is an alist specifying additional +header fields. Elements look like (HEADER . VALUE) where both +HEADER and VALUE are strings. + +CONTINUE, if non-nil, says to continue editing a message already +being composed. + +SWITCH-FUNCTION, if non-nil, is a function to use to +switch to and display the buffer used for mail composition. + +YANK-ACTION, if non-nil, is an action to perform, if and when necessary, +to insert the raw text of the message being replied to. +It has the form (FUNCTION . ARGS). The user agent will apply +FUNCTION to ARGS, to insert the raw text of the original message. +\(The user agent will also run `mail-citation-hook', *after* the +original text has been inserted in this way.) + +SEND-ACTIONS is a list of actions to call when the message is sent. +Each action has the form (FUNCTION . ARGS)." + (interactive + (list nil nil nil current-prefix-arg)) + (let ((function (get mail-user-agent 'composefunc))) + (funcall function to subject other-headers continue + switch-function yank-action send-actions))) + +(defun compose-mail-other-window (&optional to subject other-headers continue + yank-action send-actions) + "Like \\[compose-mail], but edit the outgoing message in another window." + (interactive + (list nil nil nil current-prefix-arg)) + (compose-mail to subject other-headers continue + 'switch-to-buffer-other-window yank-action send-actions)) + + +(defun compose-mail-other-frame (&optional to subject other-headers continue + yank-action send-actions) + "Like \\[compose-mail], but edit the outgoing message in another frame." + (interactive + (list nil nil nil current-prefix-arg)) + (compose-mail to subject other-headers continue + 'switch-to-buffer-other-frame yank-action send-actions)) + + (defun set-variable (var val) "Set VARIABLE to VALUE. VALUE is a Lisp object. When using this interactively, supply a Lisp expression for VALUE. diff -r 2947057885e5 -r a2f645c6b9f8 lisp/psgml/ChangeLog --- a/lisp/psgml/ChangeLog Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/psgml/ChangeLog Mon Aug 13 09:59:05 2007 +0200 @@ -1,3 +1,12 @@ +1997-09-26 SL Baur + + * iso-sgml.el: Correct email address. + + * psgml-parse.el (sgml-compile-dtd): no-conversion -> binary + coding system. + (sgml-bdtd-merge): Ditto. + (sgml-push-to-entity): Ditto. + 1997-06-15 Steven L Baur * psgml-parse.el (sgml-parse-chars): De-ebolify. diff -r 2947057885e5 -r a2f645c6b9f8 lisp/psgml/custom-load.el --- a/lisp/psgml/custom-load.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/psgml/custom-load.el Mon Aug 13 09:59:05 2007 +0200 @@ -1,3 +1,9 @@ +;;; custom-load.el --- automatically extracted custom dependencies + +;; Created by SL Baur on Sat Sep 27 08:14:15 1997 + +;;; Code: + (custom-put 'extensions 'custom-loads '("tempo")) (custom-put 'psgml-dtd 'custom-loads '("psgml")) (custom-put 'html 'custom-loads '("psgml-html")) @@ -7,3 +13,5 @@ (custom-put 'tempo 'custom-loads '("tempo")) (custom-put 'languages 'custom-loads '("psgml")) (custom-put 'psgml-insert 'custom-loads '("psgml")) + +;;; custom-load.el ends here diff -r 2947057885e5 -r a2f645c6b9f8 lisp/psgml/iso-sgml.el --- a/lisp/psgml/iso-sgml.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/psgml/iso-sgml.el Mon Aug 13 09:59:05 2007 +0200 @@ -16,7 +16,7 @@ ;; Edit SGML or HTML buffers with ISO 8859-1 (Latin-1) display| ;; 10-May-1995|1.4|~/misc/iso-sgml.el.Z| -;; $Id: iso-sgml.el,v 1.1.1.1 1996/12/18 22:43:36 steve Exp $ +;; $Id: iso-sgml.el,v 1.2 1997/09/27 16:57:46 steve Exp $ ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -38,7 +38,7 @@ ;; iso-sgml.el transparently displays entity references in SGML or HTML ;; buffers as ISO 8859-1 (aka Latin-1) characters. ;; Modified for XEmacs 19.15 to include the proposed extensions to Latin-1 -;; by Steve Baur +;; by Steve Baur ;; SEE ALSO: ;; iso-cvt.el @@ -56,7 +56,7 @@ ;; Code: -(defconst isosgml-version "$Id: iso-sgml.el,v 1.1.1.1 1996/12/18 22:43:36 steve Exp $" +(defconst isosgml-version "$Id: iso-sgml.el,v 1.2 1997/09/27 16:57:46 steve Exp $" "iso-sgml RCS version number") (defvar isosgml-modes-list '(html-mode html-helper-mode sgml-mode) @@ -228,8 +228,8 @@ ;; iso-sgml.el ends here ; $Log: iso-sgml.el,v $ -; Revision 1.1.1.1 1996/12/18 22:43:36 steve -; XEmacs 20.0 -- Beta 30 +; Revision 1.2 1997/09/27 16:57:46 steve +; Patches to beta24 ; ; Revision 1.4 1995/05/10 06:19:41 lepied ; * protect code with unwind-protect to prevent errors diff -r 2947057885e5 -r a2f645c6b9f8 lisp/psgml/psgml-parse.el --- a/lisp/psgml/psgml-parse.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/psgml/psgml-parse.el Mon Aug 13 09:59:05 2007 +0200 @@ -1,5 +1,5 @@ ;;;; psgml-parse.el --- Parser for SGML-editing mode with parsing support -;; $Id: psgml-parse.el,v 1.7 1997/06/21 20:03:09 steve Exp $ +;; $Id: psgml-parse.el,v 1.8 1997/09/27 16:57:47 steve Exp $ ;; Copyright (C) 1994, 1995 Lennart Staflin @@ -1206,7 +1206,7 @@ (sgml-pop-entity) (erase-buffer) ;; For XEmacs-20.0/Mule - (setq buffer-file-coding-system 'no-conversion) + (setq buffer-file-coding-system 'binary) (sgml-write-dtd sgml-dtd-info to-file) t)) @@ -1234,7 +1234,7 @@ "Merge the binary coded dtd in the current buffer with the current dtd. The current dtd is the variable sgml-dtd-info. Return t if mereged was successfull or nil if failed." - (setq buffer-file-coding-system 'no-conversion) + (setq buffer-file-coding-system 'binary) (goto-char (point-min)) (sgml-read-sexp) ; skip filev (let ((dependencies (sgml-read-sexp)) @@ -2368,7 +2368,7 @@ ;; (reported by Jeffrey Friedl ) (setq mc-flag nil) ;; For XEmacs 20.0/Mule - (setq buffer-file-coding-system 'no-conversion) + (setq buffer-file-coding-system 'binary) (when (eq sgml-scratch-buffer (default-value 'sgml-scratch-buffer)) (make-local-variable 'sgml-scratch-buffer) (setq sgml-scratch-buffer nil)) diff -r 2947057885e5 -r a2f645c6b9f8 lisp/tm/tm-mh-e.el --- a/lisp/tm/tm-mh-e.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/tm/tm-mh-e.el Mon Aug 13 09:59:05 2007 +0200 @@ -6,7 +6,7 @@ ;; OKABE Yasuo ;; Maintainer: MORIOKA Tomohiko ;; Created: 1993/11/21 (obsolete mh-e-mime.el) -;; Version: $Revision: 1.2 $ +;; Version: $Revision: 1.3 $ ;; Keywords: mail, MH, MIME, multimedia, encoded-word, multilingual ;; This file is part of tm (Tools for MIME). @@ -48,7 +48,7 @@ ;;; (defconst tm-mh-e/RCS-ID - "$Id: tm-mh-e.el,v 1.2 1997/07/19 22:11:28 steve Exp $") + "$Id: tm-mh-e.el,v 1.3 1997/09/27 16:57:47 steve Exp $") (defconst tm-mh-e/version (get-version-string tm-mh-e/RCS-ID)) @@ -73,13 +73,14 @@ ;; Display message NUMBER of FOLDER. ;; Sets the current buffer to the show buffer. (set-buffer folder) + (or show-buffer + (setq show-buffer mh-show-buffer)) ;; Bind variables in folder buffer in case they are local (let ((formfile mhl-formfile) (clean-message-header mh-clean-message-header) (invisible-headers mh-invisible-headers) (visible-headers mh-visible-headers) (msg-filename (mh-msg-filename msg-num)) - (show-buffer mh-show-buffer) ) (if (not (file-exists-p msg-filename)) (error "Message %d does not exist" msg-num)) diff -r 2947057885e5 -r a2f645c6b9f8 lisp/utils/auto-autoloads.el --- a/lisp/utils/auto-autoloads.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/utils/auto-autoloads.el Mon Aug 13 09:59:05 2007 +0200 @@ -150,7 +150,7 @@ (autoload 'update-file-autoloads "autoload" "\ Update the autoloads for FILE in `generated-autoload-file' \(which FILE might bind in its local variables). -This functions refuses to update autolaods files and custom loads." t nil) +This functions refuses to update autoloads files." t nil) (autoload 'update-autoloads-here "autoload" "\ Update sections of the current buffer generated by `update-file-autoloads'." t nil) @@ -166,13 +166,13 @@ on directories. Must be used only with -batch, and kills Emacs on completion. Each file will be processed even if an error occurred previously. For example, invoke `xemacs -batch -f batch-update-autoloads *.el'. -The directory to which the auto-autoloads.el and custom-load.el files must -be the first parameter on the command line." nil nil) +The directory to which the auto-autoloads.el file must be the first parameter +on the command line." nil nil) (autoload 'batch-update-directory "autoload" "\ Update the autoloads for the directory on the command line. -Runs `update-file-autoloads' on each file in the given directory, and must -be used only with -batch, and kills XEmacs on completion." nil nil) +Runs `update-file-autoloads' on each file in the given directory, must +be used only with -batch and kills XEmacs on completion." nil nil) ;;;*** @@ -598,7 +598,10 @@ ;;;*** -;;;### (autoloads (id-select-double-click-hook id-select-and-kill-thing id-select-and-copy-thing id-select-goto-matching-tag id-select-thing-with-mouse id-select-thing) "id-select" "utils/id-select.el") +;;;### (autoloads (id-select-double-click-hook id-select-and-kill-thing id-select-and-copy-thing id-select-goto-matching-tag id-select-thing-with-mouse id-select-thing id-select-install) "id-select" "utils/id-select.el") + +(autoload 'id-select-install "id-select" "\ +Install the id-select mode as the default mode of operation." t nil) (autoload 'id-select-thing "id-select" "\ Mark the region selected by the syntax of the thing at point. diff -r 2947057885e5 -r a2f645c6b9f8 lisp/utils/autoload.el --- a/lisp/utils/autoload.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/utils/autoload.el Mon Aug 13 09:59:05 2007 +0200 @@ -33,6 +33,10 @@ ;; lisp source files in various useful ways. To learn more, read the ;; source; if you're going to use this, you'd better be able to. +;; ChangeLog: + +;; Sep-26-1997: slb removed code dealing with customization. + ;;; Code: (defun make-autoload (form file) @@ -295,11 +299,9 @@ (forward-line 1))) (if dofiles (setq funlist (cdr funlist))))))) - ;;(unless visited + (unless visited ;; We created this buffer, so we should kill it. - ;; Customize needs it later, we don't want to read the file - ;; in twice. - ;;(kill-buffer (current-buffer))) + (kill-buffer (current-buffer))) (set-buffer outbuf) (setq output-end (point-marker)))) (if t ;; done-any @@ -353,51 +355,17 @@ "Generic filename ot put custom loads into. Unless you are an XEmacs maintainr, it is probably unwise to change this.") -(defvar generated-custom-file - (expand-file-name (concat autoload-target-directory - cusload-file-name) - data-directory) - "*File `update-file-autoloads' puts customization into.") - -(defvar customized-symbols (make-hash-table :test 'eq)) - -;; Written by Per Abrahamsen -(defun autoload-snarf-defcustom (file) - "Snarf all customizations in the current buffer." - (let ((visited (get-file-buffer file))) - (save-excursion - (set-buffer (or visited (find-file-noselect file))) - (when (and file - (string-match "\\`\\(.*\\)\\.el\\'" file) - (not (buffer-modified-p))) - (goto-char (point-min)) - (let ((name (file-name-nondirectory (match-string 1 file)))) - (condition-case nil - (while (re-search-forward - "^(defcustom\\|^(defface\\|^(defgroup" - nil t) - (beginning-of-line) - (let ((expr (read (current-buffer)))) - (eval expr) - (setf (gethash (nth 1 expr) customized-symbols) name))) - (error nil)))) - (unless (buffer-modified-p) - (kill-buffer (current-buffer)))))) - -(defvar autoload-do-custom-save nil) - ;;;###autoload (defun update-file-autoloads (file) "Update the autoloads for FILE in `generated-autoload-file' \(which FILE might bind in its local variables). -This functions refuses to update autolaods files and custom loads." +This functions refuses to update autoloads files." (interactive "fUpdate autoloads for file: ") (setq file (expand-file-name file)) (when (and (file-newer-than-file-p file generated-autoload-file) (not (member (file-name-nondirectory file) - (list autoload-file-name cusload-file-name)))) + (list autoload-file-name)))) - (setq autoload-do-custom-save t) (let ((load-name (replace-in-string (file-name-nondirectory file) "\\.elc?$" "")) @@ -430,8 +398,7 @@ (goto-char (point-max)))) ; Append. ;; Add in new sections for file - (generate-file-autoloads file) - (autoload-snarf-defcustom file)) + (generate-file-autoloads file)) (when (interactive-p) (save-buffer))))) @@ -491,7 +458,6 @@ This runs `update-file-autoloads' on each .el file in DIR. Obsolete autoload entries for files that no longer exist are deleted." (interactive "DUpdate autoloads for directory: ") - (setq autoload-do-custom-save nil) (setq dir (expand-file-name dir)) (let ((simple-dir (file-name-as-directory (file-name-nondirectory @@ -520,36 +486,6 @@ (unless noninteractive (save-buffer))))) -;; Based on code from Per Abrahamsen -(defun autoload-save-customization () - (save-excursion - (set-buffer (find-file-noselect generated-custom-file)) - (erase-buffer) - (insert - (with-output-to-string - (mapatoms (lambda (sym) - (let ((members (get sym 'custom-group)) - item where found) - (when members - (while members - (setq item (car (car members)) - members (cdr members) - where (gethash item customized-symbols)) - (unless (or (null where) - (member where found)) - (if found - (insert " ") -;;; (insert "(custom-add-loads '" (symbol-name sym) - (insert "(custom-put '" (symbol-name sym) - " 'custom-loads '(")) - (prin1 where (current-buffer)) - (push where found))) - (when found - (insert "))\n")))))) -)) - (when (= (point-min) (point-max)) - (set-buffer-modified-p nil)))) - ;;;###autoload (defun batch-update-autoloads () "Update the autoloads for the files or directories on the command line. @@ -557,18 +493,12 @@ on directories. Must be used only with -batch, and kills Emacs on completion. Each file will be processed even if an error occurred previously. For example, invoke `xemacs -batch -f batch-update-autoloads *.el'. -The directory to which the auto-autoloads.el and custom-load.el files must -be the first parameter on the command line." +The directory to which the auto-autoloads.el file must be the first parameter +on the command line." (unless noninteractive (error "batch-update-autoloads is to be used only with -batch")) (let ((defdir default-directory) (enable-local-eval nil)) ; Don't query in batch mode. - (when (file-exists-p generated-custom-file) - (flet ((custom-put (symbol property value) - (progn - (put symbol property value) - (setf (gethash symbol customized-symbols) value)))) - (load generated-custom-file nil t))) ;; (message "Updating autoloads in %s..." generated-autoload-file) (dolist (arg command-line-args-left) (setq arg (expand-file-name arg defdir)) @@ -579,9 +509,6 @@ ((file-exists-p arg) (update-file-autoloads arg)) (t (error "No such file or directory: %s" arg)))) - (when autoload-do-custom-save - (autoload-save-customization) - (clrhash customized-symbols)) (fixup-autoload-buffer (concat (if autoload-package-name autoload-package-name (file-name-nondirectory defdir)) @@ -608,34 +535,20 @@ ;;;###autoload (defun batch-update-directory () "Update the autoloads for the directory on the command line. -Runs `update-file-autoloads' on each file in the given directory, and must -be used only with -batch, and kills XEmacs on completion." +Runs `update-file-autoloads' on each file in the given directory, must +be used only with -batch and kills XEmacs on completion." (unless noninteractive (error "batch-update-directory is to be used only with -batch")) (let ((defdir default-directory) (enable-local-eval nil)) ; Don't query in batch mode. (dolist (arg command-line-args-left) (setq arg (expand-file-name arg defdir)) - (let ((generated-autoload-file (concat arg "/" autoload-file-name)) - (generated-custom-file (concat arg "/" cusload-file-name))) - (when (file-exists-p generated-custom-file) - (flet ((custom-put (symbol property value) - (progn - (put symbol property value) - ;; (message "Loading %s = %s" - ;; (symbol-name symbol) - ;; (prin1-to-string value)) - (setf (gethash symbol customized-symbols) - value)))) - (load generated-custom-file nil t))) + (let ((generated-autoload-file (concat arg "/" autoload-file-name))) (cond ((file-directory-p arg) - (message "Updating autoloads/custom in directory %s..." arg) + (message "Updating autoloads in directory %s..." arg) (update-autoloads-from-directory arg)) (t (error "No such file or directory: %s" arg))) - (when autoload-do-custom-save - (autoload-save-customization) - (clrhash customized-symbols)) (fixup-autoload-buffer (concat (if autoload-package-name autoload-package-name (file-name-nondirectory arg)) diff -r 2947057885e5 -r a2f645c6b9f8 lisp/utils/custom-load.el --- a/lisp/utils/custom-load.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/utils/custom-load.el Mon Aug 13 09:59:05 2007 +0200 @@ -1,8 +1,14 @@ +;;; custom-load.el --- automatically extracted custom dependencies + +;; Created by SL Baur on Sat Sep 27 08:14:20 1997 + +;;; Code: + (custom-put 'extensions 'custom-loads '("eldoc")) (custom-put 'eldoc 'custom-loads '("eldoc")) +(custom-put 'mouse 'custom-loads '("id-select")) (custom-put 'minibuffer 'custom-loads '("detached-minibuf" "savehist")) -(custom-put 'environment 'custom-loads '(("detached-minibuf") ("detached-minibuf" "savehist"))) -(custom-put 'mail 'custom-loads '("highlight-headers" "ph" "smtpmail")) +(custom-put 'mail 'custom-loads '("highlight-headers" "mail-extr" "ph" "smtpmail")) (custom-put 'uniquify 'custom-loads '("uniquify")) (custom-put 'hypermedia 'custom-loads '("browse-url")) (custom-put 'lisp 'custom-loads '("elp")) @@ -26,3 +32,7 @@ (custom-put 'highlight-headers 'custom-loads '("highlight-headers")) (custom-put 'savehist 'custom-loads '("savehist")) (custom-put 'ph 'custom-loads '("ph")) +(custom-put 'mail-extr 'custom-loads '("mail-extr")) +(custom-put 'matching 'custom-loads '("id-select")) + +;;; custom-load.el ends here diff -r 2947057885e5 -r a2f645c6b9f8 lisp/utils/finder-inf.el --- a/lisp/utils/finder-inf.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/utils/finder-inf.el Mon Aug 13 09:59:05 2007 +0200 @@ -6,6 +6,58 @@ ;;; Code: (setq finder-package-info '( + ("find-function.el" + "find the definition of the elisp function near point" + (emacs-lisp help functions) + "/home/steve/.xemacs/lisp/stuff/") + ("skk-auto.el" + "$BAw$j2>L>$N<+F0=hM}$N$?$a$N%W%m%0%i%`(B" + (japanese) + "/usr/local/lib/xemacs/packages/lisp/skk/") + ("skk-comp.el" + "$BJd40$N$?$a$N%W%m%0%i%`(B" + (japanese) + "/usr/local/lib/xemacs/packages/lisp/skk/") + ("skk-foreword.el" + "$BA0=q$-(B" + (japanese) + "/usr/local/lib/xemacs/packages/lisp/skk/") + ("skk-gadget.el" + "$B -;; Maintainer: Jamie Zawinski +;; Maintainer: XEmacs Development Team ;; Version: 1.8 ;; Keywords: mail @@ -211,34 +211,50 @@ ;; User configuration variable definitions. ;; -(defvar mail-extr-guess-middle-initial nil +(defgroup mail-extr nil + "Extract full name and address from RFC 822 mail header." + :group 'mail) + + +(defcustom mail-extr-guess-middle-initial nil "*Whether to try to guess middle initial from mail address. If true, then when we see an address like \"John Smith \" -we will assume that \"John Q. Smith\" is the fellow's name.") +we will assume that \"John Q. Smith\" is the fellow's name." + :type 'boolean + :group 'mail-extr) -(defvar mail-extr-ignore-single-names t +(defcustom mail-extr-ignore-single-names t "*Whether to ignore a name that is just a single word. If true, then when we see an address like \"Idiot \" -we will act as though we couldn't find a full name in the address.") +we will act as though we couldn't find a full name in the address." + :type 'boolean + :group 'mail-extr) ;; Matches a leading title that is not part of the name (does not ;; contribute to uniquely identifying the person). -(defvar mail-extr-full-name-prefixes - (purecopy - "\\(Prof\\|D[Rr]\\|Mrs?\\|Rev\\|Rabbi\\|SysOp\\|LCDR\\)\\.?[ \t\n]") +(defcustom mail-extr-full-name-prefixes + "\\(Prof\\|D[Rr]\\|Mrs?\\|Rev\\|Rabbi\\|SysOp\\|LCDR\\)\\.?[ \t\n]" "*Matches prefixes to the full name that identify a person's position. These are stripped from the full name because they do not contribute to -uniquely identifying the person.") +uniquely identifying the person." + :type 'boolean + :group 'mail-extr) -(defvar mail-extr-@-binds-tighter-than-! nil - "*Whether the local mail transport agent looks at ! before @.") +(defcustom mail-extr-@-binds-tighter-than-! nil + "*Whether the local mail transport agent looks at ! before @." + :type 'boolean + :group 'mail-extr) -(defvar mail-extr-mangle-uucp nil +(defcustom mail-extr-mangle-uucp nil "*Whether to throw away information in UUCP addresses -by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\".") +by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"." + :type 'boolean + :group 'mail-extr) -(defvar mail-extr-mailbox-match-case-fold t - "*Non-nil if mailbox and name matching should ignore case.") +(defcustom mail-extr-mailbox-match-case-fold t + "*Non-nil if mailbox and name matching should ignore case." + :type 'boolean + :group 'mail-extr) ;;---------------------------------------------------------------------- ;; what orderings are meaningful????? @@ -701,9 +717,6 @@ (while t (signal (car error) (cdr error)))))))) -(or (fboundp 'buffer-disable-undo) ;; v18 compat - (fset 'buffer-disable-undo 'buffer-flush-undo)) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; diff -r 2947057885e5 -r a2f645c6b9f8 lisp/utils/reporter.el --- a/lisp/utils/reporter.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/utils/reporter.el Mon Aug 13 09:59:05 2007 +0200 @@ -92,24 +92,6 @@ ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv ;; End user interface -;; XEmacs -- don't autoload -(defvar mail-user-agent 'sendmail-user-agent - "*Your preference for a mail composition package. -Various Emacs Lisp packages (e.g. reporter) require you to compose an -outgoing email message. As there are several such packages available -for Emacs, you can indicate your preference by setting this variable. - -Valid values currently are: - - 'sendmail-user-agent -- use Emacs built-in Mail package - 'vm-user-agent -- use Kyle Jones' VM package - 'mh-e-user-agent -- use the Emacs interface to the MH mail system - -Additional valid symbols may be available; check with the author of -your package for details.") - - - ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv ;; Package author interface variables @@ -469,47 +451,6 @@ ))) -;; paradigm definitions -(defun define-mail-user-agent (symbol composefunc sendfunc - &optional abortfunc hookvar) - "Define a symbol appropriate for `mail-user-agent'. -SYMBOL can be any meaningful lisp symbol. It need not have a function -or variable definition, as it is only used for its property list. -The property names are equivalent to the formal argument described -below (but in lower case). Additional properties can be placed on the -symbol. - -COMPOSEFUNC is program callable function that composes an outgoing -mail message buffer. This function should set up the basics of the -buffer without requiring user interaction. It should populate the -standard mail headers, leaving the `to:' and `subject:' headers blank. - -SENDFUNC is the command a user would type to send the message. - -Optional ABORTFUNC is the command a user would type to abort the -message. For mail packages that don't have a separate abort function, -this can be `kill-buffer' (the equivalent of omitting this argument). - -Optional HOOKVAR is a hook variable that gets run before the message -is actually sent. Reporter will install `reporter-bug-hook' onto this -hook so that empty bug reports can be suppressed by raising an error. -If not supplied, `mail-send-hook' will be used." - (put symbol 'composefunc composefunc) - (put symbol 'sendfunc sendfunc) - (put symbol 'abortfunc (or abortfunc 'kill-buffer)) - (put symbol 'hookvar (or hookvar 'mail-send-hook))) - -(define-mail-user-agent 'sendmail-user-agent - 'reporter-mail 'mail-send-and-exit) - -(define-mail-user-agent 'vm-user-agent - 'vm-mail 'vm-mail-send-and-exit) - -(define-mail-user-agent 'mh-e-user-agent - 'mh-smail-batch 'mh-send-letter 'mh-fully-kill-draft - 'mh-before-send-letter-hook) - - (provide 'reporter) ;;; reporter.el ends here diff -r 2947057885e5 -r a2f645c6b9f8 lisp/utils/shadow.el --- a/lisp/utils/shadow.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/utils/shadow.el Mon Aug 13 09:59:05 2007 +0200 @@ -123,8 +123,10 @@ ;; This file was seen before, we have a shadowing. (setq shadows (append shadows - (list (concat (cdr orig-dir) "/" file) - (concat dir "/" file)))) + (list (concat (file-name-as-directory (cdr orig-dir)) + file) + (concat (file-name-as-directory dir) + file)))) ;; Not seen before, add it to the list of seen files. (setq files (cons (cons file dir) files)))) diff -r 2947057885e5 -r a2f645c6b9f8 lisp/viper/custom-load.el --- a/lisp/viper/custom-load.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/viper/custom-load.el Mon Aug 13 09:59:05 2007 +0200 @@ -1,4 +1,12 @@ +;;; custom-load.el --- automatically extracted custom dependencies + +;; Created by SL Baur on Sat Sep 27 08:14:22 1997 + +;;; Code: + (custom-put 'viper-mouse 'custom-loads '("viper-mous")) (custom-put 'viper-ex 'custom-loads '("viper-ex")) (custom-put 'emulations 'custom-loads '("viper")) (custom-put 'viper 'custom-loads '("viper-cmd" "viper-ex" "viper-init" "viper-keym" "viper-macs" "viper-mous" "viper")) + +;;; custom-load.el ends here diff -r 2947057885e5 -r a2f645c6b9f8 lisp/w3/custom-load.el --- a/lisp/w3/custom-load.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/w3/custom-load.el Mon Aug 13 09:59:05 2007 +0200 @@ -1,3 +1,9 @@ +;;; custom-load.el --- automatically extracted custom dependencies + +;; Created by SL Baur on Sat Sep 27 08:14:25 1997 + +;;; Code: + (custom-put 'url 'custom-loads '("url-gw" "url-irc" "url-news" "url-vars" "url")) (custom-put 'ssl 'custom-loads '("ssl")) (custom-put 'url-cookie 'custom-loads '("url-cookie" "url-vars")) @@ -22,3 +28,5 @@ (custom-put 'w3-parsing 'custom-loads '("w3-cus")) (custom-put 'i18n 'custom-loads '("url-vars")) (custom-put 'w3-scripting 'custom-loads '("w3-script")) + +;;; custom-load.el ends here diff -r 2947057885e5 -r a2f645c6b9f8 lisp/x11/auto-autoloads.el --- a/lisp/x11/auto-autoloads.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/x11/auto-autoloads.el Mon Aug 13 09:59:05 2007 +0200 @@ -1,14 +1,13 @@ ;;; DO NOT MODIFY THIS FILE (if (featurep 'x11-autoloads) (error "Already loaded")) + +(provide 'x11-autoloads) ;;;### (autoloads (font-menu-weight-constructor font-menu-size-constructor font-menu-family-constructor reset-device-font-menus) "x-font-menu" "x11/x-font-menu.el") -(defvar font-menu-ignore-scaled-fonts t "\ -*If non-nil, then the font menu will try to show only bitmap fonts.") +(defcustom font-menu-ignore-scaled-fonts t "*If non-nil, then the font menu will try to show only bitmap fonts." :type 'boolean :group 'x) -(defvar font-menu-this-frame-only-p nil "\ -*If non-nil, then changing the default font from the font menu will only -affect one frame instead of all frames.") +(defcustom font-menu-this-frame-only-p nil "*If non-nil, then changing the default font from the font menu will only\naffect one frame instead of all frames." :type 'boolean :group 'x) (fset 'install-font-menus 'reset-device-font-menus) @@ -27,5 +26,3 @@ (autoload 'font-menu-weight-constructor "x-font-menu" nil nil nil) ;;;*** - -(provide 'x11-autoloads) diff -r 2947057885e5 -r a2f645c6b9f8 lisp/x11/custom-load.el --- a/lisp/x11/custom-load.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/x11/custom-load.el Mon Aug 13 09:59:05 2007 +0200 @@ -1,2 +1,14 @@ +;;; custom-load.el --- automatically extracted custom dependencies + +;; Created by SL Baur on Sat Sep 27 08:14:26 1997 + +;;; Code: + +(custom-put 'menu 'custom-loads '("x-menubar")) (custom-put 'environment 'custom-loads '("x-toolbar")) +(custom-put 'buffers-menu 'custom-loads '("x-menubar")) (custom-put 'toolbar 'custom-loads '("x-toolbar")) +(custom-put 'info 'custom-loads '("x-toolbar")) +(custom-put 'x 'custom-loads '("x-font-menu")) + +;;; custom-load.el ends here diff -r 2947057885e5 -r a2f645c6b9f8 lisp/x11/x-font-menu.el --- a/lisp/x11/x-font-menu.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/x11/x-font-menu.el Mon Aug 13 09:59:05 2007 +0200 @@ -131,13 +131,17 @@ ;;; "*If non-nil, then the font menu will only show fixed-width fonts.") ;;;###autoload -(defvar font-menu-ignore-scaled-fonts t - "*If non-nil, then the font menu will try to show only bitmap fonts.") +(defcustom font-menu-ignore-scaled-fonts t + "*If non-nil, then the font menu will try to show only bitmap fonts." + :type 'boolean + :group 'x) ;;;###autoload -(defvar font-menu-this-frame-only-p nil +(defcustom font-menu-this-frame-only-p nil "*If non-nil, then changing the default font from the font menu will only -affect one frame instead of all frames.") +affect one frame instead of all frames." + :type 'boolean + :group 'x) ;; only call XListFonts (and parse) once per device. ;; ( (device . [parsed-list-fonts family-menu size-menu weight-menu]) ...) diff -r 2947057885e5 -r a2f645c6b9f8 lisp/x11/x-menubar.el --- a/lisp/x11/x-menubar.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/x11/x-menubar.el Mon Aug 13 09:59:05 2007 +0200 @@ -862,50 +862,75 @@ ;;; The Buffers menu -(defvar buffers-menu-max-size 25 +(defgroup buffers-menu nil + "Customization of `Buffers' menu." + :group 'menu) + +(defcustom buffers-menu-max-size 25 "*Maximum number of entries which may appear on the \"Buffers\" menu. If this is 10, then only the ten most-recently-selected buffers will be shown. If this is nil, then all buffers will be shown. Setting this to -a large number or nil will slow down menu responsiveness.") +a large number or nil will slow down menu responsiveness." + :type '(choice (const :tag "Show all" nil) + (integer 10)) + :group 'buffers-menu) -(defvar complex-buffers-menu-p nil - "*If true, the buffers menu will contain several commands, as submenus -of each buffer line. If this is false, then there will be only one command: -select that buffer.") +(defcustom complex-buffers-menu-p nil + "*If non-nil, the buffers menu will contain several commands. +Commands will be presented as submenus of each buffer line. If this +is false, then there will be only one command: select that buffer." + :type 'boolean + :group 'buffers-menu) -(defvar buffers-menu-submenus-for-groups-p nil - "*If true, the buffers menu will contain one submenu per group of buffers, -if a grouping function is specified in `buffers-menu-grouping-function'. +(defcustom buffers-menu-submenus-for-groups-p nil + "*If non-nil, the buffers menu will contain one submenu per group of buffers. +The grouping function is specified in `buffers-menu-grouping-function'. If this is an integer, do not build submenus if the number of buffers -is not larger than this value.") +is not larger than this value." + :type '(choice (const :tag "No Subgroups" nil) + (integer :tag "Max. submenus" 10) + (sexp :format "%t\n" :tag "Allow Subgroups")) + :group 'buffers-menu) -(defvar buffers-menu-switch-to-buffer-function 'switch-to-buffer +(defcustom buffers-menu-switch-to-buffer-function 'switch-to-buffer "*The function to call to select a buffer from the buffers menu. -`switch-to-buffer' is a good choice, as is `pop-to-buffer'.") +`switch-to-buffer' is a good choice, as is `pop-to-buffer'." + :type '(radio (function-item switch-to-buffer) + (function-item pop-to-buffer) + (function :tag "Other")) + :group 'buffers-menu) -(defvar buffers-menu-omit-function 'buffers-menu-omit-invisible-buffers -"*If non-nil, a function specifying the buffers to omit from the buffers menu. +(defcustom buffers-menu-omit-function 'buffers-menu-omit-invisible-buffers + "*If non-nil, a function specifying the buffers to omit from the buffers menu. This is passed a buffer and should return non-nil if the buffer should be omitted. The default value `buffers-menu-omit-invisible-buffers' omits buffers that are normally considered \"invisible\" (those whose name -begins with a space).") +begins with a space)." + :type '(choice (const :tag "None" nil) + function) + :group 'buffers-menu) -(defvar buffers-menu-format-buffer-line-function 'format-buffers-menu-line +(defcustom buffers-menu-format-buffer-line-function 'format-buffers-menu-line "*The function to call to return a string to represent a buffer in the buffers menu. The function is passed a buffer and should return a string. The default value `format-buffers-menu-line' just returns the name of the buffer. Also check out `slow-format-buffers-menu-line' which -returns a whole bunch of info about a buffer.") +returns a whole bunch of info about a buffer." + :type 'function + :group 'buffers-menu) -(defvar buffers-menu-sort-function +(defcustom buffers-menu-sort-function 'sort-buffers-menu-by-mode-then-alphabetically "*If non-nil, a function to sort the list of buffers in the buffers menu. It will be passed two arguments (two buffers to compare) and should return T if the first is \"less\" than the second. One possible value is `sort-buffers-menu-alphabetically'; another is -`sort-buffers-menu-by-mode-then-alphabetically'.") +`sort-buffers-menu-by-mode-then-alphabetically'." + :type '(choice (const :tag "None" nil) + function) + :group 'buffers-menu) -(defvar buffers-menu-grouping-function +(defcustom buffers-menu-grouping-function 'group-buffers-menu-by-mode-then-alphabetically "*If non-nil, a function to group buffers in the buffers menu together. It will be passed two arguments, successive members of the sorted buffers @@ -916,7 +941,10 @@ second argument, so that the name of the last group can be determined. The sensible values of this function are dependent on the value specified -for `buffers-menu-sort-function'.") +for `buffers-menu-sort-function'." + :type '(choice (const :tag "None" nil) + function) + :group 'buffers-menu) (defun buffers-menu-omit-invisible-buffers (buf) "For use as a value of `buffers-menu-omit-function'. diff -r 2947057885e5 -r a2f645c6b9f8 lisp/x11/x-toolbar.el --- a/lisp/x11/x-toolbar.el Mon Aug 13 09:58:32 2007 +0200 +++ b/lisp/x11/x-toolbar.el Mon Aug 13 09:59:05 2007 +0200 @@ -40,6 +40,22 @@ "Configure XEmacs Toolbar functions and properties" :group 'environment) + +(defun toolbar-not-configured-message () + (interactive) + (message "Toolbar item MUST be configured, first.")) + +(defcustom toolbar-item-not-configured-function 'toolbar-not-configured-message + "*Function to call when News or Mail are not configured yet." + :type '(radio (function-item toolbar-not-configured-message) + (function :tag "Other")) + :group 'toolbar) + +(defun toolbar-item-not-configured () + (interactive) + (call-interactively toolbar-item-not-configured-function)) + + (defcustom toolbar-open-function 'find-file "*Function to call when the open icon is selected." :type '(radio (function-item find-file) @@ -168,7 +184,8 @@ (apply 'call-process process nil 0 nil args)) (defcustom toolbar-mail-commands-alist - `((vm . vm) + `((item-not-configured . toolbar-item-not-configured) + (vm . vm) (gnus . gnus-no-server) (rmail . rmail) (mh . mh-rmail) @@ -183,13 +200,13 @@ :type '(repeat (cons (symbol :tag "Mailer") (function :tag "Start with"))) :group 'toolbar) -(defcustom toolbar-mail-reader 'vm +(defcustom toolbar-mail-reader 'item-not-configured "*Mail reader toolbar will invoke. The legal values are the keys from `toolbar-mail-command-alist', which should be used to add new mail readers. -Mail readers known by default are vm, gnus, rmail, mh, pine, elm, mutt, -exmh and netscape." +Mail readers known by default are item-not-configured, vm, gnus, +rmail, mh, pine, elm, mutt, exmh and netscape." :type '(symbol :validate (lambda (wid) (if (assq (widget-value wid) toolbar-mail-commands-alist) nil @@ -213,13 +230,23 @@ (defvar toolbar-info-frame nil "The frame in which info is displayed.") +(defcustom Info-frame-plist + (append (list 'width 80) + (let ((h (plist-get default-frame-plist 'height))) + (when h (list 'height h)))) + "Frame plist for the Info frame." + :type '(repeat (group :inline t + (symbol :tag "Property") + (sexp :tag "Value"))) + :group 'info) + (defun toolbar-info () "Run info in a separate frame." (interactive) (if (or (not toolbar-info-frame) (not (frame-live-p toolbar-info-frame))) (progn - (setq toolbar-info-frame (make-frame)) + (setq toolbar-info-frame (make-frame Info-frame-plist)) (select-frame toolbar-info-frame) (raise-frame toolbar-info-frame))) (if (frame-iconified-p toolbar-info-frame) @@ -258,7 +285,8 @@ ;; (defcustom toolbar-news-commands-alist - `((gnus . gnus) ; M-x all-hail-gnus + `((item-not-configured . toolbar-item-not-configured) + (gnus . toolbar-gnus) ; M-x all-hail-gnus (rn . (toolbar-external "xterm" "-e" "rn")) (nn . (toolbar-external "xterm" "-e" "nn")) (trn . (toolbar-external "xterm" "-e" "trn")) @@ -273,13 +301,13 @@ :type '(repeat (cons (symbol :tag "Reader") (sexp :tag "Start with"))) :group 'toolbar) -(defcustom toolbar-news-reader 'gnus +(defcustom toolbar-news-reader 'item-not-configured "*News reader toolbar will invoke. The legal values are the keys from `toolbar-news-command-alist', which should be used to add new news readers. -Newsreaders known by default are gnus, rn, nn, trn, xrn, slrn, pine and -netscape." +Newsreaders known by default are item-not-configured, gnus, rn, nn, +trn, xrn, slrn, pine and netscape." :type '(symbol :validate (lambda (wid) (if (assq (widget-value wid) toolbar-news-commands-alist) nil @@ -298,7 +326,7 @@ (defvar toolbar-news-frame-properties nil "The properties of the frame in which news is displayed.") -(defun toolbar-news () +(defun toolbar-gnus () "Run Gnus in a separate frame." (interactive) (when (or (not toolbar-news-frame) @@ -318,6 +346,14 @@ (select-frame toolbar-news-frame) (raise-frame toolbar-news-frame)) +(defun toolbar-news () + "Run News (in a separate frame??)." + (interactive) + (let ((command (assq toolbar-news-reader toolbar-news-commands-alist))) + (if (not command) + (error "Unknown news reader %s" toolbar-news-reader)) + (funcall (cdr command)))) + (defvar toolbar-last-win-icon nil "A `last-win' icon set.") (defvar toolbar-next-win-icon nil "A `next-win' icon set.") (defvar toolbar-file-icon nil "A `file' icon set.") @@ -412,11 +448,11 @@ [toolbar-undo-icon toolbar-undo t "Undo edit"] [toolbar-spell-icon toolbar-ispell t "Spellcheck"] [toolbar-replace-icon toolbar-replace t "Replace text"] - ;; [toolbar-mail-icon toolbar-mail t "Mail"] + [toolbar-mail-icon toolbar-mail t "Mail"] [toolbar-info-icon toolbar-info t "Information"] [toolbar-compile-icon toolbar-compile t "Compile"] [toolbar-debug-icon toolbar-debug t "Debug"] - ;; [toolbar-news-icon toolbar-news t "News"] + [toolbar-news-icon toolbar-news t "News"] ) "The initial toolbar for a buffer.") diff -r 2947057885e5 -r a2f645c6b9f8 lwlib/xlwmenu.c --- a/lwlib/xlwmenu.c Mon Aug 13 09:58:32 2007 +0200 +++ b/lwlib/xlwmenu.c Mon Aug 13 09:59:05 2007 +0200 @@ -431,20 +431,8 @@ return width; #else # ifdef USE_XFONTSET - int i, s=0, w=0; - for (i=0; string[i]; ++i) { - if (string[i]=='%' && string[i+1]=='_') { - XmbTextExtents(mw->menu.font_set, &string[s], i-s, &ri, &rl); - w += rl.width; - s = i + 2; - ++i; - } - } - if (string[s]) { - XmbTextExtents(mw->menu.font_set, &string[s], i-s, &ri, &rl); - w += rl.width; - } - return w; + XmbTextExtents(mw->menu.font_set, newchars, j, &ri, &rl); + return rl.width; # else /* ! USE_XFONTSET */ XTextExtents (mw->menu.font, newchars, j, &drop, &drop, &drop, &xcs); return xcs.width; @@ -837,11 +825,9 @@ return 0; XmbDrawString ( XtDisplay (mw), window, mw->menu.font_set, gc, - x, y + mw->menu.font_ascent, &string[start], i-s - ); + x, y + mw->menu.font_ascent, &string[start], end - start); XmbTextExtents ( - mw->menu.font_set, &string[start], end - start, &ri, &rl - ); + mw->menu.font_set, &string[start], end - start, &ri, &rl); return rl.width; # else XCharStruct xcs; diff -r 2947057885e5 -r a2f645c6b9f8 man/ChangeLog --- a/man/ChangeLog Mon Aug 13 09:58:32 2007 +0200 +++ b/man/ChangeLog Mon Aug 13 09:59:05 2007 +0200 @@ -1,3 +1,9 @@ +1997-09-23 Hrvoje Niksic + + * xemacs/custom.texi (Easy Customization): Ditto. + + * xemacs/xemacs.texi (Top): Added pointer to easy customization. + 1997-09-18 SL Baur * internals/Makefile (../../info/$(NAME).info): Warn and clean up diff -r 2947057885e5 -r a2f645c6b9f8 man/internals/internals.texi --- a/man/internals/internals.texi Mon Aug 13 09:58:32 2007 +0200 +++ b/man/internals/internals.texi Mon Aug 13 09:59:05 2007 +0200 @@ -590,6 +590,8 @@ @itemize @bullet @item version 20.1 released September 17, 1997. +@item +version 20.2 released September 20, 1997. @end itemize @node XEmacs diff -r 2947057885e5 -r a2f645c6b9f8 man/xemacs/custom.texi --- a/man/xemacs/custom.texi Mon Aug 13 09:58:32 2007 +0200 +++ b/man/xemacs/custom.texi Mon Aug 13 09:59:05 2007 +0200 @@ -108,6 +108,7 @@ @menu * Examining:: Examining or setting one variable's value. +* Easy Customization:: Convenient and easy customization of variables. * Edit Options:: Examining or editing list of all variables' values. * Locals:: Per-buffer values of variables. * File Variables:: How files can specify variable values. @@ -171,6 +172,376 @@ Setting variables in this way, like all means of customizing Emacs except where explicitly stated, affects only the current Emacs session. +@node Easy Customization +@subsection Easy Customization Interface + +@findex customize +@cindex customization buffer + A convenient way to find the user option variables that you want to +change, and then change them, is with @kbd{M-x customize}. This command +creates a @dfn{customization buffer} with which you can browse through +the Emacs user options in a logically organized structure, then edit and +set their values. You can also use the customization buffer to save +settings permanently. (Not all Emacs user options are included in this +structure as of yet, but we are adding the rest.) + +@menu +* Groups: Customization Groups. + How options are classified in a structure. +* Changing an Option:: How to edit a value and set an option. +* Face Customization:: How to edit the attributes of a face. +* Specific Customization:: Making a customization buffer for specific + options, faces, or groups. +@end menu + +@node Customization Groups +@subsubsection Customization Groups +@cindex customization groups + + For customization purposes, user options are organized into +@dfn{groups} to help you find them. Groups are collected into bigger +groups, all the way up to a master group called @code{Emacs}. + + @kbd{M-x customize} creates a customization buffer that shows the +top-level @code{Emacs} group and the second-level groups immediately +under it. It looks like this, in part: + +@smallexample +/- Emacs group: ---------------------------------------------------\ + [State]: visible group members are all at standard settings. + Customization of the One True Editor. + See also [Manual]. + +Editing group: [Go to Group] +Basic text editing facilities. + +External group: [Go to Group] +Interfacing to external utilities. + +@var{more second-level groups} + +\- Emacs group end ------------------------------------------------/ + +@end smallexample + +@noindent +This says that the buffer displays the contents of the @code{Emacs} +group. The other groups are listed because they are its contents. But +they are listed differently, without indentation and dashes, because +@emph{their} contents are not included. Each group has a single-line +documentation string; the @code{Emacs} group also has a @samp{[State]} +line. + +@cindex editable fields (customization buffer) +@cindex active fields (customization buffer) + Most of the text in the customization buffer is read-only, but it +typically includes some @dfn{editable fields} that you can edit. There +are also @dfn{active fields}; this means a field that does something +when you @dfn{invoke} it. To invoke an active field, either click on it +with @kbd{Mouse-1}, or move point to it and type @key{RET}. + + For example, the phrase @samp{[Go to Group]} that appears in a +second-level group is an active field. Invoking the @samp{[Go to +Group]} field for a group creates a new customization buffer, which +shows that group and its contents. This field is a kind of hypertext +link to another group. + + The @code{Emacs} group does not include any user options itself, but +other groups do. By examining various groups, you will eventually find +the options and faces that belong to the feature you are interested in +customizing. Then you can use the customization buffer to set them. + +@findex customize-browse + You can view the structure of customization groups on a larger scale +with @kbd{M-x customize-browse}. This command creates a special kind of +customization buffer which shows only the names of the groups (and +options and faces), and their structure. + + In this buffer, you can show the contents of a group by invoking +@samp{[+]}. When the group contents are visible, this button changes to +@samp{[-]}; invoking that hides the group contents. + + Each group, option or face name in this buffer has an active field +which says @samp{[Group]}, @samp{[Option]} or @samp{[Face]}. Invoking +that active field creates an ordinary customization buffer showing just +that group and its contents, just that option, or just that face. +This is the way to set values in it. + +@node Changing an Option +@subsubsection Changing an Option + + Here is an example of what a user option looks like in the +customization buffer: + +@smallexample +Kill Ring Max: [Hide] 30 + [State]: this option is unchanged from its standard setting. +Maximum length of kill ring before oldest elements are thrown away. +@end smallexample + + The text following @samp{[Hide]}, @samp{30} in this case, indicates +the current value of the option. If you see @samp{[Show]} instead of +@samp{[Hide]}, it means that the value is hidden; the customization +buffer initially hides values that take up several lines. Invoke +@samp{[Show]} to show the value. + + The line after the option name indicates the @dfn{customization state} +of the option: in the example above, it says you have not changed the +option yet. The word @samp{[State]} at the beginning of this line is +active; you can get a menu of various operations by invoking it with +@kbd{Mouse-1} or @key{RET}. These operations are essential for +customizing the variable. + + The line after the @samp{[State]} line displays the beginning of the +option's documentation string. If there are more lines of +documentation, this line ends with @samp{[More]}; invoke this to show +the full documentation string. + + To enter a new value for @samp{Kill Ring Max}, move point to the value +and edit it textually. For example, you can type @kbd{M-d}, then insert +another number. + + When you begin to alter the text, you will see the @samp{[State]} line +change to say that you have edited the value: + +@smallexample +[State]: you have edited the value as text, but not set the option. +@end smallexample + +@cindex setting option value + Editing the value does not actually set the option variable. To do +that, you must @dfn{set} the option. To do this, invoke the word +@samp{[State]} and choose @samp{Set for Current Session}. + + The state of the option changes visibly when you set it: + +@smallexample +[State]: you have set this option, but not saved it for future sessions. +@end smallexample + + You don't have to worry about specifying a value that is not valid; +setting the option checks for validity and will not really install an +unacceptable value. + +@kindex M-TAB @r{(customization buffer)} +@findex widget-complete + While editing a value or field that is a file name, directory name, +command name, or anything else for which completion is defined, you can +type @kbd{M-@key{TAB}} (@code{widget-complete}) to do completion. + + Some options have a small fixed set of possible legitimate values. +These options don't let you edit the value textually. Instead, an +active field @samp{[Value Menu]} appears before the value; invoke this +field to edit the value. For a boolean ``on or off'' value, the active +field says @samp{[Toggle]}, and it changes to the other value. +@samp{[Value Menu]} and @samp{[Toggle]} edit the buffer; the changes +take effect when you use the @samp{Set for Current Session} operation. + + Some options have values with complex structure. For example, the +value of @code{load-path} is a list of directories. Here is how it +appears in the customization buffer: + +@smallexample +Load Path: +[INS] [DEL] [Current dir?]: /usr/local/share/emacs/19.34.94/site-lisp +[INS] [DEL] [Current dir?]: /usr/local/share/emacs/site-lisp +[INS] [DEL] [Current dir?]: /usr/local/share/emacs/19.34.94/leim +[INS] [DEL] [Current dir?]: /usr/local/share/emacs/19.34.94/lisp +[INS] [DEL] [Current dir?]: /build/emacs/e19/lisp +[INS] [DEL] [Current dir?]: /build/emacs/e19/lisp/gnus +[INS] + [State]: this item has been changed outside the customization buffer. +List of directories to search for files to load.... +@end smallexample + +@noindent +Each directory in the list appears on a separate line, and each line has +several editable or active fields. + + You can edit any of the directory names. To delete a directory from +the list, invoke @samp{[DEL]} on that line. To insert a new directory in +the list, invoke @samp{[INS]} at the point where you want to insert it. + + You can also invoke @samp{[Current dir?]} to switch between including +a specific named directory in the path, and including @code{nil} in the +path. (@code{nil} in a search path means ``try the current +directory.'') + +@kindex TAB @r{(customization buffer)} +@kindex S-TAB @r{(customization buffer)} +@findex widget-forward +@findex widget-backward + Two special commands, @key{TAB} and @kbd{S-@key{TAB}}, are useful for +moving through the customization buffer. @key{TAB} +(@code{widget-forward}) moves forward to the next active or editable +field; @kbd{S-@key{TAB}} (@code{widget-backward}) moves backward to the +previous active or editable field. + + Typing @key{RET} on an editable field also moves forward, just like +@key{TAB}. The reason for this is that people have a tendency to type +@key{RET} when they are finished editing a field. If you have occasion +to insert a newline in an editable field, use @kbd{C-o} or @kbd{C-q +C-j}, + +@cindex saving option value + Setting the option changes its value in the current Emacs session; +@dfn{saving} the value changes it for future sessions as well. This +works by writing code into your @file{~/.emacs} file so as to set the +option variable again each time you start Emacs. To save the option, +invoke @samp{[State]} and select the @samp{Save for Future Sessions} +operation. + + You can also restore the option to its standard value by invoking +@samp{[State]} and selecting the @samp{Reset to Standard Settings} +operation. There are actually three reset operations: + +@table @samp +@item Reset +If you have made some modifications and not yet set the option, +this restores the text in the customization buffer to match +the actual value. + +@item Reset to Saved +This restores the value of the option to the last saved value, +and updates the text accordingly. + +@item Reset to Standard Settings +This sets the option to its standard value, and updates the text +accordingly. This also eliminates any saved value for the option, +so that you will get the standard value in future Emacs sessions. +@end table + + The state of a group indicates whether anything in that group has been +edited, set or saved. You can select @samp{Set for Current Session}, +@samp{Save for Future Sessions} and the various kinds of @samp{Reset} +operation for the group; these operations on the group apply to all +options in the group and its subgroups. + + Near the top of the customization buffer there are two lines +containing several active fields: + +@smallexample + [Set] [Save] [Reset] [Reset to Saved] [Reset to Standard] [Done] +@end smallexample + +@noindent +Invoking @samp{[Done]} buries this customization buffer. Each of the +other fields performs an operation---set, save or reset---on each of the +items in the buffer that could meaningfully be set, saved or reset. + +@node Face Customization +@subsubsection Customizing Faces +@cindex customizing faces +@cindex bold font +@cindex italic font +@cindex fonts and faces + + In addition to user options, some customization groups also include +faces. When you show the contents of a group, both the user options and +the faces in the group appear in the customization buffer. Here is an +example of how a face looks: + +@smallexample +Custom Changed Face: (sample) + [State]: this face is unchanged from its standard setting. +Face used when the customize item has been changed. +Attributes: [ ] Bold: [toggle] off + [X] Italic: [toggle] on + [ ] Underline: [toggle] off + [ ] Inverse-Video: [toggle] on + [ ] Foreground: black (sample) + [ ] Background: white (sample) + [ ] Stipple: +@end smallexample + + Each face attribute has its own line. The @samp{[@var{x}]} field +before the attribute name indicates whether the attribute is +@dfn{enabled}; @samp{X} means that it is. You can enable or disable the +attribute by invoking that field. When the attribute is enabled, you +can change the attribute value in the usual ways. + + On a black-and-white display, the colors you can use for the +background are @samp{black}, @samp{white}, @samp{gray}, @samp{gray1}, +and @samp{gray3}. Emacs supports these shades of gray by using +background stipple patterns instead of a color. + + Setting, saving and resetting a face work like the same operations for +options (@pxref{Changing an Option}). + + A face can specify different appearances for different types of +display. For example, a face can make text red on a color display, but +use a bold font on a monochrome display. To specify multiple +appearances for a face, select @samp{Show Display Types} in the menu you +get from invoking @samp{[State]}. + +@findex modify-face + Another more basic way to set the attributes of a specific face is +with @kbd{M-x modify-face}. This command reads the name of a face, then +reads the attributes one by one. For the color and stipple attributes, +the attribute's current value is the default---type just @key{RET} if +you don't want to change that attribute. Type @samp{none} if you want +to clear out the attribute. + +@node Specific Customization +@subsubsection Customizing Specific Items + + Instead of finding the options you want to change by moving down +through the structure of groups, you can specify the particular option, +face or group that you want to customize. + +@table @kbd +@item M-x customize-option @key{RET} @var{option} @key{RET} +Set up a customization buffer with just one option, @var{option}. +@item M-x customize-face @key{RET} @var{face} @key{RET} +Set up a customization buffer with just one face, @var{face}. +@item M-x customize-group @key{RET} @var{group} @key{RET} +Set up a customization buffer with just one group, @var{group}. +@item M-x customize-apropos @key{RET} @var{regexp} @key{RET} +Set up a customization buffer with all the options, faces and groups +that match @var{regexp}. +@item M-x customize-saved +Set up a customization buffer containing all options and faces that you +have saved with customization buffers. +@item M-x customize-customized +Set up a customization buffer containing all options and faces that you +have customized but not saved. +@end table + +@findex customize-option + If you want to alter a particular user option variable with the +customization buffer, and you know its name, you can use the command +@kbd{M-x customize-option} and specify the option name. This sets up +the customization buffer with just one option---the one that you asked +for. Editing, setting and saving the value work as described above, but +only for the specified option. + +@findex customize-face + Likewise, you can modify a specific face, chosen by name, using +@kbd{M-x customize-face}. + +@findex customize-group + You can also set up the customization buffer with a specific group, +using @kbd{M-x customize-group}. The immediate contents of the chosen +group, including option variables, faces, and other groups, all appear +as well. However, these subgroups' own contents start out hidden. You +can show their contents in the usual way, by invoking @samp{[Show]}. + +@findex customize-apropos + To control more precisely what to customize, you can use @kbd{M-x +customize-apropos}. You specify a regular expression as argument; then +all options, faces and groups whose names match this regular expression +are set up in the customization buffer. If you specify an empty regular +expression, this includes @emph{all} groups, options and faces in the +customization buffer (but that takes a long time). + +@findex customize-saved +@findex customize-customized + If you change option values and then decide the change was a mistake, +you can use two special commands to revisit your previous changes. Use +@kbd{customize-saved} to look at the options and faces that you have +saved. Use @kbd{M-x customize-customized} to look at the options and +faces that you have set but not saved. + @node Edit Options @subsection Editing Variable Values diff -r 2947057885e5 -r a2f645c6b9f8 man/xemacs/xemacs.texi --- a/man/xemacs/xemacs.texi Mon Aug 13 09:58:32 2007 +0200 +++ b/man/xemacs/xemacs.texi Mon Aug 13 09:59:05 2007 +0200 @@ -543,6 +543,7 @@ Variables * Examining:: Examining or setting one variable's value. +* Easy Customization:: Convenient and easy customization of variables. * Edit Options:: Examining or editing list of all variables' values. * Locals:: Per-buffer values of variables. * File Variables:: How files can specify variable values. diff -r 2947057885e5 -r a2f645c6b9f8 nt/ChangeLog --- a/nt/ChangeLog Mon Aug 13 09:58:32 2007 +0200 +++ b/nt/ChangeLog Mon Aug 13 09:59:05 2007 +0200 @@ -1,3 +1,16 @@ +Thu September 25 23:06:44 1997 davidh + + * August Hill provided a patch to xemacs.mak to greatly simplify + the build - the DOC file gets created correctly. + +Tue September 22 23:06:44 1997 davidh + + * August Hill provided some more patches - to expand ~ correctly + and to correctly deal with drive letters in the path. + + * emacs.c patched to call init_ntproc() + + Tue July 15 19:32:21 1997 davidh * August Hill provided some more patches to make things better diff -r 2947057885e5 -r a2f645c6b9f8 nt/README --- a/nt/README Mon Aug 13 09:58:32 2007 +0200 +++ b/nt/README Mon Aug 13 09:59:05 2007 +0200 @@ -13,15 +13,15 @@ To get it working you will need: -1. An X server. MI/X is available on the Internet for free; It is - available from: http://www.microimages.com/www/html/freestuf/mixdlfrm.htm -2. The MIT X11R6.3 libraries available from: ftp.x.org -3. You'll need to compile the MIT libraries without multi-thread support. - To do this, there is an example Win32.cf and site.def provided which - set the relevant flags. You will also need to apply the patch in - nt/X11.patch in the xc/lib/X11 directory which will fix the DLL definition - file. Once compiled and installed, you will need to apply the following - patch to Xmd.h. This is messy and better solutions would be appreciated. +1. An X server. MI/X is available on the Internet for free; It is + available from: http://www.microimages.com/www/html/freestuf/mixdlfrm.htm +2. The MIT X11R6.3 libraries available from: ftp.x.org +3. You'll need to compile the MIT libraries without multi-thread support. + To do this, there is an example Win32.cf and site.def provided which + set the relevant flags. You will also need to apply the patch in + nt/X11.patch in the xc/lib/X11 directory which will fix the DLL definition + file. Once compiled and installed, you will need to apply the following + patch to Xmd.h. This is messy and better solutions would be appreciated. --- Xmd.h~ Thu Jun 08 23:20:40 1995 +++ Xmd.h Sun Mar 16 13:09:10 1997 @@ -33,24 +33,29 @@ typedef CARD8 BOOL; - +#endif - -4. You will need Visual C++ V4.2 or later to compile everything. Personally we - have tested V4.2 and V5.0. -5. Grab the latest XEmacs beta from ftp.xemacs.org if necessary. All nt - support is in the nt/ subdirectory. -6. Edit the xemacs.mak file and ensure variables point to the correct place. - Note that Visual C++ assumes a couple of environment variables INCLUDE and - LIB to be set which specify the location of the includes and libraries. -7. Copy the files Emacs.ad.h, config.h and paths.h from nt/ to src/. - Note, to rebuild Emacs.ad.h a sed script is run. SED for NT is available - from the Virtually Unix site: http://www.itribe.net/virtunix - This is not required however in normal operation. -8. Run make. I simply use nmake -f xemacs.mak. -9. Change directory to the src/ directory and run the temacs executable - manually: + +4. You will need Visual C++ V4.2 or later to compile everything. Personally we + have tested V4.2 and V5.0. +5. Grab the latest XEmacs beta from ftp.xemacs.org if necessary. All nt + support is in the nt/ subdirectory. +6. Edit the xemacs.mak file and ensure variables point to the correct place. + Note that Visual C++ assumes a couple of environment variables INCLUDE and + LIB to be set which specify the location of the includes and libraries. +7. Copy the files Emacs.ad.h, config.h and paths.h from nt/ to src/. + Note, to rebuild Emacs.ad.h a sed script is run. SED for NT is available + from the Virtually Unix site: http://www.itribe.net/virtunix + This is not required however in normal operation. +8. Run make. I simply use nmake -f xemacs.mak. +9. Change directory to the src/ directory and run the temacs executable + manually: temacs -batch -l loadup.el dump - This will produce an xemacs.exe which can be run in conjunction with your - X server. + This will produce an xemacs.exe which can be run in conjunction with your + X server. +10. Ensure your HOME environment variable is set correctly. Also ensure TERM + isn't set anywhere. +11. When you build, the DOC file will get created correctly. However I don't + update the elc's by default. This means the build will fail on the DOC + file if they don't exist. Just use the update-elcs rule and then rebuild. Known Problems: Please look at the TODO list for the current list of problems and people diff -r 2947057885e5 -r a2f645c6b9f8 nt/xemacs.mak --- a/nt/xemacs.mak Mon Aug 13 09:58:32 2007 +0200 +++ b/nt/xemacs.mak Mon Aug 13 09:59:05 2007 +0200 @@ -109,7 +109,7 @@ -nodefaultlib -out:$@ -debug:full DOC=$(LIB_SRC)\DOC -DOC_SRCS=\ +DOC_SRC1=\ $(XEMACS)\src\abbrev.c \ $(XEMACS)\src\alloc.c \ $(XEMACS)\src\alloca.c \ @@ -128,7 +128,8 @@ $(XEMACS)\src\console.c \ $(XEMACS)\src\data.c \ $(XEMACS)\src\debug.c \ - $(XEMACS)\src\device-x.c \ + $(XEMACS)\src\device-x.c +DOC_SRC2=\ $(XEMACS)\src\device.c \ $(XEMACS)\src\dgif_lib.c \ $(XEMACS)\src\dialog-x.c \ @@ -148,7 +149,8 @@ $(XEMACS)\src\eval.c \ $(XEMACS)\src\event-stream.c \ $(XEMACS)\src\event-unixoid.c \ - $(XEMACS)\src\event-Xt.c \ + $(XEMACS)\src\event-Xt.c +DOC_SRC3=\ $(XEMACS)\src\events.c \ $(XEMACS)\src\extents.c \ $(XEMACS)\src\faces.c \ @@ -168,7 +170,8 @@ $(XEMACS)\src\glyphs.c \ $(XEMACS)\src\gmalloc.c \ $(XEMACS)\src\gui-x.c \ - $(XEMACS)\src\gui.c \ + $(XEMACS)\src\gui.c +DOC_SRC4=\ $(XEMACS)\src\hash.c \ $(XEMACS)\src\indent.c \ $(XEMACS)\src\inline.c \ @@ -188,7 +191,8 @@ $(XEMACS)\src\ntproc.c \ $(XEMACS)\src\objects-x.c \ $(XEMACS)\src\objects.c \ - $(XEMACS)\src\opaque.c \ + $(XEMACS)\src\opaque.c +DOC_SRC5=\ $(XEMACS)\src\print.c \ $(XEMACS)\src\process.c \ $(XEMACS)\src\pure.c \ @@ -208,7 +212,8 @@ $(XEMACS)\src\symbols.c \ $(XEMACS)\src\syntax.c \ $(XEMACS)\src\sysdep.c \ - $(XEMACS)\src\termcap.c \ + $(XEMACS)\src\termcap.c +DOC_SRC6=\ $(XEMACS)\src\tparam.c \ $(XEMACS)\src\undo.c \ $(XEMACS)\src\unexnt.c \ @@ -225,13 +230,13 @@ $(XEMACS)\src\mule-ccl.c \ $(XEMACS)\src\mule-coding.c -MAKE_DOCFILE=$(OUTDIR)\make-docfile.exe +MAKE_DOCFILE=$(LIB_SRC)\make-docfile.exe $(MAKE_DOCFILE): $(OUTDIR)\make-docfile.obj link.exe -out:$@ $(LIB_SRC_LFLAGS) $** $(LIB_SRC_LIBS) $(OUTDIR)\make-docfile.obj: $(LIB_SRC)\make-docfile.c - $(CC) $(LIB_SRC_FLAGS) $** -Fo$@ + $(CC) $(LIB_SRC_FLAGS) -c $** -Fo$@ RUNEMACS=$(XEMACS)\src\runemacs.exe @@ -755,8 +760,14 @@ # LISP bits 'n bobs -$(DOC): $(OUTDIR)\make-docfile.exe - !"$(TEMACS) -batch -l make-docfile.el -o $(DOC) -d $(TEMACS_SRC) -i $(XEMACS)\site-packages $(DOC_SRC)" +$(DOC): $(LIB_SRC)\make-docfile.exe + !$(TEMACS) -batch -l make-docfile.el -- -o $(DOC) -i $(XEMACS)\site-packages + !$(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC1) + !$(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC2) + !$(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC3) + !$(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC4) + !$(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC4) + !$(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC5) LOADPATH=$(LISP)\prim dump-elcs: diff -r 2947057885e5 -r a2f645c6b9f8 src/ChangeLog --- a/src/ChangeLog Mon Aug 13 09:58:32 2007 +0200 +++ b/src/ChangeLog Mon Aug 13 09:59:05 2007 +0200 @@ -1,3 +1,161 @@ +1997-09-26 Hrvoje Niksic + + * window.c (saved_window_equal): Ditto. + + * process.c (Fget_process): Use internal_equal. + + * lread.c (build_load_history): Use internal_equal. + (build_load_history): Use XCAR/XCDR where safe. + + * events.c (event_equal): Ditto. + + * event-stream.c (Fdispatch_event): Ditto. + + * elhash.c (lisp_object_eql_equal): Ditto. + (lisp_object_equal_equal): Ditto. + + * device.c (find_device_of_type): Ditto. + + * console.c (find_console_of_type): Ditto. + + * console-tty.c (tty_init_console): Ditto. + + * console-stream.c (stream_init_console): Use internal_equal. + (stream_canonicalize_console_connection): Ditto. + + * fns.c (Fmember): Use internal_equal, to avoid a necessary + funcall and NILP check. + (Fold_member): Ditto for internal_old_equal. + (Fassoc): Use XCAR when we know we deal with a cons. Use + internal_equal. Removed tem. + (Fold_assoc): Ditto. + (Fassq): Use XCAR. + (Frassoc): Use internal_equal; remove tem. + (Fold_rassoc): Ditto for internal_old_equal. + (Frassq): Use XCDR with what we know is a cons. + (Fold_rassq): Ditto. + (Fdelete): Use internal_equal. + (Fold_delete): Ditto for internal_old_equal. + (Fremassoc): Use internal_equal; use XCAR/XCDR with what we know + is a cons. + (Fremrassoc): Ditto. + + * dired.c (Fdirectory_files): Nreverse the list only if it will be + sorted. + +Fri Sep 26 13:55:28 1997 Kyle Jones + + * faces.c (update_face_cachel_data): Don't allow the + background pixmap of the default face to override the + background of a face if that color has been specified. + +1997-09-26 Hrvoje Niksic + + * dired.c (close_directory_fd): New function. + (Fdirectory_files): Use it to set up an unwind-protection to close + the descriptor. + (Fdirectory_files): Allow QUIT in re_search. + (Fdirectory_files): If the file is too big, allocate necessary + data with malloc. + (Fdirectory_files): Use simple Fcons to build the list. + (close_directory_fd): Free the opaque pointer. + +1997-09-25 Hrvoje Niksic + + * extents.c (Fset_extent_properties): New function. + +1997-09-24 SL Baur + + * dired.c (Fdirectory_files): Remove broken VMS stuff. + (file_name_completion_stat): Ditto. + (file_name_completion): Ditto. + (Top Level): Ditto. + (syms_of_dired): Ditto. + +1997-09-25 Hrvoje Niksic + + * widget.c (Fwidget_apply): Don't GCPRO result of Fwidget_get. + +1997-09-24 SL Baur + + * symsinit.h: Declare syms_of_widget. + + * emacsfns.h: Declare Fchar_syntax. + + * bytecode.c (Fbyte_code): Call Fchar_syntax for the Bchar_syntax + bytecode. + + * syntax.c (Fchar_syntax): convert nil input to \000 for + compatibility. + + * alloc.c (report_pure_usage): Increase slop to 512 bytes in betas + and reduce it to 4 bytes in releases. + +1997-09-23 SL Baur + + * Makefile.in.in (objs): Add new C file widget.o. + +1997-09-22 SL Baur + + * editfns.c (vars_of_editfns): New feature 'ampersand-full-name + declared if AMPERSAND_FULL_NAME configuration option is enabled. + + * callproc.c (vars_of_callproc): Update docstring of `data-directory'. + +Sun Sep 21 14:14:44 1997 Kyle Jones + + * lisp.h: underspecify lisp_fn_t function prototype + to avoid compiler errors in inline_funcall_subr(). + + * eval.c (Fprogn): Walk forms list with XCDR, access + with XCAR. Check forms list CONSP, so that XCDR and XCAR are + safe. + + * eval.c (Fsetq): replace Flength call with for-loop + to compute list length. Walk arg list with XCDR, + access with XCAR. Check arg list with CONSP, so that + XCDR and XCAR are safe. + + * eval.c: New macro inline_funcall_subr, an inline + version of funcall_subr + primitive_funcall. + + * eval.c (Feval): replace Flength call with for-loop + to compute list length. Use XCAR and XCDR in some + places where it is safe to do so. Use + inline_funcall_subr() in place of funcall_subr(). + + * eval.c (funcall_recording_as): Use XCAR instead of + Fcar where it was safe. + + * eval.c (Fapply): replace Flength call with for-loop + to compute list length. + + * eval.c (apply_lambda):Use XCAR and XCDR in some + places where it is safe to do so. + + * eval.c (funcall_lambda): Walk param list with XCDR, access + with XCAR. Check param list CONSP, so that XCDR and XCAR are + safe. + + * symbols.c (find_symbol_value): return quickly if no + symbol magic is involved, to avoid the expensive call + to find_symbol_value_1. + + * symbols.c (store_symval_forwarding): don't call + reject_constant_symbols unless there is a chance a + constant symbol is involved. This break the + encapsulation of the constants check, but symbol stores + are used heavily and speed is most important than + cleanliness in this case. + +1997-09-21 Joel Peterson + + * menubar.c (normalize-menu-item-name): New function. + +1997-09-21 SL Baur + + * keymap.c (get_relevant_extent_keymaps): Previous patch reversed. + 1997-09-20 SL Baur * Makefile.in.in (xemacs): Adoption of shadow.el to print diff -r 2947057885e5 -r a2f645c6b9f8 src/Makefile.in.in --- a/src/Makefile.in.in Mon Aug 13 09:58:32 2007 +0200 +++ b/src/Makefile.in.in Mon Aug 13 09:59:05 2007 +0200 @@ -170,7 +170,7 @@ rangetab.o redisplay.o redisplay-output.o regex.o\ search.o signal.o sound.o\ specifier.o strftime.o symbols.o syntax.o sysdep.o\ - undo.o $(x_objs) window.o + undo.o $(x_objs) widget.o window.o #ifdef REL_ALLOC rallocdocsrc = ralloc.c diff -r 2947057885e5 -r a2f645c6b9f8 src/alloc.c --- a/src/alloc.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/alloc.c Mon Aug 13 09:59:05 2007 +0200 @@ -2624,6 +2624,8 @@ { int lost = (get_PURESIZE() - pureptr) / 1024; char buf[200]; + extern Lisp_Object Vemacs_beta_version; + int slop = NILP(Vemacs_beta_version) ? 512 : 4; sprintf (buf, "Purespace usage: %ld of %ld (%d%%", pureptr, (long) get_PURESIZE(), @@ -2631,7 +2633,7 @@ if (lost > 2) { sprintf (buf + strlen (buf), " -- %dk wasted", lost); if (die_if_pure_storage_exceeded) { - puresize_adjust_h (pureptr + 16); + puresize_adjust_h (pureptr + slop); rc = -1; } } diff -r 2947057885e5 -r a2f645c6b9f8 src/bytecode.c --- a/src/bytecode.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/bytecode.c Mon Aug 13 09:59:05 2007 +0200 @@ -972,12 +972,16 @@ break; case Bchar_syntax: +#if 0 CHECK_CHAR_COERCE_INT (TOP); TOP = make_char (syntax_code_spec [(int) SYNTAX (XCHAR_TABLE (current_buffer->mirror_syntax_table), XCHAR (TOP))]); +#endif + /*v1 = POP;*/ + TOP = Fchar_syntax(TOP, Qnil); break; case Bbuffer_substring: diff -r 2947057885e5 -r a2f645c6b9f8 src/callproc.c --- a/src/callproc.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/callproc.c Mon Aug 13 09:59:05 2007 +0200 @@ -1178,6 +1178,8 @@ DEFVAR_LISP ("data-directory", &Vdata_directory /* Directory of architecture-independent files that come with XEmacs, intended for XEmacs to use. +Use of this variable in new code is almost never correct. See the +function `locate-data-directory' and the variable `data-directory-list'. */ ); DEFVAR_LISP ("data-directory-list", &Vdata_directory_list /* diff -r 2947057885e5 -r a2f645c6b9f8 src/console-stream.c --- a/src/console-stream.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/console-stream.c Mon Aug 13 09:59:05 2007 +0200 @@ -58,7 +58,7 @@ /* Open the specified console */ - if (NILP (tty) || !NILP (Fequal (tty, Vstdio_str))) + if (NILP (tty) || internal_equal (tty, Vstdio_str, 0)) { infd = stdin; outfd = stdout; @@ -134,7 +134,7 @@ stream_canonicalize_console_connection (Lisp_Object connection, Error_behavior errb) { - if (NILP (connection) || !NILP (Fequal (connection, Vstdio_str))) + if (NILP (connection) || internal_equal (connection, Vstdio_str, 0)) return Vstdio_str; if (!ERRB_EQ (errb, ERROR_ME)) diff -r 2947057885e5 -r a2f645c6b9f8 src/console-tty.c --- a/src/console-tty.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/console-tty.c Mon Aug 13 09:59:05 2007 +0200 @@ -92,7 +92,7 @@ /* Open the specified console */ allocate_tty_console_struct (con); - if (!NILP (Fequal (tty, Vstdio_str))) + if (internal_equal (tty, Vstdio_str, 0)) { infd = fileno (stdin); outfd = fileno (stdout); diff -r 2947057885e5 -r a2f645c6b9f8 src/console.c --- a/src/console.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/console.c Mon Aug 13 09:59:05 2007 +0200 @@ -388,8 +388,8 @@ Lisp_Object console = XCAR (concons); if (EQ (CONMETH_TYPE (meths), CONSOLE_TYPE (XCONSOLE (console))) - && !NILP (Fequal (CONSOLE_CANON_CONNECTION (XCONSOLE (console)), - canon))) + && internal_equal (CONSOLE_CANON_CONNECTION (XCONSOLE (console)), + canon, 0)) return console; } diff -r 2947057885e5 -r a2f645c6b9f8 src/device.c --- a/src/device.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/device.c Mon Aug 13 09:59:05 2007 +0200 @@ -412,8 +412,8 @@ Lisp_Object device = XCAR (devcons); if (EQ (CONMETH_TYPE (meths), DEVICE_TYPE (XDEVICE (device))) - && !NILP (Fequal (DEVICE_CANON_CONNECTION (XDEVICE (device)), - canon))) + && internal_equal (DEVICE_CANON_CONNECTION (XDEVICE (device)), + canon, 0)) return device; } diff -r 2947057885e5 -r a2f645c6b9f8 src/dired.c --- a/src/dired.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/dired.c Mon Aug 13 09:59:05 2007 +0200 @@ -27,6 +27,7 @@ #include "commands.h" #include "elhash.h" #include "regex.h" +#include "opaque.h" #include "sysfile.h" #include "sysdir.h" @@ -38,6 +39,15 @@ Lisp_Object Qfile_name_all_completions; Lisp_Object Qfile_attributes; +static Lisp_Object +close_directory_fd (Lisp_Object unwind_obj) +{ + DIR *d = (DIR *)get_opaque_ptr (unwind_obj); + closedir (d); + free_opaque_ptr (unwind_obj); + return Qnil; +} + DEFUN ("directory-files", Fdirectory_files, 1, 5, 0, /* Return a list of names of files in DIRECTORY. There are four optional arguments: @@ -55,19 +65,16 @@ { /* This function can GC. GC checked 1997.04.06. */ DIR *d; - Bytecount dirname_length; + Bytecount name_as_dir_length; Lisp_Object list, name, dirfilename = Qnil; Lisp_Object handler; struct re_pattern_buffer *bufp = NULL; + Lisp_Object name_as_dir = Qnil; + int speccount = specpdl_depth (); + char *statbuf, *statbuf_tail; - char statbuf [MAXNAMLEN+2]; - char *statbuf_tail; - Lisp_Object tail_cons = Qnil; - char slashfilename[MAXNAMLEN+2]; - char *filename = slashfilename; - - struct gcpro gcpro1, gcpro2, gcpro3; - GCPRO3 (dirname, dirfilename, tail_cons); + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + GCPRO4 (dirname, name_as_dir, dirfilename, list); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -87,20 +94,16 @@ but earlier everywhere else? */ dirname = Fexpand_file_name (dirname, Qnil); dirfilename = Fdirectory_file_name (dirname); + name_as_dir = Ffile_name_as_directory (dirname); - { - /* XEmacs: this should come before the opendir() because it might error. */ - Lisp_Object name_as_dir = Ffile_name_as_directory (dirname); - CHECK_STRING (name_as_dir); - memcpy (statbuf, ((char *) XSTRING_DATA (name_as_dir)), - XSTRING_LENGTH (name_as_dir)); - statbuf_tail = statbuf + XSTRING_LENGTH (name_as_dir); - } + name_as_dir_length = XSTRING_LENGTH (name_as_dir); + statbuf = alloca (name_as_dir_length + MAXNAMLEN + 1); + memcpy (statbuf, XSTRING_DATA (name_as_dir), name_as_dir_length); + statbuf_tail = statbuf + name_as_dir_length; /* XEmacs: this should come after Ffile_name_as_directory() to avoid - potential regexp cache smashage. This should come before the - opendir() because it might signal an error. - */ + potential regexp cache smashage. It comes before the opendir() + because it might signal an error. */ if (!NILP (match)) { CHECK_STRING (match); @@ -108,38 +111,22 @@ /* MATCH might be a flawed regular expression. Rather than catching and signalling our own errors, we just call compile_pattern to do the work for us. */ -#ifdef VMS - bufp = - compile_pattern (match, 0, - (char *) MIRROR_DOWNCASE_TABLE_AS_STRING - (XBUFFER (Vbuffer_defaults)), 0, ERROR_ME); -#else bufp = compile_pattern (match, 0, 0, 0, ERROR_ME); -#endif } /* Now *bufp is the compiled form of MATCH; don't call anything which might compile a new regexp until we're done with the loop! */ - /* Do this opendir after anything which might signal an error; if - an error is signalled while the directory stream is open, we - have to make sure it gets closed, and setting up an - unwind_protect to do so would be a pain. */ + /* Do this opendir after anything which might signal an error; + previosly, there was no unwind-protection in case of error, but + now there is. */ d = opendir ((char *) XSTRING_DATA (dirfilename)); if (! d) report_file_error ("Opening directory", list1 (dirname)); + record_unwind_protect (close_directory_fd, make_opaque_ptr ((void *)d)); + list = Qnil; - tail_cons = Qnil; - dirname_length = XSTRING_LENGTH (dirname); -#ifndef VMS - if (dirname_length == 0 - || !IS_ANY_SEP (XSTRING_BYTE (dirname, dirname_length - 1))) - { - *filename++ = DIRECTORY_SEP; - dirname_length++; - } -#endif /* VMS */ /* Loop reading blocks */ while (1) @@ -152,30 +139,39 @@ if (DIRENTRY_NONEMPTY (dp)) { int result; - Lisp_Object oinhibit_quit = Vinhibit_quit; - strncpy (filename, dp->d_name, len); - filename[len] = 0; - /* re_search can now QUIT, so prevent it to avoid - filedesc lossage */ - Vinhibit_quit = Qt; result = (NILP (match) - || (0 <= re_search (bufp, filename, len, 0, len, 0))); - Vinhibit_quit = oinhibit_quit; + || (0 <= re_search (bufp, dp->d_name, len, 0, len, 0))); if (result) { if (!NILP (files_only)) { int dir_p; struct stat st; + char *cur_statbuf = statbuf; + char *cur_statbuf_tail = statbuf_tail; - memcpy (statbuf_tail, filename, len); - statbuf_tail [len] = 0; + /* A trick: we normally use the buffer created by + alloca. However, if the filename is too big + (meaning MAXNAMLEN lies on the system), we'll use + a malloced buffer, and free it. */ + if (len > MAXNAMLEN) + { + cur_statbuf = (char *) xmalloc (name_as_dir_length + + len + 1); + memcpy (cur_statbuf, statbuf, name_as_dir_length); + cur_statbuf_tail = cur_statbuf + name_as_dir_length; + } + memcpy (cur_statbuf_tail, dp->d_name, len); + cur_statbuf_tail [len] = 0; - if (stat (statbuf, &st) < 0) + if (stat (cur_statbuf, &st) < 0) dir_p = 0; else dir_p = ((st.st_mode & S_IFMT) == S_IFDIR); + if (cur_statbuf != statbuf) + xfree (cur_statbuf); + if (EQ (files_only, Qt) && dir_p) continue; else if (!EQ (files_only, Qt) && !dir_p) @@ -183,28 +179,20 @@ } if (!NILP (full)) - name = concat2 (dirname, build_string (slashfilename)); + name = concat2 (name_as_dir, + make_string ((Bufbyte *)dp->d_name, len)); else - name = make_string ((Bufbyte *) filename, len); + name = make_string ((Bufbyte *)dp->d_name, len); - if (NILP (tail_cons)) - { - list = list1 (name); - tail_cons = list; - } - else - { - XCDR (tail_cons) = list1 (name); - tail_cons = XCDR (tail_cons); - } + list = Fcons (name, list); } } } - closedir (d); - UNGCPRO; + unbind_to (speccount, Qnil); /* This will close the dir */ if (!NILP (nosort)) - return list; - return Fsort (Fnreverse (list), Qstring_lessp); + RETURN_UNGCPRO (list); + else + RETURN_UNGCPRO (Fsort (Fnreverse (list), Qstring_lessp)); } static Lisp_Object file_name_completion (Lisp_Object file, diff -r 2947057885e5 -r a2f645c6b9f8 src/editfns.c --- a/src/editfns.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/editfns.c Mon Aug 13 09:59:05 2007 +0200 @@ -2259,4 +2259,7 @@ is not available by any other means. */ ); atomic_extent_goto_char_p = 0; +#ifdef AMPERSAND_FULL_NAME + Fprovide(intern("ampersand-full-name")); +#endif } diff -r 2947057885e5 -r a2f645c6b9f8 src/elhash.c --- a/src/elhash.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/elhash.c Mon Aug 13 09:59:05 2007 +0200 @@ -211,7 +211,7 @@ Lisp_Object obj1, obj2; CVOID_TO_LISP (obj1, x1); CVOID_TO_LISP (obj2, x2); - return FLOATP (obj1) ? !NILP (Fequal (obj1, obj2)) : EQ (obj1, obj2); + return FLOATP (obj1) ? internal_equal (obj1, obj2, 0) : EQ (obj1, obj2); } static unsigned long @@ -231,7 +231,7 @@ Lisp_Object obj1, obj2; CVOID_TO_LISP (obj1, x1); CVOID_TO_LISP (obj2, x2); - return !NILP (Fequal (obj1, obj2)); + return internal_equal (obj1, obj2, 0); } static unsigned long diff -r 2947057885e5 -r a2f645c6b9f8 src/emacs.c --- a/src/emacs.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/emacs.c Mon Aug 13 09:59:05 2007 +0200 @@ -858,7 +858,9 @@ syms_of_toolbar (); #endif syms_of_undo (); + syms_of_widget (); syms_of_window (); + #ifdef HAVE_TTY syms_of_console_tty (); syms_of_device_tty (); @@ -1389,6 +1391,12 @@ #endif init_cmdargs (argc, argv, skip_args); /* Create list Vcommand_line_args */ init_buffer (); /* Init default directory of *scratch* buffer */ + +#ifdef WINDOWSNT + init_environment(); + init_ntproc(); +#endif + #ifdef VMS init_vms_input (); /* init_redisplay calls get_tty_device_size, that needs this */ diff -r 2947057885e5 -r a2f645c6b9f8 src/emacsfns.h --- a/src/emacsfns.h Mon Aug 13 09:58:32 2007 +0200 +++ b/src/emacsfns.h Mon Aug 13 09:59:05 2007 +0200 @@ -1737,6 +1737,7 @@ /* Defined in syntax.c */ int scan_words (struct buffer *buf, int from, int count); Lisp_Object Fforward_word (Lisp_Object n, Lisp_Object buffer); +Lisp_Object Fchar_syntax (Lisp_Object ch, Lisp_Object table); /* Defined in sysdep.c, also declared in sysdep.h. diff -r 2947057885e5 -r a2f645c6b9f8 src/eval.c --- a/src/eval.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/eval.c Mon Aug 13 09:59:05 2007 +0200 @@ -771,7 +771,7 @@ Lisp_Object args_left; struct gcpro gcpro1; - if (NILP (args)) + if (! CONSP (args)) return Qnil; args_left = args; @@ -779,10 +779,10 @@ do { - val = Feval (Fcar (args_left)); - args_left = Fcdr (args_left); + val = Feval (XCAR (args_left)); + args_left = XCDR (args_left); } - while (!NILP (args_left)); + while (CONSP (args_left)); UNGCPRO; return val; @@ -997,21 +997,33 @@ if (NILP (args)) return Qnil; - val = Flength (args); - if (XINT (val) & 1) /* Odd number of arguments? */ - Fsignal (Qwrong_number_of_arguments, list2 (Qsetq, val)); + { + REGISTER int i; + for (i = 0, val = args ; CONSP (val); val = XCDR (val)) + { + i++; + /* + * uncomment the QUIT if there is some way a circular + * arglist can get in here. I think Feval or Fapply would + * spin first and the list would never get here. + */ + /* QUIT; */ + } + if (i & 1) /* Odd number of arguments? */ + Fsignal (Qwrong_number_of_arguments, list2 (Qsetq, make_int(i))); + } args_left = args; GCPRO1 (args); do { - val = Feval (Fcar (Fcdr (args_left))); - sym = Fcar (args_left); + val = Feval (XCAR (XCDR (args_left))); + sym = XCAR (args_left); Fset (sym, val); - args_left = Fcdr (Fcdr (args_left)); + args_left = XCDR (XCDR (args_left)); } - while (!NILP (args_left)); + while (CONSP (args_left)); UNGCPRO; return val; @@ -2853,6 +2865,46 @@ return Qnil; } +#define inline_funcall_subr(rv, subr, av) \ + do { \ + switch (subr->max_args) { \ + case 0: rv = (subr_function(subr))(); \ + break; \ + case 1: rv = (subr_function(subr))(av[0]); \ + break; \ + case 2: rv = (subr_function(subr))(av[0], av[1]); \ + break; \ + case 3: rv = (subr_function(subr))(av[0], av[1], av[2]); \ + break; \ + case 4: rv = (subr_function(subr))(av[0], av[1], av[2], av[3]); \ + break; \ + case 5: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4]); \ + break; \ + case 6: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \ + av[5]); \ + break; \ + case 7: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \ + av[5], av[6]); \ + break; \ + case 8: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \ + av[5], av[6], av[7]); \ + break; \ + case 9: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \ + av[5], av[6], av[7], av[8]); \ + break; \ + case 10: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \ + av[5], av[6], av[7], av[8], av[9]); \ + break; \ + case 11: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \ + av[5], av[6], av[7], av[8], av[9], \ + av[10]); \ + break; \ + case 12: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \ + av[5], av[6], av[7], av[8], av[9], \ + av[10], av[11]); \ + break; \ + } \ + } while (0) DEFUN ("eval", Feval, 1, 1, 0, /* Evaluate FORM and return its value. @@ -2923,9 +2975,29 @@ error ("Lisp nesting exceeds `max-lisp-eval-depth'"); } - original_fun = Fcar (form); - original_args = Fcdr (form); - nargs = XINT (Flength (original_args)); + /* + * At this point we know that `form' is a Lisp_Cons so we can safely + * use XCAR and XCDR. + */ + original_fun = XCAR (form); + original_args = XCDR (form); + + /* + * Formerly we used a call to Flength here, but that is slow and + * wasteful due to type checking, stack push/pop and initialization. + * We know we're dealing with a cons, so open code it for speed. + * + * We call QUIT in the loop so that a circular arg list won't lock + * up the editor. + */ + for (nargs = 0, val = original_args ; CONSP (val) ; val = XCDR (val)) + { + nargs++; + QUIT; + } + if (! NILP (val)) + signal_simple_error ("Argument list must be nil-terminated", + original_args); #ifdef EMACS_BTL backtrace.id_number = 0; @@ -2982,10 +3054,10 @@ gcpro3.nvars = 0; argnum = 0; - while (!NILP (args_left)) + while (CONSP (args_left)) { - vals[argnum++] = Feval (Fcar (args_left)); - args_left = Fcdr (args_left); + vals[argnum++] = Feval (XCAR (args_left)); + args_left = XCDR (args_left); gcpro3.nvars = argnum; } @@ -3016,21 +3088,23 @@ gcpro3.var = argvals; gcpro3.nvars = 0; - for (i = 0; i < nargs; args_left = Fcdr (args_left)) + for (i = 0; i < nargs; args_left = XCDR (args_left)) { - argvals[i] = Feval (Fcar (args_left)); + argvals[i] = Feval (XCAR (args_left)); gcpro3.nvars = ++i; } UNGCPRO; - for (i = nargs; i < max_args; i++) + /* i == nargs at this point */ + for (; i < max_args; i++) argvals[i] = Qnil; backtrace.args = argvals; backtrace.nargs = nargs; - val = funcall_subr (subr, argvals); + /* val = funcall_subr (subr, argvals); */ + inline_funcall_subr(val, subr, argvals); } } else if (COMPILED_FUNCTIONP (fun)) @@ -3041,7 +3115,7 @@ if (!CONSP (fun)) goto invalid_function; - funcar = Fcar (fun); + funcar = XCAR (fun); if (!SYMBOLP (funcar)) goto invalid_function; if (EQ (funcar, Qautoload)) @@ -3050,7 +3124,7 @@ goto retry; } if (EQ (funcar, Qmacro)) - val = Feval (apply1 (Fcdr (fun), original_args)); + val = Feval (apply1 (XCDR (fun), original_args)); else if (EQ (funcar, Qlambda)) val = apply_lambda (fun, nargs, original_args); else @@ -3155,10 +3229,12 @@ for (i = nargs; i < max_args; i++) argvals[i] = Qnil; - val = funcall_subr (subr, argvals); + /* val = funcall_subr (subr, argvals); */ + inline_funcall_subr(val, subr, argvals); } else - val = funcall_subr (subr, args + 1); + /* val = funcall_subr (subr, args + 1); */ + inline_funcall_subr(val, subr, (&args[1])); } else if (COMPILED_FUNCTIONP (fun)) val = funcall_lambda (fun, nargs, args + 1); @@ -3169,7 +3245,8 @@ } else { - Lisp_Object funcar = Fcar (fun); + /* `fun' is a Lisp_Cons so XCAR is safe */ + Lisp_Object funcar = XCAR (fun); if (!SYMBOLP (funcar)) goto invalid_function; @@ -3339,13 +3416,27 @@ { /* This function can GC */ Lisp_Object fun = args[0]; - Lisp_Object spread_arg = args [nargs - 1]; + Lisp_Object spread_arg = args [nargs - 1], p; int numargs; int funcall_nargs; CHECK_LIST (spread_arg); - numargs = XINT (Flength (spread_arg)); + /* + * Formerly we used a call to Flength here, but that is slow and + * wasteful due to type checking, stack push/pop and initialization. + * We know we're dealing with a cons, so open code it for speed. + * + * We call QUIT in the loop so that a circular arg list won't lock + * up the editor. + */ + for (numargs = 0, p = spread_arg ; CONSP (p) ; p = XCDR (p)) + { + numargs++; + QUIT; + } + if (! NILP (p)) + signal_simple_error ("Argument list must be nil-terminated", spread_arg); if (numargs == 0) /* (apply foo 0 1 '()) */ @@ -3482,7 +3573,11 @@ for (i = 0; i < numargs;) { - tem = Fcar (unevalled_args), unevalled_args = Fcdr (unevalled_args); + /* + * unevalled_args is always a normal list, or Feval would have + * rejected it, so use XCAR and XCDR. + */ + tem = XCAR (unevalled_args), unevalled_args = XCDR (unevalled_args); tem = Feval (tem); arg_vector[i++] = tem; gcpro1.nvars = i; @@ -3519,16 +3614,16 @@ int optional = 0, rest = 0; if (CONSP (fun)) - syms_left = Fcar (Fcdr (fun)); + syms_left = Fcar (XCDR (fun)); else if (COMPILED_FUNCTIONP (fun)) syms_left = XCOMPILED_FUNCTION (fun)->arglist; else abort (); i = 0; - for (; !NILP (syms_left); syms_left = Fcdr (syms_left)) + for (; CONSP (syms_left); syms_left = XCDR (syms_left)) { QUIT; - next = Fcar (syms_left); + next = XCAR (syms_left); if (!SYMBOLP (next)) signal_error (Qinvalid_function, list1 (fun)); if (EQ (next, Qand_rest)) @@ -3557,7 +3652,7 @@ list2 (fun, make_int (nargs))); if (CONSP (fun)) - val = Fprogn (Fcdr (Fcdr (fun))); + val = Fprogn (Fcdr (XCDR (fun))); else { struct Lisp_Compiled_Function *b = XCOMPILED_FUNCTION (fun); diff -r 2947057885e5 -r a2f645c6b9f8 src/event-stream.c --- a/src/event-stream.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/event-stream.c Mon Aug 13 09:59:05 2007 +0200 @@ -4521,7 +4521,7 @@ } execute_command_event (command_builder, - !NILP (Fequal (event, command_builder-> most_current_event)) + internal_equal (event, command_builder-> most_current_event, 0) ? event /* Use the translated event that was most recently seen. This way, last-command-event becomes f1 instead of diff -r 2947057885e5 -r a2f645c6b9f8 src/events.c --- a/src/events.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/events.c Mon Aug 13 09:59:05 2007 +0200 @@ -233,10 +233,10 @@ return EQ (e1->event.process.process, e2->event.process.process); case timeout_event: - return (!NILP (Fequal (e1->event.timeout.function, - e2->event.timeout.function)) && - !NILP (Fequal (e1->event.timeout.object, - e2->event.timeout.object))); + return (internal_equal (e1->event.timeout.function, + e2->event.timeout.function, 0) && + internal_equal (e1->event.timeout.object, + e2->event.timeout.object, 0)); case key_press_event: return (EQ (e1->event.key.keysym, e2->event.key.keysym) && @@ -253,16 +253,16 @@ case misc_user_event: case eval_event: - return (!NILP (Fequal (e1->event.eval.function, - e2->event.eval.function)) && - !NILP (Fequal (e1->event.eval.object, - e2->event.eval.object))); + return (internal_equal (e1->event.eval.function, + e2->event.eval.function, 0) && + internal_equal (e1->event.eval.object, + e2->event.eval.object, 0)); case magic_eval_event: return (e1->event.magic_eval.internal_function == e2->event.magic_eval.internal_function && - !NILP (Fequal (e1->event.magic_eval.object, - e2->event.magic_eval.object))); + internal_equal (e1->event.magic_eval.object, + e2->event.magic_eval.object, 0)); case magic_event: { diff -r 2947057885e5 -r a2f645c6b9f8 src/extents.c --- a/src/extents.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/extents.c Mon Aug 13 09:59:05 2007 +0200 @@ -5272,6 +5272,32 @@ return value; } +DEFUN ("set-extent-properties", Fset_extent_properties, 2, 2, 0, /* +Change some properties of EXTENT. +PLIST is a property list. +For a list of built-in properties, see `set-extent-property'. +*/ + (extent, plist)) +{ + /* This function can GC, if one of the properties is `keymap' */ + Lisp_Object property, value; + struct gcpro gcpro1; + GCPRO1 (plist); + + plist = Fcopy_sequence (plist); + Fcanonicalize_plist (plist, Qnil); + + while (!NILP (plist)) + { + property = Fcar (plist); + value = Fcar (Fcdr (plist)); + plist = Fcdr (Fcdr (plist)); + Fset_extent_property (extent, property, value); + } + UNGCPRO; + return Qnil; +} + DEFUN ("extent-property", Fextent_property, 2, 3, 0, /* Return EXTENT's value for property PROPERTY. See `set-extent-property' for the built-in property names. @@ -6669,6 +6695,7 @@ DEFSUBR (Fset_extent_priority); DEFSUBR (Fextent_priority); DEFSUBR (Fset_extent_property); + DEFSUBR (Fset_extent_properties); DEFSUBR (Fextent_property); DEFSUBR (Fextent_properties); diff -r 2947057885e5 -r a2f645c6b9f8 src/faces.c --- a/src/faces.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/faces.c Mon Aug 13 09:59:05 2007 +0200 @@ -1185,6 +1185,26 @@ FROB (background); FROB (display_table); FROB (background_pixmap); + + /* + * A face's background pixmap will override the face's + * background color. But the background pixmap of the + * default face should not override the background color of + * a face if the background color has been specified or + * inherited. + * + * To accomplish this we remove the background pixmap of the + * cachel and mark it as having been specified so that cachel + * merging won't override it later. + */ + if (! default_face + && cachel->background_specified + && ! cachel->background_pixmap_specified) + { + cachel->background_pixmap = Qunbound; + cachel->background_pixmap_specified = 1; + } + #undef FROB ensure_face_cachel_contains_charset (cachel, domain, Vcharset_ascii); diff -r 2947057885e5 -r a2f645c6b9f8 src/fileio.c --- a/src/fileio.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/fileio.c Mon Aug 13 09:59:05 2007 +0200 @@ -1160,8 +1160,15 @@ o [p - nm] = 0; #ifdef WINDOWSNT + /* + ** Now if the file given is "~foo/file" and HOME="c:/", then we + ** want the file to be named "c:/file" ("~foo" becomes "c:/"). + ** The variable o has "~foo", so we can use the length of + ** that string to offset nm. August Hill, 31 Aug 1998. + */ newdir = (unsigned char *) egetenv ("HOME"); dostounix_filename (newdir); + nm += strlen(o) + 1; #else /* not WINDOWSNT */ /* Jamie reports that getpwnam() can get wedged by SIGIO/SIGALARM occurring in it. (It can call select()). */ diff -r 2947057885e5 -r a2f645c6b9f8 src/fns.c --- a/src/fns.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/fns.c Mon Aug 13 09:59:05 2007 +0200 @@ -55,6 +55,8 @@ static void print_bit_vector (Lisp_Object, Lisp_Object, int); static int bit_vector_equal (Lisp_Object o1, Lisp_Object o2, int depth); static unsigned long bit_vector_hash (Lisp_Object obj, int depth); +static int internal_old_equal (Lisp_Object o1, Lisp_Object o2, int depth); + DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bit-vector", bit_vector, mark_bit_vector, print_bit_vector, 0, bit_vector_equal, bit_vector_hash, @@ -1064,7 +1066,7 @@ for (tail = list; !NILP (tail); tail = Fcdr (tail)) { tem = Fcar (tail); - if (! NILP (Fequal (elt, tem))) + if (internal_equal (elt, tem, 0)) return tail; QUIT; } @@ -1083,7 +1085,7 @@ for (tail = list; !NILP (tail); tail = Fcdr (tail)) { tem = Fcar (tail); - if (! NILP (Fold_equal (elt, tem))) + if (internal_old_equal (elt, tem, 0)) return tail; QUIT; } @@ -1143,13 +1145,14 @@ (key, list)) { /* This function can GC. */ - REGISTER Lisp_Object tail, elt, tem; + REGISTER Lisp_Object tail, elt; for (tail = list; !NILP (tail); tail = Fcdr (tail)) { elt = Fcar (tail); - if (!CONSP (elt)) continue; - tem = Fequal (Fcar (elt), key); - if (!NILP (tem)) return elt; + if (!CONSP (elt)) + continue; + if (internal_equal (XCAR (elt), key, 0)) + return elt; QUIT; } return Qnil; @@ -1162,13 +1165,14 @@ (key, list)) { /* This function can GC. */ - REGISTER Lisp_Object tail, elt, tem; + REGISTER Lisp_Object tail, elt; for (tail = list; !NILP (tail); tail = Fcdr (tail)) { elt = Fcar (tail); - if (!CONSP (elt)) continue; - tem = Fold_equal (Fcar (elt), key); - if (!NILP (tem)) return elt; + if (!CONSP (elt)) + continue; + if (internal_old_equal (XCAR (elt), key, 0)) + return elt; QUIT; } return Qnil; @@ -1193,9 +1197,13 @@ for (tail = list; !NILP (tail); tail = Fcdr (tail)) { elt = Fcar (tail); - if (!CONSP (elt)) continue; - tem = Fcar (elt); - if (EQ_WITH_EBOLA_NOTICE (key, tem)) return elt; + if (!CONSP (elt)) + continue; + /* Note: we use a temporary variable to avoid multiple + evaluations of XCAR (elt). */ + tem = XCAR (elt); + if (EQ_WITH_EBOLA_NOTICE (key, tem)) + return elt; QUIT; } return Qnil; @@ -1214,9 +1222,11 @@ for (tail = list; !NILP (tail); tail = Fcdr (tail)) { elt = Fcar (tail); - if (!CONSP (elt)) continue; - tem = Fcar (elt); - if (HACKEQ_UNSAFE (key, tem)) return elt; + if (!CONSP (elt)) + continue; + tem = XCAR (elt); + if (HACKEQ_UNSAFE (key, tem)) + return elt; QUIT; } return Qnil; @@ -1249,11 +1259,12 @@ REGISTER Lisp_Object tail; for (tail = list; !NILP (tail); tail = Fcdr (tail)) { - REGISTER Lisp_Object elt, tem; + REGISTER Lisp_Object elt; elt = Fcar (tail); - if (!CONSP (elt)) continue; - tem = Fequal (Fcdr (elt), key); - if (!NILP (tem)) return elt; + if (!CONSP (elt)) + continue; + if (internal_equal (XCDR (elt), key, 0)) + return elt; QUIT; } return Qnil; @@ -1268,11 +1279,12 @@ REGISTER Lisp_Object tail; for (tail = list; !NILP (tail); tail = Fcdr (tail)) { - REGISTER Lisp_Object elt, tem; + REGISTER Lisp_Object elt; elt = Fcar (tail); - if (!CONSP (elt)) continue; - tem = Fold_equal (Fcdr (elt), key); - if (!NILP (tem)) return elt; + if (!CONSP (elt)) + continue; + if (internal_old_equal (XCDR (elt), key, 0)) + return elt; QUIT; } return Qnil; @@ -1288,9 +1300,11 @@ for (tail = list; !NILP (tail); tail = Fcdr (tail)) { elt = Fcar (tail); - if (!CONSP (elt)) continue; - tem = Fcdr (elt); - if (EQ_WITH_EBOLA_NOTICE (key, tem)) return elt; + if (!CONSP (elt)) + continue; + tem = XCDR (elt); + if (EQ_WITH_EBOLA_NOTICE (key, tem)) + return elt; QUIT; } return Qnil; @@ -1306,9 +1320,11 @@ for (tail = list; !NILP (tail); tail = Fcdr (tail)) { elt = Fcar (tail); - if (!CONSP (elt)) continue; - tem = Fcdr (elt); - if (HACKEQ_UNSAFE (key, tem)) return elt; + if (!CONSP (elt)) + continue; + tem = XCDR (elt); + if (HACKEQ_UNSAFE (key, tem)) + return elt; QUIT; } return Qnil; @@ -1344,7 +1360,7 @@ prev = Qnil; while (!NILP (tail)) { - if (!NILP (Fequal (elt, Fcar (tail)))) + if (internal_equal (elt, Fcar (tail), 0)) { if (NILP (prev)) list = Fcdr (tail); @@ -1374,7 +1390,7 @@ prev = Qnil; while (!NILP (tail)) { - if (!NILP (Fold_equal (elt, Fcar (tail)))) + if (internal_old_equal (elt, Fcar (tail), 0)) { if (NILP (prev)) list = Fcdr (tail); @@ -1532,7 +1548,7 @@ while (!NILP (tail)) { Lisp_Object elt = Fcar (tail); - if (CONSP (elt) && ! NILP (Fequal (key, Fcar (elt)))) + if (CONSP (elt) && internal_equal (key, XCAR (elt), 0)) { if (NILP (prev)) list = Fcdr (tail); @@ -1629,7 +1645,7 @@ while (!NILP (tail)) { Lisp_Object elt = Fcar (tail); - if (CONSP (elt) && ! NILP (Fequal (value, Fcdr (elt)))) + if (CONSP (elt) && internal_equal (value, XCDR (elt), 0)) { if (NILP (prev)) list = Fcdr (tail); diff -r 2947057885e5 -r a2f645c6b9f8 src/keymap.c --- a/src/keymap.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/keymap.c Mon Aug 13 09:59:05 2007 +0200 @@ -2428,17 +2428,14 @@ if (!NILP (pos)) { Lisp_Object extent; - for (extent = Fextent_at (pos, buffer_or_string, Qkeymap, Qnil, Qat); + for (extent = Fextent_at (pos, buffer_or_string, Qkeymap, Qnil, Qnil); !NILP (extent); - extent = Fextent_at (pos, buffer_or_string, Qkeymap, extent, Qat)) + extent = Fextent_at (pos, buffer_or_string, Qkeymap, extent, Qnil)) { - if (!NILP (Fextent_in_region_p (extent, pos, pos, Qnil))) - { - Lisp_Object keymap = Fextent_property (extent, Qkeymap, Qnil); - if (!NILP (keymap)) - relevant_map_push (get_keymap (keymap, 1, 1), closure); - QUIT; - } + Lisp_Object keymap = Fextent_property (extent, Qkeymap, Qnil); + if (!NILP (keymap)) + relevant_map_push (get_keymap (keymap, 1, 1), closure); + QUIT; } } } diff -r 2947057885e5 -r a2f645c6b9f8 src/lisp.h --- a/src/lisp.h Mon Aug 13 09:58:32 2007 +0200 +++ b/src/lisp.h Mon Aug 13 09:59:05 2007 +0200 @@ -1080,7 +1080,7 @@ /*********** subr ***********/ -typedef Lisp_Object (*lisp_fn_t) (Lisp_Object, ...); +typedef Lisp_Object (*lisp_fn_t) (); struct Lisp_Subr { diff -r 2947057885e5 -r a2f645c6b9f8 src/lread.c --- a/src/lread.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/lread.c Mon Aug 13 09:59:05 2007 +0200 @@ -1125,10 +1125,10 @@ hashtab = locate_file_find_directory_hash_table (pathel); /* Loop over suffixes. */ - for (tail = suffixtab, found = 0; !NILP (tail) && !found; - tail = Fcdr (tail)) + for (tail = suffixtab, found = 0; !found && CONSP (tail); + tail = XCDR (tail)) { - if (!NILP (Fgethash (Fcar (tail), hashtab, Qnil))) + if (!NILP (Fgethash (XCAR (tail), hashtab, Qnil))) found = 1; } @@ -1215,7 +1215,7 @@ tem = Fcar (tail); /* Find the feature's previous assoc list... */ - if (!NILP (Fequal (source, Fcar (tem)))) + if (internal_equal (source, Fcar (tem), 0)) { foundit = 1; @@ -1235,13 +1235,13 @@ while (CONSP (tem2)) { - newelt = Fcar (tem2); + newelt = XCAR (tem2); if (NILP (Fmemq (newelt, tem))) Fsetcar (tail, Fcons (Fcar (tem), Fcons (newelt, Fcdr (tem)))); - tem2 = Fcdr (tem2); + tem2 = XCDR (tem2); QUIT; } } diff -r 2947057885e5 -r a2f645c6b9f8 src/menubar.c --- a/src/menubar.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/menubar.c Mon Aug 13 09:59:05 2007 +0200 @@ -27,6 +27,7 @@ #include #include "lisp.h" +#include "buffer.h" #include "device.h" #include "frame.h" #include "menubar.h" @@ -178,11 +179,59 @@ return Qnil; } +DEFUN ("normalize-menu-item-name", Fnormalize_menu_item_name, 1, 2, 0, /* +Convert a menu item name string into normal form. Returns a new string. +Menu item names should be converted to normal form before being compared. +*/ + (name, buffer)) +{ + struct buffer *buf = decode_buffer (buffer, 0); + struct Lisp_String *n; + Charcount end; + int i; + Bufbyte *name_data; + Bufbyte *string_result; + Bufbyte *string_result_ptr; + Lisp_Object res; + Emchar elt; + int expecting_underscore = 0; + + CHECK_STRING (name); + + n = XSTRING (name); + end = string_char_length (n); + name_data = string_data (n); + + string_result = (Bufbyte *) alloca (end * MAX_EMCHAR_LEN); + string_result_ptr = string_result; + for (i = 0; i < end ; i++) + { + elt = charptr_emchar_n (name_data, i); + elt = DOWNCASE (buf, elt); + if (elt == '%') + expecting_underscore = 1; + else if (expecting_underscore) + { + expecting_underscore = 0; + if (elt != '_') + { + string_result_ptr += set_charptr_emchar (string_result_ptr, '%'); + string_result_ptr += set_charptr_emchar (string_result_ptr, elt); + } + } + else + string_result_ptr += set_charptr_emchar (string_result_ptr, elt); + } + + return make_string (string_result, string_result_ptr - string_result); +} + void syms_of_menubar (void) { defsymbol (&Qcurrent_menubar, "current-menubar"); DEFSUBR (Fpopup_menu); + DEFSUBR (Fnormalize_menu_item_name); } void diff -r 2947057885e5 -r a2f645c6b9f8 src/process.c --- a/src/process.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/process.c Mon Aug 13 09:59:05 2007 +0200 @@ -404,7 +404,7 @@ { Lisp_Object proc = XCAR (tail); QUIT; - if (!NILP (Fequal (name, XPROCESS (proc)->name))) + if (internal_equal (name, XPROCESS (proc)->name, 0)) return XCAR (tail); } return Qnil; diff -r 2947057885e5 -r a2f645c6b9f8 src/realpath.c --- a/src/realpath.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/realpath.c Mon Aug 13 09:59:05 2007 +0200 @@ -77,6 +77,49 @@ strcpy(copy_path, path); path = copy_path; max_path = copy_path + PATH_MAX - 2; +#ifdef WINDOWSNT + /* + ** In NT we have two different cases: (1) the path name begins + ** with a drive letter, e.g., "C:"; and (2) the path name begins + ** with just a slash, which roots to the current drive. In the + ** first case we are going to leave things alone, in the second + ** case we will prepend the drive letter to the given path. + ** Note: So far in testing, I'm only seeing case #1, even though + ** I've tried to get the other cases to happen. + ** August Hill, 31 Aug 1997. + ** + ** Check for a driver letter...C:/... + */ + if (*(path + 1) == ':') + { + strncpy(new_path, path, 3); + new_path += 3; + path += 3; + } + + /* + ** No drive letter, but a beginning slash? Prepend the drive + ** letter... + */ + else if (*path == '/') + { + getcwd(new_path, PATH_MAX - 1); + new_path += 3; + path++; + } + + /* + ** Just a path name, prepend the current directory + */ + else + { + getcwd(new_path, PATH_MAX - 1); + new_path += strlen(new_path); + if (new_path[-1] != '/') + *new_path++ = '/'; + } + +#else /* If it's a relative pathname use getwd for starters. */ if (*path != '/') { @@ -94,7 +137,7 @@ *new_path++ = '/'; path++; } - +#endif /* Expand each slash-separated pathname component. */ while (*path != '\0') { diff -r 2947057885e5 -r a2f645c6b9f8 src/redisplay.c --- a/src/redisplay.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/redisplay.c Mon Aug 13 09:59:05 2007 +0200 @@ -454,11 +454,13 @@ Lisp_Object Vglobal_mode_string; -/* The number of lines to try scrolling a - window by when point leaves the window; if +/* The number of lines scroll a window by when point leaves the window; if it is <=0 then point is centered in the window */ int scroll_step; +/* Scroll up to this many lines, to bring point back on screen. */ +int scroll_conservatively; + /* Marker for where to display an arrow on top of the buffer text. */ Lisp_Object Voverlay_arrow_position; /* String to display for the arrow. */ @@ -5190,12 +5192,16 @@ back onto the screen. */ if (scroll_step) { - startp = vmotion (w, startp, - (pointm < startp) ? -scroll_step : scroll_step, 0); - regenerate_window (w, startp, pointm, DESIRED_DISP); - - if (point_visible (w, pointm, DESIRED_DISP)) - goto regeneration_done; + int scrolled = scroll_conservatively; + for (; scrolled >= 0; scrolled -= scroll_step) + { + startp = vmotion (w, startp, + (pointm < startp) ? -scroll_step : scroll_step, 0); + regenerate_window (w, startp, pointm, DESIRED_DISP); + + if (point_visible (w, pointm, DESIRED_DISP)) + goto regeneration_done; + } } /* We still haven't managed to get the screen drawn with point on @@ -8205,6 +8211,12 @@ If that fails to bring point back on frame, point is centered instead. If this is zero, point is always centered after it moves off screen. */ ); + scroll_step = 0; + + DEFVAR_INT ("scroll-conservatively", &scroll_conservatively /* +*Scroll up to this many lines, to bring point back on screen. +*/ ); + scroll_conservatively = 0; DEFVAR_BOOL_MAGIC ("truncate-partial-width-windows", &truncate_partial_width_windows /* diff -r 2947057885e5 -r a2f645c6b9f8 src/symbols.c --- a/src/symbols.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/symbols.c Mon Aug 13 09:59:05 2007 +0200 @@ -1510,8 +1510,14 @@ /* WARNING: This function can be called when current_buffer is 0 and Vselected_console is Qnil, early in initialization. */ struct console *dev; + Lisp_Object valcontents; CHECK_SYMBOL (sym); + + valcontents = XSYMBOL (sym)->value; + if (!SYMBOL_VALUE_MAGIC_P (valcontents)) + return valcontents; + if (CONSOLEP (Vselected_console)) dev = XCONSOLE (Vselected_console); else @@ -1588,9 +1594,16 @@ CHECK_SYMBOL (sym); retry: - reject_constant_symbols (sym, newval, 0, - UNBOUNDP (newval) ? Qmakunbound : Qset); valcontents = XSYMBOL (sym)->value; + if (NILP (sym) || EQ (sym, Qt) || SYMBOL_VALUE_MAGIC_P (valcontents)) + reject_constant_symbols (sym, newval, 0, + UNBOUNDP (newval) ? Qmakunbound : Qset); + else + { + XSYMBOL (sym)->value = newval; + return newval; + } + retry_2: if (SYMBOL_VALUE_MAGIC_P (valcontents)) diff -r 2947057885e5 -r a2f645c6b9f8 src/symsinit.h --- a/src/symsinit.h Mon Aug 13 09:58:32 2007 +0200 +++ b/src/symsinit.h Mon Aug 13 09:59:05 2007 +0200 @@ -125,6 +125,7 @@ void syms_of_toolbar (void); void syms_of_tooltalk (void); void syms_of_undo (void); +void syms_of_widget (void); void syms_of_window (void); void syms_of_xselect (void); diff -r 2947057885e5 -r a2f645c6b9f8 src/syntax.c --- a/src/syntax.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/syntax.c Mon Aug 13 09:59:05 2007 +0200 @@ -274,7 +274,7 @@ if (NILP(ch)) { - return Qnil; + ch = make_char('\000'); } CHECK_CHAR_COERCE_INT (ch); table = check_syntax_table (table, current_buffer->syntax_table); diff -r 2947057885e5 -r a2f645c6b9f8 src/widget.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/widget.c Mon Aug 13 09:59:05 2007 +0200 @@ -0,0 +1,119 @@ +/* Primitives for work of the "widget" library. + Copyright (C) 1997 Free Software Foundation, Inc. + +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, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + +/* In an ideal world, this file would not have been necessary. + However, elisp function calls being as slow as they are, it turns + out that some functions in the widget library (wid-edit.el) are the + bottleneck of Widget operation. Here is their translation to C, + for the sole reason of efficiency. */ + +#include +#include "lisp.h" +#include "buffer.h" +#include "insdel.h" + + +Lisp_Object Qwidget_type; + + +DEFUN ("widget-plist-member", Fwidget_plist_member, 2, 2, 0, /* +Like `plist-get', but returns the tail of PLIST whose car is PROP. +*/ + (plist, prop)) +{ + while (!NILP (plist) && !EQ (Fcar (plist), prop)) + { + /* Check for QUIT, so a circular plist doesn't lock up the + editor. */ + QUIT; + plist = Fcdr (Fcdr (plist)); + } + return plist; +} + +DEFUN ("widget-put", Fwidget_put, 3, 3, 0, /* +In WIDGET set PROPERTY to VALUE. +The value can later be retrived with `widget-get'. +*/ + (widget, property, value)) +{ + CHECK_CONS (widget); + XCDR (widget) = Fplist_put (XCDR (widget), property, value); + return widget; +} + +DEFUN ("widget-get", Fwidget_get, 2, 2, 0, /* + In WIDGET, get the value of PROPERTY. +The value could either be specified when the widget was created, or +later with `widget-put'. +*/ + (widget, property)) +{ + Lisp_Object tmp, value; + + value = Qnil; + while (1) + { + tmp = Fwidget_plist_member (Fcdr (widget), property); + if (!NILP (tmp)) + { + value = Fcar (Fcdr (tmp)); + break; + } + tmp = Fcar (widget); + if (!NILP (tmp)) + { + widget = Fget (tmp, Qwidget_type, Qnil); + continue; + } + break; + } + return value; +} + +DEFUN ("widget-apply", Fwidget_apply, 2, MANY, 0, /* +Apply the value of WIDGET's PROPERTY to the widget itself. +ARGS are passed as extra arguments to the function. +*/ + (int nargs, Lisp_Object *args)) +{ + /* This function can GC */ + Lisp_Object newargs[3]; + struct gcpro gcpro1; + + newargs[0] = Fwidget_get (args[0], args[1]); + newargs[1] = args[0]; + newargs[2] = Flist (nargs - 2, args + 2); + GCPRO1 ((newargs[2])); + RETURN_UNGCPRO (Fapply (3, newargs)); +} + +void +syms_of_widget (void) +{ + defsymbol (&Qwidget_type, "widget-type"); + + DEFSUBR (Fwidget_plist_member); + DEFSUBR (Fwidget_put); + DEFSUBR (Fwidget_get); + DEFSUBR (Fwidget_apply); +} diff -r 2947057885e5 -r a2f645c6b9f8 src/window.c --- a/src/window.c Mon Aug 13 09:58:32 2007 +0200 +++ b/src/window.c Mon Aug 13 09:59:05 2007 +0200 @@ -4592,10 +4592,10 @@ return EQ (win1->window, win2->window) && EQ (win1->buffer, win2->buffer) && - !NILP (Fequal (win1->start, win2->start)) && - !NILP (Fequal (win1->pointm, win2->pointm)) && - !NILP (Fequal (win1->sb_point, win2->sb_point)) && - !NILP (Fequal (win1->mark, win2->mark)) && + internal_equal (win1->start, win2->start, 0) && + internal_equal (win1->pointm, win2->pointm, 0) && + internal_equal (win1->sb_point, win2->sb_point, 0) && + internal_equal (win1->mark, win2->mark, 0) && win1->pixel_left == win2->pixel_left && win1->pixel_top == win2->pixel_top && win1->pixel_width == win2->pixel_width && diff -r 2947057885e5 -r a2f645c6b9f8 version.sh --- a/version.sh Mon Aug 13 09:58:32 2007 +0200 +++ b/version.sh Mon Aug 13 09:59:05 2007 +0200 @@ -1,5 +1,5 @@ #!/bin/sh emacs_major_version=20 emacs_minor_version=3 -emacs_beta_version=23 -xemacs_codename="Sarajevo" +emacs_beta_version=24 +xemacs_codename="Ljubljana"