Mercurial > hg > xemacs-beta
changeset 189:489f57a838ef r20-3b21
Import from CVS: tag r20-3b21
line wrap: on
line diff
--- a/CHANGES-beta Mon Aug 13 09:56:30 2007 +0200 +++ b/CHANGES-beta Mon Aug 13 09:57:07 2007 +0200 @@ -1,4 +1,17 @@ -*- indented-text -*- +to 20.3 beta21 "Bern" +-- Artificial event creation from Hrvoje Niksic +-- cl-extra.elc and cl-seq.elc are now dumped with XEmacs +-- custom-1.9958 Courtesy of Per Abrahamsen +-- W3-3.0.104 Courtesy of William Perry +-- one-shot extent hooks added -- someone please send me the current + shotlock.el +-- Custom initialization rework from Hrvoje Niksic +-- cc-mode-5.18 courtesy of Barry Warsaw +-- VM-6.34 courtesy of Kyle Jones +-- Miscellaneous clean up patches from Hrvoje Niksic +-- Miscellaneous bug fixes + to 20.3 beta20 "Tirana" -- Miscellaneous patches from Martin and Hrvoje -- tetris.el-1.8
--- a/ChangeLog Mon Aug 13 09:56:30 2007 +0200 +++ b/ChangeLog Mon Aug 13 09:57:07 2007 +0200 @@ -1,3 +1,9 @@ +1997-09-16 SL Baur <steve@altair.xemacs.org> + + * XEmacs 20.3-beta21 is released. + + * XEmacs 19.16-pre2 is released. + 1997-09-13 SL Baur <steve@altair.xemacs.org> * XEmacs 20.3-beta20 is released.
--- a/etc/NEWS Mon Aug 13 09:56:30 2007 +0200 +++ b/etc/NEWS Mon Aug 13 09:57:07 2007 +0200 @@ -109,46 +109,6 @@ * Changes in XEmacs 20.3 ======================== -** Info "dir" functionality merged from Emacs-19.34 - -All of the directories on `Info-directory-list' will be searched for -"dir" files, which may be full fledged Info files containing subnodes -as well as menus. They are merged to become one directory, with menus -in like-named subnodes being coalesced from the several "dir" files. - -"localdir" files are looked for too, secondary to "dir"'s. If there's -no "dir" in a directory, a "localdir" will be looked for. There can -be one of either "dir" or "localdir" in each of the directories in -`Info-directory-list', which is initialized from `Info-default- -directory-list', which you may customize through the Options menu. - -The first directory specified in `Info-default-directory-list' should -contain a "dir" file that will become the toplevel dir which the -others will be merged into. A "localdir" may optionally contain a -'* Menu:' section, or just entries like those in a menu section, but -no subnodes or info header. You can see what I'm talking about if you -view the "dir" file that comes with XEmacs. It has a header section -that should not be in a "localdir" file. The "localdir" should look -like the `buffer-substring' of XEmacs' stock "dir" from just below -"* Menu:" to the end of the file, optionally also containing the -"* Menu:" line. - -The contents of each "localdir" file will be inserted into the -toplevel "dir" file replacing a '* Locals:' line, OR alternatively, -will insert it below a 'Local*' (that's a regexp) heading line. If -there's more than one "localdir" file, each will either consume a '* -Locals:' line, be catenated to the end of the (dir)Top, or be inserted -under the 'Local' topic header. - -There is a new variable, called `Info-additional-directory-list', -which you may customize also, that can contain a list of directories -in which to search for Info documents, but NOT to search in for "dir" -or "localdir" files. This is useful for things like the Calc package, -which likes its info files in its lisp directory. If you put that -directory in the 'additional list', and a menu entry for it in one of -your "dir" or "localdir" files, a click on a menu entry for it will be -able to find the Info file. - ** Startup file additions. By default XEmacs now loads the user file ~/.xemacs if it exists. If @@ -185,22 +145,18 @@ set to nil to revert to the old behaviour. As before, typing C-g deactivate the region. -** Pending-delete changes. - -*** Pending-delete is now a minor mode, with the normal minor-mode -semantics and toggle functions. Old functions are left for -compatibility. - -*** Loading pending-del no longer turns on pending-delete mode. In -fact, it is no longer necessary to explicitly load pending-del. All -you need to do to turn on tpu-edt is run the tpu-edt function. Here's -how to run pending-delete instead of loading the file: - - Within XEmacs: Type M-x pending-delete <ret> - not M-x load-library <ret> pending-delete <ret> - - In .emacs: Use (turn-on-pending-delete) - not (load "pending-del") +** Info "dir" functionality merged from Emacs-19.34 + +All of the directories on `Info-directory-list' will be searched for +"dir" files, which may be full fledged Info files containing subnodes +as well as menus. They are merged to become one directory, with menus +in like-named subnodes being coalesced from the several "dir" files. + +"localdir" files are looked for too, secondary to "dir"'s. If there's +no "dir" in a directory, a "localdir" will be looked for. There can +be one of either "dir" or "localdir" in each of the directories in +`Info-directory-list', which is initialized from `Info-default- +directory-list', which you may customize through the Options menu. ** Abbreviations can now contain non-word characters. @@ -209,6 +165,10 @@ `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. @@ -225,6 +185,38 @@ previous echo area contents is restored (in case the command prints something useful.) +** Pending-delete changes. + +*** Pending-delete is now a minor mode, with the normal minor-mode +semantics and toggle functions. Old functions are left for +compatibility. + +*** Loading pending-del no longer turns on pending-delete mode. In +fact, it is no longer necessary to explicitly load pending-del. All +you need to do to turn on pending-delete is run the pending-delete +function: + + Within XEmacs: Type M-x pending-delete <ret> + not M-x load-library <ret> pending-delete <ret> + + In .emacs: Use (turn-on-pending-delete) + not (load "pending-del") + +** 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'. + ** XEmacs can now save the minibuffer histories from various minibuffers. To use this feature, add the line: @@ -290,6 +282,31 @@ an interval is \{M,N\}, and it means to match the preceding expression at least M times and as many as N times. +** Ada mode changes. + +*** There is now better support for using find-file.el with Ada mode. +If you switch between spec and body, the cursor stays in the same +procedure (modulo overloading). If a spec has no body file yet, but +you try to switch to its body file, Ada mode now generates procedure +stubs. + +*** There are two new commands: + - `ada-make-local' : invokes gnatmake on the current buffer + - `ada-check-syntax' : check syntax of current buffer. + +The user options `ada-compiler-make', `ada-make-options', +`ada-language-version', `ada-compiler-syntax-check', and +`ada-compile-options' are used within these commands. + +*** Ada mode can now work with Outline minor mode. The outline level +is calculated from the indenting, not from syntactic contructs. +Outlining does not work if your code is not correctly indented. + +*** The new function `ada-gnat-style' converts the buffer to the style of +formatting used in GNAT. It places two blanks after a comment start, +places one blank between a word end and an opening '(', and puts one +space between a comma and the beginning of a word. + * Lisp and internal changes in XEmacs 20.3 @@ -336,6 +353,23 @@ `debug-on-error' is t. It has no effect when `debug-on-signal' is non-nil. +** The function current-message returns the message currently displayed +in the echo area, or nil if there is none. + +** File-access primitive functions no longer discard an extra redundant +directory name from the beginning of the file name. In other words, +they no longer do anything special with // or /~. The same goes for +`expand-file-name'. That conversion is now done only in +`substitute-in-file-name'. + +This makes it possible for a Lisp program to open a file whose name +begins with ~. + +** The new function regexp-opt returns an efficient regexp to match a +string. The arguments are STRINGS and (optionally) PAREN. This +function can be used where regexp matching or searching is intensively +used and speed is important, e.g., in Font Lock mode. + * Changes in XEmacs 20.2
--- a/info/dir Mon Aug 13 09:56:30 2007 +0200 +++ b/info/dir Mon Aug 13 09:57:07 2007 +0200 @@ -48,7 +48,6 @@ Packages: -* AUCTeX:: Mode for editing TeX files. * CC-MODE:: Mode for editing C, C++, and Objective-C code. * CL:: A Common Lisp compatibility package for Emacs-Lisp. * Custom:: Customization Library for Emacs
--- a/lisp/ChangeLog Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/ChangeLog Mon Aug 13 09:57:07 2007 +0200 @@ -1,3 +1,219 @@ +1997-09-15 Karl M. Hegbloom <karlheg@inetarena.com> + + * packages/info.el (Info-mouse-track-double-click-hook): follow + the top menu item when double click in bottom 1/4 and middle 1/3 + +1997-09-16 SL Baur <steve@altair.xemacs.org> + + * prim/about.el (about-hackers): Add new entry. + +Tue Sep 16 19:23:24 1997 Barry A. Warsaw <cc-mode-help@python.org> + + * cc-mode/Release 5.18 + +Tue Sep 16 23:17:15 1997 Barry A. Warsaw <cc-mode-help@python.org> + + * cc-mode/cc-menus.el (cc-imenu-c-prototype-macro-regexp): New + variable. + + (cc-imenu-c++-generic-expression): Patches to better match C++ code. + Given by jan.dubois@ibm.net (Jan Dubois) + + * cc-mode/cc-menus.el (cc-imenu-java-generic-expression): + Removed test for declaration + statements. Patch given by Ake Stenhoff <etxaksf@aom.ericsson.se>, as + forwarded to me by RMS. + + * cc-mode/cc-menus.el: + Imenu support for Objective-C given by Masatake (jet) YAMATO. + + * cc-mode/cc-mode.el (objc-mode): Bind imenu-create-index-function to + cc-imenu-objc-function to enable Imenu support for Objective-C. + Contributed by Masatake (jet) YAMATO. + +Mon Sep 15 23:21:51 1997 Barry A. Warsaw <cc-mode-help@python.org> + + * cc-mode/cc-styles.el (c-initialize-builtin-style): + Use existing copy-tree if it's defined. + + copy-sequence doesn't work; the + c-offsets-alist must be copied recursively. Use copy-tree solution + given by Simon Marshall. + +Fri Sep 5 04:47:03 1997 Barry A. Warsaw <cc-mode-help@python.org> + + * cc-mode/cc-cmds.el (c-beginning-of-statement): + Fixes in sentence movement to properly + handle M-e moving forward into a comment when looking at preceding + whitespace, and M-a moving backward into comment when looking at + following whitespace. + + Uncommented the looking-at call in the + sentence-flag clause so that moving by forward-sentence when looking + at the beginning of a comment works again. A previous log message in + cc-mode.el indicates this was commented out "because + c-beginning-of-statement-1 should do the right thing", but clearly it + doesn't. + + I don't know if this breaks something else, because I can't figure out + why it was commented out in the first place. + + * cc-mode/cc-langs.el: + Define `/' in c-mode-base-map since all modes now support + c-electric-slash. + + Define C-c C-e in mode-specific maps instead of c-mode-base-map since + c-expand-macro is meaningless in Java and IDL. + + * cc-mode/cc-engine.el (c-end-of-statement-1): + Wrap backward-up-list in a c-safe call so no + error results when buffer contains only a comment and point is at + eob. + +1997-09-15 SL Baur <steve@altair.xemacs.org> + + * utils/autoload.el (customized-symbols): Use a hash table. + + * prim/cus-load.el (custom-put): Restore. + Adapted from code by Hrvoje Niksic <hniksic@srce.hr> + + * x11/x-toolbar.el (initial-toolbar-spec): Remove news and mail + icons from default toolbar. + +1997-09-14 Hrvoje Niksic <hniksic@srce.hr> + + * prim/packages.el (locate-data-directory): Return nil when + directory not found. + (locate-library): Reimplemented using `locate-file'. + +1997-09-14 Hrvoje Niksic <hniksic@srce.hr> + + * prim/cus-dep.el: Provide `cus-dep'. + + * packages/time.el (display-time-insinuate): New function; don't + insinuate upon loading. + (display-time): Use it. + + * prim/loadup.el: Use it. + + * prim/dumped-lisp.el (dumped-lisp-packages): Renamed to + `preloaded-file-list'. + + * prim/cus-load.el: Updated the comment. + + * prim/cus-dep.el (custom-make-dependencies): Unjunkify. + + * modes/lisp-mode.el: Declare indentation of `with-temp-buffer'. + + * prim/cus-dep.el (custom-make-dependencies): Allow optional + parameter; don't kill Emacs. + + * modes/cl-indent.el: Minor customize changes. + + * modes/asm-mode.el: Minor customize changes. + + * modes/arc-mode.el: Customized. + + * modes/ada-stmt.el: New file. + + * modes/ada-mode.el: Synched with FSF (customized, etc.) + +1997-09-13 SL Baur <steve@altair.xemacs.org> + + * prim/files.el (switch-to-buffer-other-frame): Undo previous + change when focus-follows-mouse policy is in effect. + +1997-09-14 Hrvoje Niksic <hniksic@srce.hr> + + * packages/recent-files.el: Minor customize changes. + + * packages/man.el: Minor customize changes. + (Manual-use-rosetta-man): Moved the extensive info from docstring. + + * packages/makeinfo.el: Minor customize changes. + + * packages/info.el: Minor customize changes. + + * packages/gopher.el: Minor customize changes. + + * packages/func-menu.el: Minor customize changes. + + * packages/etags.el (tags-delete): Use builtin `delete'. + (tags-remove-duplicates): Don't recurse. + Fixup customizations. + + * packages/emerge.el: Use `with-current-buffer' instead of + `emerge-eval-in-buffer'; reindent. + + * packages/compile.el: Minor customize changes. + + * packages/bookmark.el: Customized. + + * packages/avoid.el (mouse-avoidance-mode): Customized properly. + + * packages/autoinsert.el: Customized. + + * modes/xrdb-mode.el: Minor customize changes. + + * modes/vrml-mode.el: Minor customize changes. + + * modes/vhdl-mode.el: Customized. + (vhdl-emacs-features): Recognize XEmacs 20 correctly. + + * modes/vhdl-mode.el: Require elp when compiling. + + * modes/texinfo.el: Minor customize changes. + + * modes/tcl.el: Minot customize changes. + + * modes/strokes.el: Small fixes. + (strokes-mode): Don't signal error without window system; issue a + warning. + (strokes-insinuate): New function. Don't defadvice upon loading. + (strokes-mode): Use it. + (strokes-char-face): Use `defface'. + + * modes/simula.el: Customized. + + * modes/scribe.el: Customized. + (scribe-envelop-word): Don't bind `noparens' (unused). + + * modes/rsz-minibuf.el: Remove old lemacs support, + e.g. screen-vs-frame, etc. + (resize-minibuffer-min): Removed. + + * modes/rsz-minibuf.el: Fix customizations. + + * prim/subr.el: Moved string-to-foo functions to obsolete.el. + + * prim/obsolete.el: Comments. + +1997-09-13 Hrvoje Niksic <hniksic@srce.hr> + + * packages/filladapt.el: Added `:require' to filladapt-mode + customization. + + * modes/whitespace-mode.el: Customize better. + + * modes/hideshow.el: Customize. + + * packages/icomplete.el: Don't turn on by default; customize + correctly. + + * utils/uniquify.el: Don't invade Emacs by default. + (uniquify-buffer-name-style): Default to nil. + + * utils/uniquify.el: Removed support for Emacs 18. + + * packages/pending-del.el: Customize `pending-delete-mode'. + + * modes/sh-script.el: Renamed `sh-script' customization group to `sh'. + + * packages/balloon-help.el: Customize `balloon-help-mode'. + + * packages/paren.el: Don't invade Emacs by default. + Finished customizing. + 1997-09-13 SL Baur <steve@altair.xemacs.org> * x11/x-toolbar.el (toolbar-paste-function): Remove reference to
--- a/lisp/calendar/custom-load.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/calendar/custom-load.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,3 +1,5 @@ +(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-put 'holidays 'custom-loads '("calendar")) -(custom-put 'diary 'custom-loads '("calendar"))
--- a/lisp/cc-mode/auto-autoloads.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/cc-mode/auto-autoloads.el Mon Aug 13 09:57:07 2007 +0200 @@ -76,7 +76,7 @@ (autoload 'java-mode "cc-mode" "\ Major mode for editing Java code. -To submit a problem report, enter `\\[c-submit-bug-report]' from an +To submit a problem report, enter `\\[c-submit-bug-report]' from a java-mode buffer. This automatically sets up a mail buffer with version information already added. You just need to add a description of the problem, including a reproducible test case and send the @@ -95,7 +95,7 @@ (autoload 'idl-mode "cc-mode" "\ Major mode for editing CORBA's IDL code. -To submit a problem report, enter `\\[c-submit-bug-report]' from an +To submit a problem report, enter `\\[c-submit-bug-report]' from a idl-mode buffer. This automatically sets up a mail buffer with version information already added. You just need to add a description of the problem, including a reproducible test case, and send the
--- a/lisp/cc-mode/cc-align.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/cc-mode/cc-align.el Mon Aug 13 09:57:07 2007 +0200 @@ -7,7 +7,7 @@ ;; 1985 Richard M. Stallman ;; Maintainer: cc-mode-help@python.org ;; Created: 22-Apr-1997 (split from cc-mode.el) -;; Version: 5.17 +;; Version: 5.18 ;; Keywords: c languages oop ;; This file is part of GNU Emacs.
--- a/lisp/cc-mode/cc-cmds.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/cc-mode/cc-cmds.el Mon Aug 13 09:57:07 2007 +0200 @@ -7,7 +7,7 @@ ;; 1985 Richard M. Stallman ;; Maintainer: cc-mode-help@python.org ;; Created: 22-Apr-1997 (split from cc-mode.el) -;; Version: 5.17 +;; Version: 5.18 ;; Keywords: c languages oop ;; This file is part of GNU Emacs.
--- a/lisp/cc-mode/cc-compat.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/cc-mode/cc-compat.el Mon Aug 13 09:57:07 2007 +0200 @@ -5,7 +5,7 @@ ;; Author: 1994-1997 Barry A. Warsaw ;; Maintainer: cc-mode-help@python.org ;; Created: August 1994, split from cc-mode.el -;; Version: 5.17 +;; Version: 5.18 ;; Keywords: c languages oop ;; This file is part of GNU Emacs.
--- a/lisp/cc-mode/cc-defs.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/cc-mode/cc-defs.el Mon Aug 13 09:57:07 2007 +0200 @@ -7,7 +7,7 @@ ;; 1985 Richard M. Stallman ;; Maintainer: cc-mode-help@python.org ;; Created: 22-Apr-1997 (split from cc-mode.el) -;; Version: 5.17 +;; Version: 5.18 ;; Keywords: c languages oop ;; This file is part of GNU Emacs.
--- a/lisp/cc-mode/cc-engine.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/cc-mode/cc-engine.el Mon Aug 13 09:57:07 2007 +0200 @@ -7,7 +7,7 @@ ;; 1985 Richard M. Stallman ;; Maintainer: cc-mode-help@python.org ;; Created: 22-Apr-1997 (split from cc-mode.el) -;; Version: 5.17 +;; Version: 5.18 ;; Keywords: c languages oop ;; This file is part of GNU Emacs.
--- a/lisp/cc-mode/cc-langs.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/cc-mode/cc-langs.el Mon Aug 13 09:57:07 2007 +0200 @@ -7,7 +7,7 @@ ;; 1985 Richard M. Stallman ;; Maintainer: cc-mode-help@python.org ;; Created: 22-Apr-1997 (split from cc-mode.el) -;; Version: 5.17 +;; Version: 5.18 ;; Keywords: c languages oop ;; This file is part of GNU Emacs.
--- a/lisp/cc-mode/cc-menus.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/cc-mode/cc-menus.el Mon Aug 13 09:57:07 2007 +0200 @@ -7,7 +7,7 @@ ;; 1985 Richard M. Stallman ;; Maintainer: cc-mode-help@python.org ;; Created: 22-Apr-1997 (split from cc-mode.el) -;; Version: 5.17 +;; Version: 5.18 ;; Keywords: c languages oop ;; This file is part of GNU Emacs. @@ -29,56 +29,97 @@ ;; imenu integration +(defvar cc-imenu-c-prototype-macro-regexp nil + "RE matching macro names used to conditionally specify function prototypes. + +For example: + + #ifdef __STDC__ + #define _P(x) x + #else + #define _P(x) /*nothing*/ + #endif + + int main _P( (int argc, char *argv[]) ) + +A sample value might look like: `\\(_P\\|_PROTO\\)'.") + (defvar cc-imenu-c++-generic-expression (` - ((nil + ( + ;; Try to match ::operator definitions first. Otherwise `X::operator new ()' + ;; will be incorrectly recognised as function `new ()' because the regexps + ;; work by backtracking from the end of the definition. + (nil (, (concat - "^" ; beginning of line is required - "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>" - "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; type specs; there can be no - "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; more than 3 tokens, right? - - "\\(" ; last type spec including */& - "[a-zA-Z0-9_:]+" - "\\([ \t]*[*&]+[ \t]*\\|[ \t]+\\)" ; either ptr/ref sign or ws - "\\)?" ; if there is a last type spec - "\\(" ; name, take into the imenu entry - "[a-zA-Z0-9_:~]+" ; member func, ctor or dtor... - ; (may not contain * because then - ; "a::operator char*" would - ; become "char*"!) - "\\|" - "\\([a-zA-Z0-9_:~]*::\\)?operator" - "[^a-zA-Z1-9_][^(]*" ; ...or operator - " \\)" - "[ \t]*([^)]*)[ \t\n]*[^ ;]" ; require something other than - ; a `;' after the (...) to - ; avoid prototypes. Can't - ; catch cases with () inside - ; the parentheses surrounding - ; the parameters. e.g.: - ; "int foo(int a=bar()) {...}" - - )) 6) + "^\\<.*" + "[^a-zA-Z0-9_:<>~]" ; match any non-identifier char + ; (note: this can be `\n') + "\\(" + "\\([a-zA-Z0-9_:<>~]*::\\)?" ; match an operator + "operator\\>[ \t]*" + "\\(()\\|[^(]*\\)" ; special case for `()' operator + "\\)" + + "[ \t]*([^)]*)[ \t]*[^ \t;]" ; followed by ws, arg list, + ; require something other than + ; a `;' after the (...) to + ; avoid prototypes. Can't + ; catch cases with () inside + ; the parentheses surrounding + ; the parameters. e.g.: + ; `int foo(int a=bar()) {...}' + )) 1) + ;; Special case to match a line like `main() {}' + ;; e.g. no return type, not even on the previous line. + (nil + (, + (concat + "^" + "\\([a-zA-Z_][a-zA-Z0-9_:<>~]*\\)" ; match function name + "[ \t]*([^)]*)[ \t]*[^ \t;]" ; see above + )) 1) + ;; Special case for definitions using phony prototype macros like: + ;; `int main _PROTO( (int argc,char *argv[]) )'. + ;; This case is only included if cc-imenu-c-prototype-macro-regexp is set. + ;; Only supported in c-code, so no `:<>~' chars in function name! + (,@ (if cc-imenu-c-prototype-macro-regexp + (` ((nil + (, + (concat + "^\\<.*" ; line MUST start with word char + "[^a-zA-Z0-9_]" ; match any non-identifier char + "\\([a-zA-Z_][a-zA-Z0-9_]*\\)" ; match function name + "[ \t]*" ; whitespace before macro name + cc-imenu-c-prototype-macro-regexp + "[ \t]*(" ; ws followed by first paren. + "[ \t]*([^)]*)[ \t]*[^ \t;]" ; see above + )) 1))))) + ;; General function name regexp + (nil + (, + (concat + "^\\<.*" ; line MUST start with word char + "[^a-zA-Z0-9_:<>~]" ; match any non-identifier char + "\\([a-zA-Z_][a-zA-Z0-9_:<>~]*\\)" ; match function name + "[ \t]*([^)]*)[ \t]*[^ \t;]" ; see above + )) 1) + ;; Class definitions ("Class" (, (concat - "^" ; beginning of line is required - "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>" - "class[ \t]+" - "\\([a-zA-Z0-9_]+\\)" ; the string we want to get - "[ \t]*[:{]" - )) 2))) + "^" ; beginning of line is required + "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a `template <...>' + "class[ \t]+" + "\\([a-zA-Z0-9_]+\\)" ; the string we want to get + "[ \t]*[:{]" + )) 2))) "Imenu generic expression for C++ mode. See `imenu-generic-expression'.") (defvar cc-imenu-c-generic-expression cc-imenu-c++-generic-expression "Imenu generic expression for C mode. See `imenu-generic-expression'.") -;(defvar cc-imenu-objc-generic-expression -; ()) -; Please contribute one! - (defvar cc-imenu-java-generic-expression (` ((nil @@ -93,11 +134,191 @@ "\\([ \t]*\\)+(" "\\([a-zA-Z,_1-9\n \t]*[[]?[]]?\\)*" ; arguments ")[ \t]*" - "[^;(]" +; "[^;(]" "[,a-zA-Z_1-9\n \t]*{" )) 6))) "Imenu generic expression for Java mode. See `imenu-generic-expression'.") +(defvar cc-imenu-objc-generic-expression + (concat + ;; For C + ;; Pick a token by (match-string 6) + (car (cdr (car cc-imenu-c++-generic-expression))) + ;; For Objective-C + ;; Pick a token by (match-string 8) + "\\|\\(" + "^[-+][:a-zA-Z0-9()*_<>\n\t ]*[;{]" ; Methods + "\\|" + "^@interface[\t ]+[a-zA-Z0-9_]+[\t ]*:" + "\\|" + "^@interface[\t ]+[a-zA-Z0-9_]+[\t ]*([a-zA-Z0-9_]+)" + "\\|" + ;; For NSObject, NSProxy and Object... They don't have super class. + "^@interface[\t ]+[a-zA-Z0-9_]+[\t ]*.*$" + "\\|" + "^@implementation[\t ]+[a-zA-Z0-9_]+[\t ]*([a-zA-Z0-9_]+)" + "\\|" + "^@implementation[\t ]+[a-zA-Z0-9_]+" + "\\|" + "^@protocol[\t ]+[a-zA-Z0-9_]+" "\\)") + "Imenu generic expression for ObjC mode. See `imenu-generic-expression'.") + + +;; Imenu support for objective-c uses functions. +(defsubst cc-imenu-objc-method-to-selector (method) + "Return the objc selector style string of METHOD. +Example: +- perform: (SEL)aSelector withObject: object1 withObject: object2; /* METHOD */ +=> +-perform:withObject:withObject:withObject: /* selector */" + (let ((return "") ; String to be returned + (p 0) ; Current scanning position in METHOD + (pmax (length method)) ; + char ; Current scanning target + (betweenparen 0) ; CHAR is in parentheses. + argreq ; An argument is required. + inargvar) ; position of CHAR is in an argument variable. + (while (< p pmax) + (setq char (aref method p) + p (1+ p)) + (cond + ;; Is CHAR part of a objc token? + ((and (not inargvar) ; Ignore if CHAR is part of an argument variable. + (eq 0 betweenparen) ; Ignore if CHAR is in parentheses. + (or (and (<= ?a char) (<= char ?z)) + (and (<= ?A char) (<= char ?Z)) + (and (<= ?0 char) (<= char ?9)) + (= ?_ char))) + (if argreq + (setq inargvar t + argreq nil) + (setq return (concat return (char-to-string char))))) + ;; Or a white space? + ((and inargvar (or (eq ?\ char) (eq ?\n char)) + (setq inargvar nil))) + ;; Or a method separator? + ;; If a method separator, the next token will be an argument variable. + ((eq ?: char) + (setq argreq t + return (concat return (char-to-string char)))) + ;; Or an open parentheses? + ((eq ?\( char) + (setq betweenparen (1+ betweenparen))) + ;; Or a close parentheses? + ((eq ?\) char) + (setq betweenparen (1- betweenparen))))) + return)) + +(defun cc-imenu-objc-remove-white-space (str) + "Remove all spaces and tabs from STR." + (let ((return "") + (p 0) + (max (length str)) + char) + (while (< p max) + (setq char (aref str p)) + (setq p (1+ p)) + (if (or (= char ?\ ) (= char ?\t)) + () + (setq return (concat return (char-to-string char))))) + return)) + +(defun cc-imenu-objc-function () + "imenu supports for objc-mode." + (let (methodlist + clist + (C 6) + (OBJC 8) + langnum + (classcount 0) + toplist + stupid + str + str2 + (intflen (length "@interface")) + (implen (length "@implementation")) + (prtlen (length "@protocol")) + bufsubst-fun) + ;; + ;; Does this emacs has buffer-substring-no-properties? + ;; + (fset 'bufsubst-fun (if (fboundp 'buffer-substring-no-properties) + (symbol-function 'buffer-substring-no-properties) + (symbol-function 'buffer-substring))) + (goto-char (point-max)) + (imenu-progress-message stupid 0) + ;; + (while (re-search-backward cc-imenu-objc-generic-expression nil t) + (imenu-progress-message stupid) + (setq langnum (if (match-beginning C) C OBJC)) + (setq str (bufsubst-fun (match-beginning langnum) (match-end langnum))) + ;; + (cond + ;; + ;; C + ;; + ((eq langnum C) + (setq clist (cons (cons str (match-beginning langnum)) clist))) + ;; + ;; ObjC + ;; + ;; An instance Method + ((eq (aref str 0) ?-) + (setq str (concat "-" (cc-imenu-objc-method-to-selector str))) + (setq methodlist (cons (cons str + (match-beginning langnum)) + methodlist))) + ;; A factory Method + ((eq (aref str 0) ?+) + (setq str (concat "+" (cc-imenu-objc-method-to-selector str))) + (setq methodlist (cons (cons str + (match-beginning langnum)) + methodlist))) + ;; Interface or implementation or protocol + ((eq (aref str 0) ?@) + (setq classcount (1+ classcount)) + (cond + ((and (> (length str) implen) + (string= (substring str 0 implen) "@implementation")) + (setq str (substring str implen) + str2 "@implementation")) + ((string= (substring str 0 intflen) "@interface") + (setq str (substring str intflen) + str2 "@interface")) + ((string= (substring str 0 prtlen) "@protocol") + (setq str (substring str prtlen) + str2 "@protocol"))) + (setq str (cc-imenu-objc-remove-white-space str)) + (setq methodlist (cons (cons str2 + (match-beginning langnum)) + methodlist)) + (setq toplist (cons nil (cons (cons str + methodlist) toplist)) + methodlist nil)))) + ;; + (imenu-progress-message stupid 100) + (if (eq (car toplist) nil) + (setq toplist (cdr toplist))) + + ;; In this buffer, there is only one or zero @{interface|implementation|protocol}. + (if (< classcount 2) + (let ((classname (car (car toplist))) + (p (cdr (car (cdr (car toplist))))) + last) + (setq toplist (cons (cons classname p) (cdr (cdr (car toplist))))) + ;; Add C lang token + (if clist + (progn + (setq last toplist) + (while (cdr last) + (setq last (cdr last))) + (setcdr last clist)))) + ;; Add C lang tokens as a sub menu + (setq toplist (cons (cons "C" clist) toplist))) + ;; + toplist + )) + (provide 'cc-menus) ;;; cc-menus.el ends here
--- a/lisp/cc-mode/cc-mode.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/cc-mode/cc-mode.el Mon Aug 13 09:57:07 2007 +0200 @@ -7,7 +7,7 @@ ;; 1985 Richard M. Stallman ;; Maintainer: cc-mode-help@python.org ;; Created: a long, long, time ago. adapted from the original c-mode.el -;; Version: 5.17 +;; Version: 5.18 ;; Keywords: c languages oop ;; NOTE: Read the commentary below for the right way to submit bug reports! @@ -234,7 +234,8 @@ c-class-key c-ObjC-class-key c-baseclass-key nil c-access-key c-ObjC-access-key - c-method-key c-ObjC-method-key) + c-method-key c-ObjC-method-key + imenu-create-index-function 'cc-imenu-objc-function) (run-hooks 'c-mode-common-hook) (run-hooks 'objc-mode-hook) (c-update-modeline)) @@ -289,7 +290,7 @@ ;;;###autoload (defun idl-mode () "Major mode for editing CORBA's IDL code. -To submit a problem report, enter `\\[c-submit-bug-report]' from an +To submit a problem report, enter `\\[c-submit-bug-report]' from a idl-mode buffer. This automatically sets up a mail buffer with version information already added. You just need to add a description of the problem, including a reproducible test case, and send the @@ -326,7 +327,7 @@ ;; defuns for submitting bug reports -(defconst c-version "5.17" +(defconst c-version "5.18" "CC Mode version number.") (defconst c-mode-help-address
--- a/lisp/cc-mode/cc-styles.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/cc-mode/cc-styles.el Mon Aug 13 09:57:07 2007 +0200 @@ -7,7 +7,7 @@ ;; 1985 Richard M. Stallman ;; Maintainer: cc-mode-help@python.org ;; Created: 22-Apr-1997 (split from cc-mode.el) -;; Version: 5.17 +;; Version: 5.18 ;; Keywords: c languages oop ;; This file is part of GNU Emacs. @@ -570,14 +570,23 @@ ;; variables first to the `cc-mode' style before instituting the new ;; style. Only do this once! (or (assoc "cc-mode" c-style-alist) - (progn + (let (copyfunc) + ;; use built-in copy-tree if its there. + (if (fboundp 'copy-tree) + (setq copyfunc (symbol-function 'copy-tree)) + (setq copyfunc (lambda (tree) + (if (consp tree) + (cons (funcall copyfunc (car tree)) + (funcall copyfunc (cdr tree))) + tree)))) (c-add-style "cc-mode" (mapcar (function (lambda (var) (let ((val (symbol-value var))) - (cons var (if (atom val) val - (copy-sequence val) + (cons var (if (atom val) + val + (funcall copyfunc val) )) ))) '(c-backslash-column
--- a/lisp/cc-mode/cc-vars.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/cc-mode/cc-vars.el Mon Aug 13 09:57:07 2007 +0200 @@ -7,7 +7,7 @@ ;; 1985 Richard M. Stallman ;; Maintainer: cc-mode-help@python.org ;; Created: 22-Apr-1997 (split from cc-mode.el) -;; Version: 5.17 +;; Version: 5.18 ;; Keywords: c languages oop ;; This file is part of GNU Emacs.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cc-mode/custom-load.el Mon Aug 13 09:57:07 2007 +0200 @@ -0,0 +1,1 @@ +(custom-put 'c 'custom-loads '("cc-vars"))
--- a/lisp/cl/cl-defs.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/cl/cl-defs.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,470 +1,34 @@ - -;;;### (autoloads (cl-macroexpand-all cl-prettyexpand cl-progv-before hash-table-count hash-table-p cl-puthash cl-hash-lookup make-hash-table cl-do-remf cl-set-getf getf get* tailp list-length nreconc revappend notevery notany every some map cl-mapcar-many concatenate random-state-p make-random-state random* signum rem* mod* round* truncate* ceiling* floor* isqrt lcm gcd cl-float-limits cl-set-frame-visible-p cl-map-overlays cl-map-intervals cl-map-keymap-recursively cl-map-keymap mapcon mapcan mapl mapc maplist equalp coerce) "cl-extra" "cl/cl-extra.el" (12636 41267)) -;;; Generated autoloads from cl/cl-extra.el - -(autoload 'coerce "cl-extra" "\ -Coerce OBJECT to type TYPE. -TYPE is a Common Lisp type specifier." nil nil) - -(autoload 'equalp "cl-extra" "\ -T if two Lisp objects have similar structures and contents. -This is like `equal', except that it accepts numerically equal -numbers of different types (float vs. integer), and also compares -strings case-insensitively." nil nil) - -(autoload 'maplist "cl-extra" "\ -Map FUNC to each sublist of LIST or LISTS. -Like `mapcar', except applies to lists and their cdr's rather than to -the elements themselves." nil nil) - -(autoload 'mapc "cl-extra" "\ -Like `mapcar', but does not accumulate values returned by the function." nil nil) - -(autoload 'mapl "cl-extra" "\ -Like `maplist', but does not accumulate values returned by the function." nil nil) - -(autoload 'mapcan "cl-extra" "\ -Like `mapcar', but nconc's together the values returned by the function." nil nil) - -(autoload 'mapcon "cl-extra" "\ -Like `maplist', but nconc's together the values returned by the function." nil nil) - -(autoload 'cl-map-keymap "cl-extra" nil nil nil) - -(autoload 'cl-map-keymap-recursively "cl-extra" nil nil nil) - -(autoload 'cl-map-intervals "cl-extra" nil nil nil) - -(autoload 'cl-map-overlays "cl-extra" nil nil nil) - -(autoload 'cl-set-frame-visible-p "cl-extra" nil nil nil) - -(autoload 'cl-float-limits "cl-extra" nil nil nil) - -(autoload 'gcd "cl-extra" "\ -Return the greatest common divisor of the arguments." nil nil) - -(autoload 'lcm "cl-extra" "\ -Return the least common multiple of the arguments." nil nil) - -(autoload 'isqrt "cl-extra" "\ -Return the integer square root of the argument." nil nil) - -(autoload 'floor* "cl-extra" "\ -Return a list of the floor of X and the fractional part of X. -With two arguments, return floor and remainder of their quotient." nil nil) +;;; cl-defs.el --- Manually maintained autoloads for cl -(autoload 'ceiling* "cl-extra" "\ -Return a list of the ceiling of X and the fractional part of X. -With two arguments, return ceiling and remainder of their quotient." nil nil) - -(autoload 'truncate* "cl-extra" "\ -Return a list of the integer part of X and the fractional part of X. -With two arguments, return truncation and remainder of their quotient." nil nil) - -(autoload 'round* "cl-extra" "\ -Return a list of X rounded to the nearest integer and the remainder. -With two arguments, return rounding and remainder of their quotient." nil nil) - -(autoload 'mod* "cl-extra" "\ -The remainder of X divided by Y, with the same sign as Y." nil nil) - -(autoload 'rem* "cl-extra" "\ -The remainder of X divided by Y, with the same sign as X." nil nil) - -(autoload 'signum "cl-extra" "\ -Return 1 if A is positive, -1 if negative, 0 if zero." nil nil) - -(autoload 'random* "cl-extra" "\ -Return a random nonnegative number less than LIM, an integer or float. -Optional second arg STATE is a random-state object." nil nil) - -(autoload 'make-random-state "cl-extra" "\ -Return a copy of random-state STATE, or of `*random-state*' if omitted. -If STATE is t, return a new state object seeded from the time of day." nil nil) +;; Copyright (C) 1993, 1997 Free Software Foundation, Inc. -(autoload 'random-state-p "cl-extra" "\ -Return t if OBJECT is a random-state object." nil nil) - -(autoload 'concatenate "cl-extra" "\ -Concatenate, into a sequence of type TYPE, the argument SEQUENCES." nil nil) - -(autoload 'cl-mapcar-many "cl-extra" nil nil nil) - -(autoload 'map "cl-extra" "\ -Map a function across one or more sequences, returning a sequence. -TYPE is the sequence type to return, FUNC is the function, and SEQS -are the argument sequences." nil nil) - -(autoload 'some "cl-extra" "\ -Return true if PREDICATE is true of any element of SEQ or SEQs. -If so, return the true (non-nil) value returned by PREDICATE." nil nil) - -(autoload 'every "cl-extra" "\ -Return true if PREDICATE is true of every element of SEQ or SEQs." nil nil) - -(autoload 'notany "cl-extra" "\ -Return true if PREDICATE is false of every element of SEQ or SEQs." nil nil) - -(autoload 'notevery "cl-extra" "\ -Return true if PREDICATE is false of some element of SEQ or SEQs." nil nil) - -(autoload 'revappend "cl-extra" "\ -Equivalent to (append (reverse X) Y)." nil nil) - -(autoload 'nreconc "cl-extra" "\ -Equivalent to (nconc (nreverse X) Y)." nil nil) +;; Maintainer: XEmacs Development Team +;; Keywords: extensions, lisp -(autoload 'list-length "cl-extra" "\ -Return the length of a list. Return nil if list is circular." nil nil) - -(autoload 'tailp "cl-extra" "\ -Return true if SUBLIST is a tail of LIST." nil nil) - -(autoload 'get* "cl-extra" "\ -Return the value of SYMBOL's PROPNAME property, or DEFAULT if none." nil nil) - -(autoload 'getf "cl-extra" "\ -Search PROPLIST for property PROPNAME; return its value or DEFAULT. -PROPLIST is a list of the sort returned by `symbol-plist'." nil nil) - -(autoload 'cl-set-getf "cl-extra" nil nil nil) - -(autoload 'cl-do-remf "cl-extra" nil nil nil) - -(autoload 'make-hash-table "cl-extra" "\ -Make an empty Common Lisp-style hash-table. -If :test is `eq', this can use Lucid Emacs built-in hash-tables. -In non-Lucid Emacs, or with non-`eq' test, this internally uses a-lists. -Keywords supported: :test :size -The Common Lisp keywords :rehash-size and :rehash-threshold are ignored." nil nil) - -(autoload 'cl-hash-lookup "cl-extra" nil nil nil) - -(autoload 'cl-puthash "cl-extra" nil nil nil) - -(autoload 'hash-table-p "cl-extra" "\ -Return t if OBJECT is a hash table." nil nil) - -(autoload 'hash-table-count "cl-extra" "\ -Return the number of entries in HASH-TABLE." nil nil) - -(autoload 'cl-progv-before "cl-extra" nil nil nil) - -(autoload 'cl-prettyexpand "cl-extra" nil nil nil) - -(autoload 'cl-macroexpand-all "cl-extra" "\ -Expand all macro calls through a Lisp FORM. -This also does some trivial optimizations to make the form prettier." nil nil) - -;;;*** - -;;;### (autoloads (tree-equal nsublis sublis nsubst-if-not nsubst-if nsubst subst-if-not subst-if subsetp nset-exclusive-or set-exclusive-or nset-difference set-difference nintersection intersection nunion union rassoc-if-not rassoc-if rassoc* assoc-if-not assoc-if assoc* cl-adjoin member-if-not member-if member* merge stable-sort sort* search mismatch count-if-not count-if count position-if-not position-if position find-if-not find-if find nsubstitute-if-not nsubstitute-if nsubstitute substitute-if-not substitute-if substitute delete-duplicates remove-duplicates delete-if-not delete-if delete* remove-if-not remove-if remove* remove remq replace fill reduce) "cl-seq" "cl/cl-seq.el" (12559 39909)) -;;; Generated autoloads from cl/cl-seq.el - -(autoload 'reduce "cl-seq" "\ -Reduce two-argument FUNCTION across SEQUENCE. -Keywords supported: :start :end :from-end :initial-value :key" nil nil) - -(autoload 'fill "cl-seq" "\ -Fill the elements of SEQ with ITEM. -Keywords supported: :start :end" nil nil) +;; This file is part of XEmacs. -(autoload 'replace "cl-seq" "\ -Replace the elements of SEQ1 with the elements of SEQ2. -SEQ1 is destructively modified, then returned. -Keywords supported: :start1 :end1 :start2 :end2" nil nil) - -(autoload 'remq "cl-seq" nil nil nil) - -(autoload 'remove "cl-seq" nil nil nil) - -(autoload 'remove* "cl-seq" "\ -Remove all occurrences of ITEM in SEQ. -This is a non-destructive function; it makes a copy of SEQ if necessary -to avoid corrupting the original SEQ. -Keywords supported: :test :test-not :key :count :start :end :from-end" nil nil) - -(autoload 'remove-if "cl-seq" "\ -Remove all items satisfying PREDICATE in SEQ. -This is a non-destructive function; it makes a copy of SEQ if necessary -to avoid corrupting the original SEQ. -Keywords supported: :key :count :start :end :from-end" nil nil) - -(autoload 'remove-if-not "cl-seq" "\ -Remove all items not satisfying PREDICATE in SEQ. -This is a non-destructive function; it makes a copy of SEQ if necessary -to avoid corrupting the original SEQ. -Keywords supported: :key :count :start :end :from-end" nil nil) - -(autoload 'delete* "cl-seq" "\ -Remove all occurrences of ITEM in SEQ. -This is a destructive function; it reuses the storage of SEQ whenever possible. -Keywords supported: :test :test-not :key :count :start :end :from-end" nil nil) - -(autoload 'delete-if "cl-seq" "\ -Remove all items satisfying PREDICATE in SEQ. -This is a destructive function; it reuses the storage of SEQ whenever possible. -Keywords supported: :key :count :start :end :from-end" nil nil) - -(autoload 'delete-if-not "cl-seq" "\ -Remove all items not satisfying PREDICATE in SEQ. -This is a destructive function; it reuses the storage of SEQ whenever possible. -Keywords supported: :key :count :start :end :from-end" nil nil) - -(autoload 'remove-duplicates "cl-seq" "\ -Return a copy of SEQ with all duplicate elements removed. -Keywords supported: :test :test-not :key :start :end :from-end" nil nil) - -(autoload 'delete-duplicates "cl-seq" "\ -Remove all duplicate elements from SEQ (destructively). -Keywords supported: :test :test-not :key :start :end :from-end" nil nil) - -(autoload 'substitute "cl-seq" "\ -Substitute NEW for OLD in SEQ. -This is a non-destructive function; it makes a copy of SEQ if necessary -to avoid corrupting the original SEQ. -Keywords supported: :test :test-not :key :count :start :end :from-end" nil nil) - -(autoload 'substitute-if "cl-seq" "\ -Substitute NEW for all items satisfying PREDICATE in SEQ. -This is a non-destructive function; it makes a copy of SEQ if necessary -to avoid corrupting the original SEQ. -Keywords supported: :key :count :start :end :from-end" nil nil) +;; 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. -(autoload 'substitute-if-not "cl-seq" "\ -Substitute NEW for all items not satisfying PREDICATE in SEQ. -This is a non-destructive function; it makes a copy of SEQ if necessary -to avoid corrupting the original SEQ. -Keywords supported: :key :count :start :end :from-end" nil nil) - -(autoload 'nsubstitute "cl-seq" "\ -Substitute NEW for OLD in SEQ. -This is a destructive function; it reuses the storage of SEQ whenever possible. -Keywords supported: :test :test-not :key :count :start :end :from-end" nil nil) - -(autoload 'nsubstitute-if "cl-seq" "\ -Substitute NEW for all items satisfying PREDICATE in SEQ. -This is a destructive function; it reuses the storage of SEQ whenever possible. -Keywords supported: :key :count :start :end :from-end" nil nil) - -(autoload 'nsubstitute-if-not "cl-seq" "\ -Substitute NEW for all items not satisfying PREDICATE in SEQ. -This is a destructive function; it reuses the storage of SEQ whenever possible. -Keywords supported: :key :count :start :end :from-end" nil nil) - -(autoload 'find "cl-seq" "\ -Find the first occurrence of ITEM in LIST. -Return the matching ITEM, or nil if not found. -Keywords supported: :test :test-not :key :start :end :from-end" nil nil) - -(autoload 'find-if "cl-seq" "\ -Find the first item satisfying PREDICATE in LIST. -Return the matching ITEM, or nil if not found. -Keywords supported: :key :start :end :from-end" nil nil) - -(autoload 'find-if-not "cl-seq" "\ -Find the first item not satisfying PREDICATE in LIST. -Return the matching ITEM, or nil if not found. -Keywords supported: :key :start :end :from-end" nil nil) - -(autoload 'position "cl-seq" "\ -Find the first occurrence of ITEM in LIST. -Return the index of the matching item, or nil if not found. -Keywords supported: :test :test-not :key :start :end :from-end" nil nil) - -(autoload 'position-if "cl-seq" "\ -Find the first item satisfying PREDICATE in LIST. -Return the index of the matching item, or nil if not found. -Keywords supported: :key :start :end :from-end" nil nil) - -(autoload 'position-if-not "cl-seq" "\ -Find the first item not satisfying PREDICATE in LIST. -Return the index of the matching item, or nil if not found. -Keywords supported: :key :start :end :from-end" nil nil) - -(autoload 'count "cl-seq" "\ -Count the number of occurrences of ITEM in LIST. -Keywords supported: :test :test-not :key :start :end" nil nil) - -(autoload 'count-if "cl-seq" "\ -Count the number of items satisfying PREDICATE in LIST. -Keywords supported: :key :start :end" nil nil) - -(autoload 'count-if-not "cl-seq" "\ -Count the number of items not satisfying PREDICATE in LIST. -Keywords supported: :key :start :end" nil nil) - -(autoload 'mismatch "cl-seq" "\ -Compare SEQ1 with SEQ2, return index of first mismatching element. -Return nil if the sequences match. If one sequence is a prefix of the -other, the return value indicates the end of the shorted sequence. -Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end" nil nil) - -(autoload 'search "cl-seq" "\ -Search for SEQ1 as a subsequence of SEQ2. -Return the index of the leftmost element of the first match found; -return nil if there are no matches. -Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end" nil nil) - -(autoload 'sort* "cl-seq" "\ -Sort the argument SEQUENCE according to PREDICATE. -This is a destructive function; it reuses the storage of SEQUENCE if possible. -Keywords supported: :key" nil nil) - -(autoload 'stable-sort "cl-seq" "\ -Sort the argument SEQUENCE stably according to PREDICATE. -This is a destructive function; it reuses the storage of SEQUENCE if possible. -Keywords supported: :key" nil nil) - -(autoload 'merge "cl-seq" "\ -Destructively merge the two sequences to produce a new sequence. -TYPE is the sequence type to return, SEQ1 and SEQ2 are the two -argument sequences, and PRED is a `less-than' predicate on the elements. -Keywords supported: :key" nil nil) - -(autoload 'member* "cl-seq" "\ -Find the first occurrence of ITEM in LIST. -Return the sublist of LIST whose car is ITEM. -Keywords supported: :test :test-not :key" nil nil) - -(autoload 'member-if "cl-seq" "\ -Find the first item satisfying PREDICATE in LIST. -Return the sublist of LIST whose car matches. -Keywords supported: :key" nil nil) - -(autoload 'member-if-not "cl-seq" "\ -Find the first item not satisfying PREDICATE in LIST. -Return the sublist of LIST whose car matches. -Keywords supported: :key" nil nil) - -(autoload 'cl-adjoin "cl-seq" nil nil nil) - -(autoload 'assoc* "cl-seq" "\ -Find the first item whose car matches ITEM in LIST. -Keywords supported: :test :test-not :key" nil nil) - -(autoload 'assoc-if "cl-seq" "\ -Find the first item whose car satisfies PREDICATE in LIST. -Keywords supported: :key" nil nil) +;; 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. -(autoload 'assoc-if-not "cl-seq" "\ -Find the first item whose car does not satisfy PREDICATE in LIST. -Keywords supported: :key" nil nil) - -(autoload 'rassoc* "cl-seq" "\ -Find the first item whose cdr matches ITEM in LIST. -Keywords supported: :test :test-not :key" nil nil) - -(autoload 'rassoc-if "cl-seq" "\ -Find the first item whose cdr satisfies PREDICATE in LIST. -Keywords supported: :key" nil nil) - -(autoload 'rassoc-if-not "cl-seq" "\ -Find the first item whose cdr does not satisfy PREDICATE in LIST. -Keywords supported: :key" nil nil) - -(autoload 'union "cl-seq" "\ -Combine LIST1 and LIST2 using a set-union operation. -The result list contains all items that appear in either LIST1 or LIST2. -This is a non-destructive function; it makes a copy of the data if necessary -to avoid corrupting the original LIST1 and LIST2. -Keywords supported: :test :test-not :key" nil nil) - -(autoload 'nunion "cl-seq" "\ -Combine LIST1 and LIST2 using a set-union operation. -The result list contains all items that appear in either LIST1 or LIST2. -This is a destructive function; it reuses the storage of LIST1 and LIST2 -whenever possible. -Keywords supported: :test :test-not :key" nil nil) - -(autoload 'intersection "cl-seq" "\ -Combine LIST1 and LIST2 using a set-intersection operation. -The result list contains all items that appear in both LIST1 and LIST2. -This is a non-destructive function; it makes a copy of the data if necessary -to avoid corrupting the original LIST1 and LIST2. -Keywords supported: :test :test-not :key" nil nil) - -(autoload 'nintersection "cl-seq" "\ -Combine LIST1 and LIST2 using a set-intersection operation. -The result list contains all items that appear in both LIST1 and LIST2. -This is a destructive function; it reuses the storage of LIST1 and LIST2 -whenever possible. -Keywords supported: :test :test-not :key" nil nil) - -(autoload 'set-difference "cl-seq" "\ -Combine LIST1 and LIST2 using a set-difference operation. -The result list contains all items that appear in LIST1 but not LIST2. -This is a non-destructive function; it makes a copy of the data if necessary -to avoid corrupting the original LIST1 and LIST2. -Keywords supported: :test :test-not :key" nil nil) - -(autoload 'nset-difference "cl-seq" "\ -Combine LIST1 and LIST2 using a set-difference operation. -The result list contains all items that appear in LIST1 but not LIST2. -This is a destructive function; it reuses the storage of LIST1 and LIST2 -whenever possible. -Keywords supported: :test :test-not :key" nil nil) +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the +;; Free Software Foundation, 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. -(autoload 'set-exclusive-or "cl-seq" "\ -Combine LIST1 and LIST2 using a set-exclusive-or operation. -The result list contains all items that appear in exactly one of LIST1, LIST2. -This is a non-destructive function; it makes a copy of the data if necessary -to avoid corrupting the original LIST1 and LIST2. -Keywords supported: :test :test-not :key" nil nil) - -(autoload 'nset-exclusive-or "cl-seq" "\ -Combine LIST1 and LIST2 using a set-exclusive-or operation. -The result list contains all items that appear in exactly one of LIST1, LIST2. -This is a destructive function; it reuses the storage of LIST1 and LIST2 -whenever possible. -Keywords supported: :test :test-not :key" nil nil) - -(autoload 'subsetp "cl-seq" "\ -True if LIST1 is a subset of LIST2. -I.e., if every element of LIST1 also appears in LIST2. -Keywords supported: :test :test-not :key" nil nil) - -(autoload 'subst-if "cl-seq" "\ -Substitute NEW for elements matching PREDICATE in TREE (non-destructively). -Return a copy of TREE with all matching elements replaced by NEW. -Keywords supported: :key" nil nil) - -(autoload 'subst-if-not "cl-seq" "\ -Substitute NEW for elts not matching PREDICATE in TREE (non-destructively). -Return a copy of TREE with all non-matching elements replaced by NEW. -Keywords supported: :key" nil nil) +;;; Synched up with: Not synched. -(autoload 'nsubst "cl-seq" "\ -Substitute NEW for OLD everywhere in TREE (destructively). -Any element of TREE which is `eql' to OLD is changed to NEW (via a call -to `setcar'). -Keywords supported: :test :test-not :key" nil nil) - -(autoload 'nsubst-if "cl-seq" "\ -Substitute NEW for elements matching PREDICATE in TREE (destructively). -Any element of TREE which matches is changed to NEW (via a call to `setcar'). -Keywords supported: :key" nil nil) +;;; Commentary: + +;; At one time this file appears to have been generated by autoload.el. -(autoload 'nsubst-if-not "cl-seq" "\ -Substitute NEW for elements not matching PREDICATE in TREE (destructively). -Any element of TREE which matches is changed to NEW (via a call to `setcar'). -Keywords supported: :key" nil nil) - -(autoload 'sublis "cl-seq" "\ -Perform substitutions indicated by ALIST in TREE (non-destructively). -Return a copy of TREE with all matching elements replaced. -Keywords supported: :test :test-not :key" nil nil) - -(autoload 'nsublis "cl-seq" "\ -Perform substitutions indicated by ALIST in TREE (destructively). -Any matching element of TREE is changed via a call to `setcar'. -Keywords supported: :test :test-not :key" nil nil) - -(autoload 'tree-equal "cl-seq" "\ -T if trees X and Y have `eql' leaves. -Atoms are compared by `eql'; cons cells are compared recursively. -Keywords supported: :test :test-not :key" nil nil) +;;; Code: ;;;*** @@ -793,3 +357,5 @@ and then returning foo." nil 'macro) ;;;*** + +;;; cl-defs.el ends here
--- a/lisp/comint/custom-load.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/comint/custom-load.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,10 +1,12 @@ -(custom-put 'background 'custom-loads '("background")) -(custom-put 'comint 'custom-loads '("comint-xemacs" "comint" "telnet")) -(custom-put 'comint-completion 'custom-loads '("comint")) -(custom-put 'comint-source 'custom-loads '("comint")) -(custom-put 'rlogin 'custom-loads '("rlogin")) -(custom-put 'shell 'custom-loads '("shell")) -(custom-put 'shell-directories 'custom-loads '("shell")) -(custom-put 'shell-faces 'custom-loads '("shell")) (custom-put 'ssh 'custom-loads '("ssh")) (custom-put 'telnet 'custom-loads '("telnet")) +(custom-put 'shell 'custom-loads '("shell")) +(custom-put 'comint-completion 'custom-loads '("comint")) +(custom-put 'comint 'custom-loads '("comint" "telnet")) +(custom-put 'rlogin 'custom-loads '("rlogin")) +(custom-put 'shell-faces 'custom-loads '("shell")) +(custom-put 'shell-directories 'custom-loads '("shell")) +(custom-put 'comint-source 'custom-loads '("comint")) +(custom-put 'processes 'custom-loads '("background" "comint" "rlogin" "shell" "ssh")) +(custom-put 'background 'custom-loads '("background")) +(custom-put 'unix 'custom-loads '("rlogin" "shell" "ssh"))
--- a/lisp/custom/ChangeLog Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/custom/ChangeLog Mon Aug 13 09:57:07 2007 +0200 @@ -1,3 +1,29 @@ +Mon Sep 15 19:40:19 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * Version 1.9958 released. + +Mon Sep 15 19:23:36 1997 Hrvoje Niksic <hniksic@srce.hr> + + * 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 <abraham@dina.kvl.dk> + + * Version 1.9957 released. + +Tue Aug 26 19:43:14 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * 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 <abraham@dina.kvl.dk> + + * 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 <abraham@dina.kvl.dk> * Version 1.9956 released.
--- a/lisp/custom/cus-edit.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/custom/cus-edit.el Mon Aug 13 09:57:07 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, faces -;; Version: 1.9956 +;; Version: 1.9958 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;; This file is part of GNU Emacs. @@ -1960,7 +1960,7 @@ ("Don't show as Lisp expression" custom-variable-edit (lambda (widget) (eq (widget-get widget :custom-form) 'lisp))) - ("Show as Lisp expression" custom-variable-edit-lisp + ("Show initial Lisp expression" custom-variable-edit-lisp (lambda (widget) (eq (widget-get widget :custom-form) 'edit)))) "Alist of actions for the `custom-variable' widget. @@ -2023,7 +2023,7 @@ (custom-redraw-magic widget))) (defun custom-variable-save (widget) - "Set the default value for the variable being edited by WIDGET." + "Set and save the value for the variable being edited by WIDGET." (let* ((form (widget-get widget :custom-form)) (state (widget-get widget :custom-state)) (child (car (widget-get widget :children))) @@ -3093,25 +3093,31 @@ (let* ((item (vector (custom-unlispify-menu-entry symbol) `(customize-group ',symbol) t))) - (if (and (or (not (boundp 'custom-menu-nesting)) - (>= custom-menu-nesting 0)) - (< (length (get symbol 'custom-group)) widget-menu-max-size)) - (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))) - (custom-load-symbol symbol) - `(,(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))) - item))) + ;; 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)))) ;;;###autoload (defun customize-menu-create (symbol &optional name)
--- a/lisp/custom/cus-face.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/custom/cus-face.el Mon Aug 13 09:57:07 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, faces -;; Version: 1.9956 +;; Version: 1.9958 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary:
--- a/lisp/custom/custom-load.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/custom/custom-load.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,53 +1,25 @@ -(custom-put 'emacs 'custom-loads '("cus-edit")) -(custom-put 'editing 'custom-loads '("cus-edit")) -(custom-put 'abbrev 'custom-loads '("cus-edit")) -(custom-put 'matching 'custom-loads '()) -(custom-put 'mouse 'custom-loads '()) -(custom-put 'external 'custom-loads '("cus-edit")) -(custom-put 'processes 'custom-loads '("cus-edit")) -(custom-put 'programming 'custom-loads '("cus-edit")) -(custom-put 'languages 'custom-loads '("cus-edit")) -(custom-put 'lisp 'custom-loads '()) +(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 'environment 'custom-loads '("cus-edit")) +(custom-put 'custom-menu 'custom-loads '("cus-edit")) +(custom-put 'internal 'custom-loads '("cus-edit")) +(custom-put 'hypermedia 'custom-loads '("wid-edit")) (custom-put 'applications 'custom-loads '("cus-edit")) -(custom-put 'calendar 'custom-loads '()) -(custom-put 'development 'custom-loads '("cus-edit")) -(custom-put 'extensions 'custom-loads '("wid-edit")) -(custom-put 'internal 'custom-loads '("cus-edit")) -(custom-put 'maint 'custom-loads '()) -(custom-put 'environment 'custom-loads '("cus-edit")) -(custom-put 'i18n 'custom-loads '("cus-edit")) -(custom-put 'x 'custom-loads '()) -(custom-put 'frames 'custom-loads '()) -(custom-put 'data 'custom-loads '()) -(custom-put 'files 'custom-loads '("cus-edit")) -(custom-put 'wp 'custom-loads '("cus-edit")) -(custom-put 'faces 'custom-loads '("cus-edit" "wid-edit")) -(custom-put 'hypermedia 'custom-loads '("wid-edit")) (custom-put 'help 'custom-loads '("cus-edit")) -(custom-put 'local 'custom-loads '()) -(custom-put 'customize 'custom-loads '("cus-edit" "wid-edit" "cus-face")) -(custom-put 'custom-faces 'custom-loads '("cus-edit")) +(custom-put 'widget-browse 'custom-loads '("wid-browse")) +(custom-put 'customize 'custom-loads '("wid-edit" "cus-edit" "cus-face")) (custom-put 'custom-browse 'custom-loads '("cus-edit")) -(custom-put 'custom-buffer 'custom-loads '("cus-edit")) -(custom-put 'custom-menu 'custom-loads '("cus-edit")) -(custom-put 'alloc 'custom-loads '()) -(custom-put 'undo 'custom-loads '()) -(custom-put 'modeline 'custom-loads '()) -(custom-put 'fill 'custom-loads '()) -(custom-put 'editing-basics 'custom-loads '()) -(custom-put 'display 'custom-loads '()) -(custom-put 'execute 'custom-loads '()) -(custom-put 'dired 'custom-loads '()) -(custom-put 'limits 'custom-loads '()) -(custom-put 'debug 'custom-loads '()) -(custom-put 'minibuffer 'custom-loads '()) -(custom-put 'keyboard 'custom-loads '()) -(custom-put 'auto-save 'custom-loads '()) -(custom-put 'processes-basics 'custom-loads '()) -(custom-put 'windows 'custom-loads '()) -(custom-put 'custom-magic-faces 'custom-loads '("cus-edit")) -(custom-put 'widget-browse 'custom-loads '("wid-browse")) -(custom-put 'widgets 'custom-loads '("wid-browse" "wid-edit")) -(custom-put 'widget-documentation 'custom-loads '("wid-edit")) -(custom-put 'widget-faces 'custom-loads '("wid-edit")) -(custom-put 'widget-button 'custom-loads '("wid-edit")) +(custom-put 'abbrev 'custom-loads '("cus-edit")) +(custom-put 'programming 'custom-loads '("cus-edit")) +(custom-put 'files 'custom-loads '("cus-edit")) +(custom-put 'external 'custom-loads '("cus-edit")) +(custom-put 'development 'custom-loads '("cus-edit")) +(custom-put 'languages 'custom-loads '("cus-edit")) +(custom-put 'faces 'custom-loads '("cus-edit" "wid-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"))
--- a/lisp/custom/custom.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/custom/custom.el Mon Aug 13 09:57:07 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, faces -;; Version: 1.9956 +;; Version: 1.9958 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;; This file is part of GNU Emacs. @@ -136,7 +136,7 @@ (put symbol 'force-value nil)) (when doc (put symbol 'variable-documentation doc)) - (let ((initialize 'custom-initialize-set) + (let ((initialize 'custom-initialize-reset) (requests nil)) (while args (let ((arg (car args)))
--- a/lisp/custom/wid-browse.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/custom/wid-browse.el Mon Aug 13 09:57:07 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: extensions -;; Version: 1.9956 +;; Version: 1.9958 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;; This file is part of GNU Emacs.
--- a/lisp/custom/wid-edit.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/custom/wid-edit.el Mon Aug 13 09:57:07 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: extensions -;; Version: 1.9956 +;; Version: 1.9958 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;; This file is part of GNU Emacs.
--- a/lisp/custom/widget-example.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/custom/widget-example.el Mon Aug 13 09:57:07 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, extensions, faces, hypermedia -;; Version: 1.9956 +;; Version: 1.9958 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ (require 'widget)
--- a/lisp/custom/widget.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/custom/widget.el Mon Aug 13 09:57:07 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, extensions, faces, hypermedia -;; Version: 1.9956 +;; Version: 1.9958 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;; This file is part of GNU Emacs.
--- a/lisp/edebug/custom-load.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/edebug/custom-load.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,1 +1,2 @@ +(custom-put 'lisp 'custom-loads '("edebug")) (custom-put 'edebug 'custom-loads '("edebug"))
--- a/lisp/ediff/custom-load.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/ediff/custom-load.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,5 +1,7 @@ -(custom-put 'ediff 'custom-loads '("ediff-diff" "ediff-merg" "ediff-mult" "ediff-ptch" "ediff-wind" "ediff" "ediff-init")) +(custom-put 'tools 'custom-loads '("ediff")) +(custom-put 'ediff-diff 'custom-loads '("ediff-diff")) +(custom-put 'frames 'custom-loads '("ediff-wind")) (custom-put 'ediff-ptch 'custom-loads '("ediff-ptch")) +(custom-put 'ediff-merge 'custom-loads '("ediff-merg")) (custom-put 'ediff-mult 'custom-loads '("ediff-mult")) -(custom-put 'ediff-merge 'custom-loads '("ediff-merg")) -(custom-put 'ediff-diff 'custom-loads '("ediff-diff")) +(custom-put 'ediff 'custom-loads '("ediff-diff" "ediff-init" "ediff-merg" "ediff-mult" "ediff-ptch" "ediff-wind" "ediff"))
--- a/lisp/efs/auto-autoloads.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/efs/auto-autoloads.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,5 +1,5 @@ ;;; DO NOT MODIFY THIS FILE -(if (featurep 'efs-autoloads) (error "Already loaded")) +(if (featurep '-autoloads) (error "Already loaded")) ;;;### (autoloads nil "default-dir" "efs/default-dir.el") @@ -265,4 +265,4 @@ ;;;*** -(provide 'efs-autoloads) +(provide '-autoloads)
--- a/lisp/efs/custom-load.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/efs/custom-load.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,1 +1,2 @@ +(custom-put 'environment 'custom-loads '("dired-faces")) (custom-put 'dired 'custom-loads '("dired-faces"))
--- a/lisp/emulators/custom-load.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/emulators/custom-load.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,1 +1,2 @@ +(custom-put 'emulations 'custom-loads '("crisp")) (custom-put 'emulations-crisp 'custom-loads '("crisp"))
--- a/lisp/eterm/custom-load.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/eterm/custom-load.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,1 +1,3 @@ (custom-put 'term 'custom-loads '("term")) +(custom-put 'processes 'custom-loads '("term")) +(custom-put 'unix 'custom-loads '("term"))
--- a/lisp/games/custom-load.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/games/custom-load.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,1 +1,2 @@ +(custom-put 'games 'custom-loads '("xmine")) (custom-put 'xmine 'custom-loads '("xmine"))
--- a/lisp/games/tetris.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/games/tetris.el Mon Aug 13 09:57:07 2007 +0200 @@ -45,6 +45,7 @@ ;; Modified: 1997-09-09, changed layout to work in a 22 line window ;; Modified: 1997-09-12 ;; fixed tetris-shift-down to deal with multiple rows correctly +;; Modified: 1997-09-14, added tetris-setup-default-face ;; URL: ftp://sensei.co.uk/misc/tetris.el.gz ;; Tested with XEmacs 20.3-beta and Emacs 19.34 ;; Reported to work with XEmacs 19.15 and 20.2 @@ -463,6 +464,16 @@ nil 'remove-locale) (setq buffer-display-table tetris-display-table))) +(defun tetris-setup-default-face () + (cond ((eq tetris-display-mode 'glyph) + (let* ((font-spec (face-property 'default 'font)) + (name (font-name font-spec)) + (glyph (aref tetris-display-table tetris-blank)) + (height (glyph-height glyph))) + (while (> (font-height font-spec) height) + (setq name (x-find-smaller-font name)) + (add-spec-to-specifier font-spec name (current-buffer))))))) + (defun tetris-hide-cursor () (if (fboundp 'specifierp) (set-specifier text-cursor-visible-p nil (current-buffer)))) @@ -791,6 +802,7 @@ (buffer-disable-undo (current-buffer)) (tetris-initialize-display) + (tetris-setup-default-face) (tetris-set-display-table) (tetris-hide-cursor)
--- a/lisp/hm--html-menus/custom-load.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/hm--html-menus/custom-load.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,12 +1,15 @@ -(custom-put 'tmpl-minor 'custom-loads '("tmpl-minor-mode")) -(custom-put 'idd-drag-and-drop 'custom-loads '("internal-drag-and-drop")) -(custom-put 'hm--html-indentation 'custom-loads '("hm--html-configuration")) -(custom-put 'hm--html-hooks 'custom-loads '("hm--html-configuration")) -(custom-put 'hm--html-display 'custom-loads '("hm--html-configuration")) -(custom-put 'hm--html-keys 'custom-loads '("hm--html-configuration")) -(custom-put 'hm--html-templates 'custom-loads '("hm--html-configuration")) (custom-put 'hm--html-links 'custom-loads '("hm--html-configuration")) (custom-put 'hm--html-menus 'custom-loads '("hm--html-configuration")) +(custom-put 'mouse 'custom-loads '("internal-drag-and-drop")) +(custom-put 'hm--html-display 'custom-loads '("hm--html-configuration")) +(custom-put 'idd-drag-and-drop 'custom-loads '("internal-drag-and-drop")) +(custom-put 'hypermedia 'custom-loads '("hm--html-configuration")) +(custom-put 'hm--html-keys 'custom-loads '("hm--html-configuration")) +(custom-put 'hm--html-indentation 'custom-loads '("hm--html-configuration")) +(custom-put 'data 'custom-loads '("tmpl-minor-mode")) +(custom-put 'hm--html-hooks 'custom-loads '("hm--html-configuration")) (custom-put 'hm--html-document-information 'custom-loads '("hm--html-configuration")) +(custom-put 'hm--html 'custom-loads '("hm--html-configuration")) +(custom-put 'hm--html-templates 'custom-loads '("hm--html-configuration")) (custom-put 'hm--html-files 'custom-loads '("hm--html-configuration")) -(custom-put 'hm--html 'custom-loads '("hm--html-configuration")) +(custom-put 'tmpl-minor 'custom-loads '("tmpl-minor-mode"))
--- a/lisp/hyperbole/auto-autoloads.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/hyperbole/auto-autoloads.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,5 +1,5 @@ ;;; DO NOT MODIFY THIS FILE -(if (featurep 'hyperbole-autoloads) (error "Already loaded")) +(if (featurep '-autoloads) (error "Already loaded")) ;;;### (autoloads (hmail:compose) "hmail" "hyperbole/hmail.el") @@ -420,4 +420,4 @@ ;;;*** -(provide 'hyperbole-autoloads) +(provide '-autoloads)
--- a/lisp/iso/auto-autoloads.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/iso/auto-autoloads.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,6 +1,5 @@ ;;; DO NOT MODIFY THIS FILE (if (featurep 'iso-autoloads) (error "Already loaded")) - ;;;### (autoloads (iso-accents-mode) "iso-acc" "iso/iso-acc.el")
--- a/lisp/leim/auto-autoloads.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/leim/auto-autoloads.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,6 +1,5 @@ ;;; DO NOT MODIFY THIS FILE (if (featurep 'leim-autoloads) (error "Already loaded")) - ;;;### (autoloads (quail-use-package) "quail" "leim/quail.el")
--- a/lisp/mh-e/custom-load.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/mh-e/custom-load.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,4 +1,5 @@ -(custom-put 'mh-buffer 'custom-loads '("mh-utils")) +(custom-put 'mail 'custom-loads '("mh-e")) (custom-put 'mh-hook 'custom-loads '("mh-e")) +(custom-put 'mh-buffer 'custom-loads '("mh-utils")) +(custom-put 'mh-compose 'custom-loads '("mh-comp")) (custom-put 'mh 'custom-loads '("mh-comp" "mh-e" "mh-utils")) -(custom-put 'mh-compose 'custom-loads '("mh-comp"))
--- a/lisp/modes/ada-mode.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/modes/ada-mode.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,35 +1,38 @@ ;;; ada-mode.el --- An Emacs major-mode for editing Ada source. -;;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. - -;;; Authors: Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de> -;;; Rolf Ebert <ebert@inf.enst.fr> - -;;; 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 + +;; Copyright (C) 1994, 1995, 1997 Free Software Foundation, Inc. + +;; Authors: Rolf Ebert <ebert@inf.enst.fr> +;; Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de> +;; Keywords: languages oop ada +;; Rolf Ebert's version: 2.27 + +;; 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. +;; 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. ;;; This mode is a complete rewrite of a major mode for editing Ada 83 ;;; and Ada 95 source code under Emacs-19. It contains completely new ;;; indenting code and support for code browsing (see ada-xref). -;;; Synched up with: FSF 19.34. +;;; Synched up with: FSF 20.1 ;;; USAGE ;;; ===== -;;; Emacs should enter ada-mode when you load an ada source (*.ad[abs]). +;;; Emacs should enter Ada mode when you load an Ada source (*.ad[abs]). ;;; ;;; When you have entered ada-mode, you may get more info by pressing ;;; C-h m. You may also get online help describing various functions by: @@ -53,7 +56,7 @@ ;;; electric-ada.el. ;;; ;;; The current Ada mode is a complete rewrite by M. Heritsch and -;;; R. Ebert. Some ideas from the ada-mode mailing list have been +;;; R. Ebert. Some ideas from the Ada mode mailing list have been ;;; added. Some of the functionality of L. Slater's mode has not ;;; (yet) been recoded in this new mode. Perhaps you prefer sticking ;;; to his version. @@ -65,15 +68,18 @@ ;;; In the presence of comments and/or incorrect syntax ;;; ada-format-paramlist produces weird results. ;;; ------------------- -;;; Indenting of some tasking constructs is still buggy. +;;; Character constants with otherwise syntactic relevant characters +;;; like `(' or `"' throw indentation off the track. Fontification +;;; should work now in Emacs-19.35 +;;; C : constant Character := Character'('"'); ;;; ------------------- -;;; package Test is -;;; -- If I hit return on the "type" line it will indent the next line -;;; -- in another 3 space instead of heading out to the "(". If I hit -;;; -- tab or return it reindents the line correctly but does not initially. -;;; type Wait_Return is (Read_Success, Read_Timeout, Wait_Timeout, -;;; Nothing_To_Wait_For_In_Wait_List); -;;; ------------------- + + +;;; TODO +;;; ==== +;;; +;;; o bodify-single-subprogram +;;; o make a function "separate" and put it in the corresponding file. @@ -92,43 +98,70 @@ ;;; USER OPTIONS ;;;-------------------- + +;; ---- customize support + +(defgroup ada nil + "Major mode for editing Ada source in Emacs" + :group 'languages) + ;; ---- configure indentation -(defvar ada-indent 3 - "*Defines the size of Ada indentation.") - -(defvar ada-broken-indent 2 - "*# of columns to indent the continuation of a broken line.") - -(defvar ada-label-indent -4 - "*# of columns to indent a label.") - -(defvar ada-stmt-end-indent 0 +(defcustom ada-indent 3 + "*Defines the size of Ada indentation." + :type 'integer + :group 'ada) + +(defcustom ada-broken-indent 2 + "*# of columns to indent the continuation of a broken line." + :type 'integer + :group 'ada) + +(defcustom ada-label-indent -4 + "*# of columns to indent a label." + :type 'integer + :group 'ada) + +(defcustom ada-stmt-end-indent 0 "*# of columns to indent a statement end keyword in a separate line. -Examples are 'is', 'loop', 'record', ...") - -(defvar ada-when-indent 3 - "*Defines the indentation for 'when' relative to 'exception' or 'case'.") - -(defvar ada-indent-record-rel-type 3 - "*Defines the indentation for 'record' relative to 'type' or 'use'.") - -(defvar ada-indent-comment-as-code t - "*If non-nil, comment-lines get indented as Ada code.") - -(defvar ada-indent-is-separate t - "*If non-nil, 'is separate' or 'is abstract' on a single line are indented.") - -(defvar ada-indent-to-open-paren t - "*If non-nil, indent according to the innermost open parenthesis.") - -(defvar ada-search-paren-char-count-limit 3000 - "*Search that many characters for an open parenthesis.") +Examples are 'is', 'loop', 'record', ..." + :type 'integer + :group 'ada) + +(defcustom ada-when-indent 3 + "*Defines the indentation for 'when' relative to 'exception' or 'case'." + :type 'integer + :group 'ada) + +(defcustom ada-indent-record-rel-type 3 + "*Defines the indentation for 'record' relative to 'type' or 'use'." + :type 'integer + :group 'ada) + +(defcustom ada-indent-comment-as-code t + "*If non-nil, comment-lines get indented as Ada code." + :type 'boolean + :group 'ada) + +(defcustom ada-indent-is-separate t + "*If non-nil, 'is separate' or 'is abstract' on a single line are indented." + :type 'boolean + :group 'ada) + +(defcustom ada-indent-to-open-paren t + "*If non-nil, indent according to the innermost open parenthesis." + :type 'boolean + :group 'ada) + +(defcustom ada-search-paren-char-count-limit 3000 + "*Search that many characters for an open parenthesis." + :type 'integer + :group 'ada) ;; ---- other user options -(defvar ada-tab-policy 'indent-auto +(defcustom ada-tab-policy 'indent-auto "*Control behaviour of the TAB key. Must be one of `indent-rigidly', `indent-auto', `gei', `indent-af' or `always-tab'. @@ -137,74 +170,173 @@ `indent-auto' : use indentation functions in this file. `gei' : use David Kågedal's Generic Indentation Engine. `indent-af' : use Gary E. Barnes' ada-format.el -`always-tab' : do indent-relative.") - -(defvar ada-move-to-declaration nil +`always-tab' : do indent-relative." + :type '(choice (const indent-auto) + (const indent-rigidly) + (const gei) + (const indent-af) + (const always-tab)) + :group 'ada) + +(defcustom ada-move-to-declaration nil "*If non-nil, `ada-move-to-start' moves point to the subprog declaration, -not to 'begin'.") - -(defvar ada-spec-suffix ".ads" - "*Suffix of Ada specification files.") - -(defvar ada-body-suffix ".adb" - "*Suffix of Ada body files.") - -(defvar ada-language-version 'ada95 - "*Do we program in `ada83' or `ada95'?") - -(defvar ada-case-keyword 'downcase-word +not to 'begin'." + :type 'boolean + :group 'ada) + +(defcustom ada-spec-suffix ".ads" + "*Suffix of Ada specification files." + :type 'string + :group 'ada) + +(defcustom ada-body-suffix ".adb" + "*Suffix of Ada body files." + :type 'string + :group 'ada) + +(defcustom ada-spec-suffix-as-regexp "\\.ads$" + "*Regexp to find Ada specification files." + :type 'string + :group 'ada) + +(defcustom ada-body-suffix-as-regexp "\\.adb$" + "*Regexp to find Ada body files." + :type 'string + :group 'ada) + +(defvar ada-other-file-alist + (list + (list ada-spec-suffix-as-regexp (list ada-body-suffix)) + (list ada-body-suffix-as-regexp (list ada-spec-suffix)) + ) + "*Alist of extensions to find given the current file's extension. + +This list should contain the most used extensions before the others, +since the search algorithm searches sequentially through each directory +specified in `ada-search-directories'. If a file is not found, a new one +is created with the first matching extension (`.adb' yields `.ads').") + +(defcustom ada-search-directories + '("." "/usr/adainclude" "/usr/local/adainclude" "/opt/gnu/adainclude") + "*List of directories to search for Ada files. +See the description for the `ff-search-directories' variable." + :type '(repeat (choice :tag "Directory" + (const :tag "default" nil) + (directory :format "%v"))) + :group 'ada) + +(defcustom ada-language-version 'ada95 + "*Do we program in `ada83' or `ada95'?" + :type '(choice (const ada83) + (const ada95)) + :group 'ada) + +(defcustom ada-case-keyword 'downcase-word "*Function to call to adjust the case of Ada keywords. -It may be `downcase-word', `upcase-word', `ada-loose-case-word' or -`capitalize-word'.") - -(defvar ada-case-identifier 'ada-loose-case-word +It may be `downcase-word', `upcase-word', `ada-loose-case-word' or +`capitalize-word'." + :type '(choice (const downcase-word) + (const upcase-word) + (const capitalize-word) + (const ada-loose-case-word)) + :group 'ada) + +(defcustom ada-case-identifier 'ada-loose-case-word "*Function to call to adjust the case of an Ada identifier. -It may be `downcase-word', `upcase-word', `ada-loose-case-word' or -`capitalize-word'.") - -(defvar ada-case-attribute 'capitalize-word +It may be `downcase-word', `upcase-word', `ada-loose-case-word' or +`capitalize-word'." + :type '(choice (const downcase-word) + (const upcase-word) + (const capitalize-word) + (const ada-loose-case-word)) + :group 'ada) + +(defcustom ada-case-attribute 'capitalize-word "*Function to call to adjust the case of Ada attributes. -It may be `downcase-word', `upcase-word', `ada-loose-case-word' or -`capitalize-word'.") - -(defvar ada-auto-case t +It may be `downcase-word', `upcase-word', `ada-loose-case-word' or +`capitalize-word'." + :type '(choice (const downcase-word) + (const upcase-word) + (const capitalize-word) + (const ada-loose-case-word)) + :group 'ada) + +(defcustom ada-auto-case t "*Non-nil automatically changes case of preceding word while typing. Casing is done according to `ada-case-keyword', `ada-case-identifier' -and `ada-cacse-attribute'.") - -(defvar ada-clean-buffer-before-saving nil - "*If non-nil, `remove-trailing-spaces' and `untabify' buffer before saving.") +and `ada-case-attribute'." + :type 'boolean + :group 'ada) + +(defcustom ada-clean-buffer-before-saving t + "*If non-nil, `remove-trailing-spaces' and `untabify' buffer before saving." + :type 'boolean + :group 'ada) (defvar ada-mode-hook nil - "*List of functions to call when Ada Mode is invoked. + "*List of functions to call when Ada mode is invoked. This is a good place to add Ada environment specific bindings.") -(defvar ada-external-pretty-print-program "aimap" - "*External pretty printer to call from within Ada Mode.") - -(defvar ada-tmp-directory "/tmp/" - "*Directory to store the temporary file for the Ada pretty printer.") - -(defvar ada-fill-comment-prefix "-- " - "*This is inserted in the first columns when filling a comment paragraph.") - -(defvar ada-fill-comment-postfix " --" - "*This is inserted at the end of each line when filling a comment paragraph -with `ada-fill-comment-paragraph-postfix'.") - -(defvar ada-krunch-args "0" - "*Argument of gnatk8, a string containing the max number of characters. -Set to 0, if you don't use crunched filenames.") +(defcustom ada-external-pretty-print-program "aimap" + "*External pretty printer to call from within Ada mode." + :type 'string + :group 'ada) + +(defcustom ada-tmp-directory "/tmp/" + "*Directory to store the temporary file for the Ada pretty printer." + :type 'string + :group 'ada) + +(defcustom ada-compile-options "-c" + "*Buffer local options passed to the Ada compiler. +These options are used when the compiler is invoked on the current buffer." + :type 'string + :group 'ada) +(make-variable-buffer-local 'ada-compile-options) + +(defcustom ada-make-options "-c" + "*Buffer local options passed to `ada-compiler-make' (usually `gnatmake'). +These options are used when `gnatmake' is invoked on the current buffer." + :type 'string + :group 'ada) +(make-variable-buffer-local 'ada-make-options) + +(defcustom ada-compiler-syntax-check "gcc -c -gnats" + "*Compiler command with options for syntax checking." + :type 'string + :group 'ada) + +(defcustom ada-compiler-make "gnatmake" + "*The `make' command for the given compiler." + :type 'string + :group 'ada) + +(defcustom ada-fill-comment-prefix "-- " + "*This is inserted in the first columns when filling a comment paragraph." + :type 'string + :group 'ada) + +(defcustom ada-fill-comment-postfix " --" + "*This is inserted at the end of each line when filling a comment paragraph. +with `ada-fill-comment-paragraph-postfix'." + :type 'string + :group 'ada) + +(defcustom ada-krunch-args "0" + "*Argument of gnatkr, a string containing the max number of characters. +Set to 0, if you don't use crunched filenames." + :type 'string + :group 'ada) ;;; ---- end of user configurable variables (defvar ada-mode-abbrev-table nil - "Abbrev table used in Ada Mode.") + "Abbrev table used in Ada mode.") (define-abbrev-table 'ada-mode-abbrev-table ()) (defvar ada-mode-map () - "Local keymap used for Ada Mode.") + "Local keymap used for Ada mode.") (defvar ada-mode-syntax-table nil "Syntax table to be used for editing Ada source code.") @@ -279,9 +411,9 @@ (defvar ada-end-stmt-re "\\(;\\|=>\\|^[ \t]*separate[ \t]+([a-zA-Z0-9_\\.]+)\\|\ -\\<\\(begin\\|else\\|record\\|loop\\|select\\|do\\|\ +\\<\\(begin\\|else\\|record\\|loop\\|select\\|do\\|then\\|\ declare\\|generic\\|private\\)\\>\\|\ -^[ \t]*\\(package\\|procedure\\|function\\)[ \ta-zA-Z0-9_\\.]+is\\|\ +^[ \t]*\\(package\\|procedure\\|function\\)\\>[ \ta-zA-Z0-9_\\.]+\\<is\\>\\|\ ^[ \t]*exception\\>\\)" "Regexp of possible ends for a non-broken statement. A new statement starts after these.") @@ -295,12 +427,16 @@ task\\|accept\\|entry\\)\\>" "Regexp for the start of a subprogram.") +(defvar ada-named-block-re + "[ \t]*[a-zA-Z_0-9]+ *:[^=]" + "Regexp of the name of a block or loop.") + ;; Written by Christian Egli <Christian.Egli@hcsd.hac.com> ;; (defvar ada-imenu-generic-expression - '((nil "^\\s-*\\(procedure\\|function\\)\\s-+\\([A-Za-z0-9_]+\\)" 2) - ("Type Defs" "^\\s-*\\(sub\\)?type\\s-+\\([A-Za-z0-9_]+\\)" 2)) + '((nil "^\\s-*\\(procedure\\|function\\)\\s-+\\([A-Za-z0-9_]+\\)" 2) + ("Type Defs" "^\\s-*\\(sub\\)?type\\s-+\\([A-Za-z0-9_]+\\)" 2)) "Imenu generic expression for Ada mode. See `imenu-generic-expression'.") @@ -313,7 +449,7 @@ (string-match "XEmacs" emacs-version))) (defun ada-create-syntax-table () - "Create the syntax table for Ada Mode." + "Create the syntax table for Ada mode." ;; There are two different syntax-tables. The standard one declares ;; `_' as a symbol constituent, in the second one, it is a word ;; constituent. For some search and replacing routines we @@ -321,8 +457,10 @@ (setq ada-mode-syntax-table (make-syntax-table)) (set-syntax-table ada-mode-syntax-table) - ;; define string brackets (% is alternative string bracket) - (modify-syntax-entry ?% "\"" ada-mode-syntax-table) + ;; define string brackets (`%' is alternative string bracket, but + ;; almost never used as such and throws font-lock and indentation + ;; off the track.) + (modify-syntax-entry ?% "$" ada-mode-syntax-table) (modify-syntax-entry ?\" "\"" ada-mode-syntax-table) (modify-syntax-entry ?\# "$" ada-mode-syntax-table) @@ -353,7 +491,7 @@ (modify-syntax-entry ?\f "> " ada-mode-syntax-table) (modify-syntax-entry ?\n "> " ada-mode-syntax-table) - ;; define what belongs in ada symbols + ;; define what belongs in Ada symbols (modify-syntax-entry ?_ "_" ada-mode-syntax-table) ;; define parentheses to match @@ -367,7 +505,7 @@ ;;;###autoload (defun ada-mode () - "Ada Mode is the major mode for editing Ada code. + "Ada mode is the major mode for editing Ada code. Bindings are as follows: (Note: 'LFD' is control-j.) @@ -387,7 +525,7 @@ Fill comment paragraph and justify each line '\\[ada-fill-comment-paragraph-justify]' Fill comment paragraph, justify and append postfix '\\[ada-fill-comment-paragraph-postfix]' - Next func/proc/task '\\[ada-next-procedure]' Previous func/proc/task '\\[ada-previous-procedure]' + Next func/proc/task '\\[ada-next-procedure]' Previous func/proc/task '\\[ada-previous-procedure]' Next package '\\[ada-next-package]' Previous package '\\[ada-previous-package]' Goto matching start of current 'end ...;' '\\[ada-move-to-start]' @@ -448,25 +586,40 @@ (make-local-variable 'case-fold-search) (setq case-fold-search t) + (make-local-variable 'outline-regexp) + (setq outline-regexp "[^\n\^M]") + (make-local-variable 'outline-level) + (setq outline-level 'ada-outline-level) + (make-local-variable 'fill-paragraph-function) (setq fill-paragraph-function 'ada-fill-comment-paragraph) + ;;(make-local-variable 'adaptive-fill-regexp) (make-local-variable 'imenu-generic-expression) (setq imenu-generic-expression ada-imenu-generic-expression) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '((ada-font-lock-keywords - ada-font-lock-keywords-1 - ada-font-lock-keywords-2) - nil t - ((?\_ . "w")) - beginning-of-line)) + (if (ada-xemacs) nil ; XEmacs uses properties + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults + '((ada-font-lock-keywords + ada-font-lock-keywords-1 ada-font-lock-keywords-2) + nil t + ((?\_ . "w")(?\. . "w")) + beginning-of-line + (font-lock-syntactic-keywords . ada-font-lock-syntactic-keywords))) + + ;; Set up support for find-file.el. + (make-variable-buffer-local 'ff-other-file-alist) + (make-variable-buffer-local 'ff-search-directories) + (setq ff-other-file-alist 'ada-other-file-alist + ff-search-directories 'ada-search-directories + ff-pre-load-hooks 'ff-which-function-are-we-in + ff-post-load-hooks 'ff-set-point-accordingly + ff-file-created-hooks 'ada-make-body)) (setq major-mode 'ada-mode) (setq mode-name "Ada") - (setq blink-matching-paren t) - (use-local-map ada-mode-map) (if ada-mode-syntax-table @@ -500,6 +653,45 @@ ;;;-------------------------- +;;; Compile support +;;;-------------------------- + +(defun ada-check-syntax () + "Check syntax of the current buffer. +Uses the function `compile' to execute `ada-compiler-syntax-check'." + (interactive) + (let ((old-compile-command compile-command)) + (setq compile-command (concat ada-compiler-syntax-check + (if (eq ada-language-version 'ada83) + "-gnat83 ") + " " ada-compile-options " " + (buffer-name))) + (setq compile-command (read-from-minibuffer + "enter command for syntax check: " + compile-command)) + (compile compile-command) + ;; restore old compile-command + (setq compile-command old-compile-command))) + +(defun ada-make-local () + "Bring current Ada unit up-to-date. +Uses the function `compile' to execute `ada-compile-make'." + (interactive) + (let ((old-compile-command compile-command)) + (setq compile-command (concat ada-compiler-make + " " ada-make-options " " + (buffer-name))) + (setq compile-command (read-from-minibuffer + "enter command for local make: " + compile-command)) + (compile compile-command) + ;; restore old compile-command + (setq compile-command old-compile-command))) + + + + +;;;-------------------------- ;;; Fill Comment Paragraph ;;;-------------------------- @@ -661,7 +853,7 @@ "Calls the external Pretty Printer. The name is specified in `ada-external-pretty-print-program'. Saves the current buffer in a directory specified by `ada-tmp-directory', -starts the pretty printer as an external process on that file and then +starts the pretty printer as external process on that file and then reloads the beautified program in the buffer and cleans up `ada-tmp-directory'." (interactive) @@ -724,7 +916,7 @@ ;;;--------------- ;; from Philippe Waroquiers <philippe@cfmu.eurocontrol.be> -;; modifiedby RE and MH +;; modified by RE and MH (defun ada-after-keyword-p () ;; returns t if cursor is after a keyword. @@ -737,14 +929,19 @@ (not (looking-at "_"))) ; (MH) (looking-at (concat ada-keywords "[^_]"))))) -(defun ada-after-char-p () - ;; returns t if after ada character "'". This is interpreted as being - ;; in a character constant. +(defun ada-in-char-const-p () + ;; Returns t if point is inside a character constant. + ;; We assume to be in a constant if the previous and the next character + ;; are "'". (save-excursion - (if (> (point) 2) - (progn - (forward-char -2) - (looking-at "'")) + (if (> (point) 1) + (and + (progn + (forward-char 1) + (looking-at "'")) + (progn + (forward-char -2) + (looking-at "'"))) nil))) @@ -756,7 +953,7 @@ (forward-char -1) (if (and (> (point) 1) (not (or (ada-in-string-p) (ada-in-comment-p) - (ada-after-char-p)))) + (ada-in-char-const-p)))) (if (eq (char-syntax (char-after (1- (point)))) ?w) (if (save-excursion (forward-word -1) @@ -801,7 +998,7 @@ ;; save original keybindings to allow swapping ret/lfd ;; when casing is activated ;; the 'or ...' is there to be sure that the value will not - ;; be changed again when Ada Mode is called more than once (MH) + ;; be changed again when Ada mode is called more than once (MH) (or ada-ret-binding (setq ada-ret-binding (key-binding "\C-M"))) (or ada-lfd-binding @@ -819,7 +1016,7 @@ ;; added by MH ;; (defun ada-loose-case-word (&optional arg) - "Capitalizes the first letter and the letters following `_'. + "Capitalizes the first letter and the letters following `_'. ARG is ignored, it's there to fit the standard casing functions' style." (let ((pos (point)) (first t)) @@ -835,6 +1032,7 @@ ;; ;; added by MH +;; modified by JSH to handle attributes ;; (defun ada-adjust-case-region (from to) "Adjusts the case of all words in the region. @@ -843,13 +1041,13 @@ (let ((begin nil) (end nil) (keywordp nil) - (reldiff nil)) + (attribp nil)) (unwind-protect (save-excursion (set-syntax-table ada-mode-symbol-syntax-table) (goto-char to) ;; - ;; loop: look for all identifiers and keywords + ;; loop: look for all identifiers, keywords, and attributes ;; (while (re-search-backward "[^a-zA-Z0-9_]\\([a-zA-Z0-9_]+\\)[^a-zA-Z0-9_]" @@ -858,16 +1056,15 @@ ;; ;; print status message ;; - (setq reldiff (- (point) from)) - (message "adjusting case ... %5d characters left" - (- (point) from)) + (message "adjusting case ... %5d characters left" (- (point) from)) + (setq attribp (looking-at "'[a-zA-Z0-9_]+[^']")) (forward-char 1) (or ;; do nothing if it is a string or comment (ada-in-string-or-comment-p) (progn ;; - ;; get the identifier or keyword + ;; get the identifier or keyword or attribute ;; (setq begin (point)) (setq keywordp (looking-at (concat ada-keywords "[^_]"))) @@ -877,7 +1074,9 @@ ;; (if keywordp (funcall ada-case-keyword -1) - (funcall ada-case-identifier -1)) + (if attribp + (funcall ada-case-attribute -1) + (funcall ada-case-identifier -1))) (goto-char begin)))) (message "adjusting case ... done")) (set-syntax-table ada-mode-syntax-table)))) @@ -888,7 +1087,7 @@ ;; (defun ada-adjust-case-buffer () "Adjusts the case of all words in the whole buffer. -Attention: This function might take very long for big buffers !" +ATTENTION: This function might take very long for big buffers !" (interactive "*") (ada-adjust-case-region (point-min) (point-max))) @@ -898,8 +1097,8 @@ ;;;------------------------;;; (defun ada-format-paramlist () - "Reformats a parameter-list. -Attention: 1) Comments inside the list are killed ! + "Reformats a parameter list. +ATTENTION: 1) Comments inside the list are killed ! 2) If the syntax is not correct (especially, if there are semicolons missing), it can get totally confused ! In such a case, use `undo', correct the syntax and try again." @@ -920,7 +1119,7 @@ ;; find start of current parameter-list ;; (ada-search-ignore-string-comment - (concat ada-subprog-start-re "\\|\\<body\\>" ) t nil) + (concat ada-subprog-start-re "\\|\\<body\\>" ) t nil) (ada-search-ignore-string-comment "(" nil nil t) (backward-char 1) (setq begin (point)) @@ -1061,9 +1260,9 @@ (ada-goto-next-non-ws)) ;; - ;; read type of parameter + ;; read type of parameter ;; - (looking-at "\\<[a-zA-Z0-9_\\.]+\\>") + (looking-at "\\<[a-zA-Z0-9_\\.\\']+\\>") (setq param (append param (list @@ -1409,51 +1608,16 @@ (setq lines-remaining (1- lines-remaining))) ;; show line number where the error occurred (error - (error "line %d: %s" (1+ (count-lines (point-min) (point))) err))) + (error "line %d: %s" (1+ (count-lines (point-min) (point))) err) nil)) (message "indenting ... done"))) (defun ada-indent-newline-indent () "Indents the current line, inserts a newline and then indents the new line." (interactive "*") - (let ((column) - (orgpoint)) - - (ada-indent-current) - (newline) - (delete-horizontal-space) - (setq orgpoint (point)) - - (unwind-protect - (progn - (set-syntax-table ada-mode-symbol-syntax-table) - - (setq column (save-excursion - (funcall (ada-indent-function) orgpoint)))) - - ;; - ;; restore syntax-table - ;; - (set-syntax-table ada-mode-syntax-table)) - - (indent-to column) - - ;; The following is needed to ensure that indentation will still be - ;; correct if something follows behind point when typing LFD - ;; For example: Imagine point to be there (*) when LFD is typed: - ;; while cond loop - ;; null; *end loop; - ;; Result without the following statement would be: - ;; while cond loop - ;; null; - ;; *end loop; - ;; You would then have to type TAB to correct it. - ;; If that doesn't bother you, you can comment out the following - ;; statement to speed up indentation a LITTLE bit. - - (if (not (looking-at "[ \t]*$")) - (ada-indent-current)) - )) + (ada-indent-current) + (newline) + (ada-indent-current)) (defun ada-indent-current () @@ -1496,10 +1660,10 @@ (setq prev-indent (save-excursion (funcall (ada-indent-function) line-end)))) - (progn ; first line of buffer -> set indent - (beginning-of-line) ; to 0 - (delete-horizontal-space) - (setq prevline nil)))) + (progn ; first line of buffer -> set indent + (beginning-of-line) ; to 0 + (delete-horizontal-space) + (setq prevline nil)))) (if prevline ;; @@ -1511,18 +1675,17 @@ ;; (back-to-indentation) (setq cur-indent (ada-get-current-indent prev-indent)) - ;; only reindent if indentation is different then the current - (if (= (current-column) cur-indent) - nil + ;; only reindent if indentation is different then the current + (if (= (current-column) cur-indent) + nil (delete-horizontal-space) - (indent-to cur-indent)) - + (indent-to cur-indent)) ;; ;; restore position of point ;; (goto-char orgpoint) (if (< (current-column) (current-indentation)) - (back-to-indentation)))))) + (back-to-indentation)))))) ;; ;; restore syntax-table @@ -1559,27 +1722,33 @@ ;; end ;; ((looking-at "\\<end\\>") - (save-excursion - (ada-goto-matching-start 1) - - ;; - ;; found 'loop' => skip back to 'while' or 'for' - ;; if 'loop' is not on a separate line - ;; - (if (and - (looking-at "\\<loop\\>") - (save-excursion - (back-to-indentation) - (not (looking-at "\\<loop\\>")))) - (if (save-excursion - (and - (setq match-cons - (ada-search-ignore-string-comment - ada-loop-start-re t nil)) - (not (looking-at "\\<loop\\>")))) - (goto-char (car match-cons)))) - - (current-indentation))) + (let ((label 0)) + (save-excursion + (ada-goto-matching-start 1) + + ;; + ;; found 'loop' => skip back to 'while' or 'for' + ;; if 'loop' is not on a separate line + ;; + (if (and + (looking-at "\\<loop\\>") + (save-excursion + (back-to-indentation) + (not (looking-at "\\<loop\\>")))) + (if (save-excursion + (and + (setq match-cons + (ada-search-ignore-string-comment + ada-loop-start-re t nil)) + (not (looking-at "\\<loop\\>")))) + (progn + (goto-char (car match-cons)) + (save-excursion + (beginning-of-line) + (if (looking-at ada-named-block-re) + (setq label (- ada-label-indent))))))) + + (+ (current-indentation) label)))) ;; ;; exception ;; @@ -1647,9 +1816,7 @@ (save-excursion (if (ada-goto-matching-decl-start t) (current-indentation) - (progn - (message "no matching declaration start") - prev-indent)))) + prev-indent))) ;; ;; is ;; @@ -1776,8 +1943,7 @@ ;; the current statement, if NOMOVE is nil. (let ((orgpoint (point)) - (func nil) - (stmt-start nil)) + (func nil)) ;; ;; inside a parameter-list ;; @@ -1788,14 +1954,14 @@ ;; move to beginning of current statement ;; (if (not nomove) - (setq stmt-start (ada-goto-stmt-start))) + (ada-goto-stmt-start)) ;; ;; no beginning found => don't change indentation ;; (if (and (eq orgpoint (point)) (not nomove)) - (setq func 'ada-get-indent-nochange) + (setq func 'ada-get-indent-nochange) (cond ;; @@ -1813,11 +1979,6 @@ ((looking-at ada-subprog-start-re) (setq func 'ada-get-indent-subprog)) ;; - ((looking-at "\\<package\\>") - (setq func 'ada-get-indent-subprog)) ; maybe it needs a - ; special function - ; sometimes ? - ;; ((looking-at ada-block-start-re) (setq func 'ada-get-indent-block-start)) ;; @@ -1851,7 +2012,7 @@ (defun ada-get-indent-open-paren (orgpoint) ;; Returns the indentation (column #) for the new line after ORGPOINT. - ;; Assumes point to be behind an open paranthesis not yet closed. + ;; Assumes point to be behind an open parenthesis not yet closed. (ada-in-open-paren-p)) @@ -1897,6 +2058,7 @@ ;; slow, if it has to search through big files with many nested blocks. ;; Signals an error if the corresponding block-start doesn't match. (let ((defun-name nil) + (label 0) (indent nil)) ;; ;; is the line already terminated by ';' ? @@ -1923,8 +2085,9 @@ (forward-word 1) (ada-goto-stmt-start))) ;; a label ? => skip it - (if (looking-at "[a-zA-Z0-9_]+[ \n\t]+:") + (if (looking-at ada-named-block-re) (progn + (setq label (- ada-label-indent)) (goto-char (match-end 0)) (ada-goto-next-non-ws))) ;; really looking-at the right thing ? @@ -1937,7 +2100,7 @@ "loop\\|select\\|if\\|case\\|" "record\\|while\\|type\\)\\>"))) (backward-word 1)) - (current-indentation))) + (+ (current-indentation) label))) ;; ;; a named block end ;; @@ -1971,7 +2134,7 @@ (defun ada-get-indent-case (orgpoint) ;; Returns the indentation (column #) for the new line after ORGPOINT. - ;; Assumes point to be at the beginning of an case-statement. + ;; Assumes point to be at the beginning of a case-statement. (let ((cur-indent (current-indentation)) (match-cons nil) (opos (point))) @@ -1980,8 +2143,12 @@ ;; case..is..when..=> ;; ((save-excursion - (setq match-cons (ada-search-ignore-string-comment - "[ \t\n]+=>" nil orgpoint))) + (setq match-cons (and + ;; the `=>' must be after the keyword `is'. + (ada-search-ignore-string-comment + "\\<is\\>" nil orgpoint) + (ada-search-ignore-string-comment + "[ \t\n]+=>" nil orgpoint)))) (save-excursion (goto-char (car match-cons)) (if (not (ada-search-ignore-string-comment "\\<when\\>" t opos)) @@ -2092,7 +2259,7 @@ (if (save-excursion (setq match-cons (ada-search-ignore-string-comment - "\\<is\\>\\|\\<do\\>" nil orgpoint))) + "\\<\\(is\\|do\\)\\>" nil orgpoint))) ;; ;; yes, then skip to its end ;; @@ -2155,10 +2322,15 @@ (defun ada-get-indent-noindent (orgpoint) ;; Returns the indentation (column #) for the new line after ORGPOINT. ;; Assumes point to be at the beginning of a 'noindent statement'. - (if (save-excursion - (ada-search-ignore-string-comment ";" nil orgpoint)) - (current-indentation) - (+ (current-indentation) ada-broken-indent))) + (let ((label 0)) + (save-excursion + (beginning-of-line) + (if (looking-at ada-named-block-re) + (setq label (- ada-label-indent)))) + (if (save-excursion + (ada-search-ignore-string-comment ";" nil orgpoint)) + (+ (current-indentation) label) + (+ (current-indentation) ada-broken-indent label)))) (defun ada-get-indent-label (orgpoint) @@ -2183,7 +2355,7 @@ ;; ((save-excursion (setq match-cons (ada-search-ignore-string-comment - "\\<declare\\>" nil orgpoint))) + "\\<declare\\|begin\\>" nil orgpoint))) (save-excursion (goto-char (car match-cons)) (+ (current-indentation) ada-indent))) @@ -2217,7 +2389,13 @@ ;; Assumes point to be at the beginning of a loop statement ;; or (unfortunately) also a for ... use statement. (let ((match-cons nil) - (pos (point))) + (pos (point)) + (label (save-excursion + (beginning-of-line) + (if (looking-at ada-named-block-re) + (- ada-label-indent) + 0)))) + (cond ;; @@ -2225,12 +2403,12 @@ ;; ((save-excursion (ada-search-ignore-string-comment ";" nil orgpoint)) - (current-indentation)) + (+ (current-indentation) label)) ;; ;; simple loop ;; ((looking-at "loop\\>") - (ada-get-indent-block-start orgpoint)) + (+ (ada-get-indent-block-start orgpoint) label)) ;; ;; 'for'- loop (or also a for ... use statement) @@ -2274,12 +2452,12 @@ (back-to-indentation) (looking-at "\\<loop\\>"))) (goto-char pos)) - (+ (current-indentation) ada-indent)) + (+ (current-indentation) ada-indent label)) ;; ;; for-statement is broken ;; (t - (+ (current-indentation) ada-broken-indent)))) + (+ (current-indentation) ada-broken-indent label)))) ;; ;; 'while'-loop @@ -2302,9 +2480,9 @@ (back-to-indentation) (looking-at "\\<loop\\>"))) (goto-char pos)) - (+ (current-indentation) ada-indent)) - - (+ (current-indentation) ada-broken-indent)))))) + (+ (current-indentation) ada-indent label)) + + (+ (current-indentation) ada-broken-indent label)))))) (defun ada-get-indent-type (orgpoint) @@ -2387,7 +2565,7 @@ ;; (setq match-dat (ada-search-prev-end-stmt limit))) ;; - ;; if found the correct end-stetement => goto next non-ws + ;; if found the correct end-statement => goto next non-ws ;; (if match-dat (goto-char (cdr match-dat))) @@ -2418,7 +2596,6 @@ ;; End-statements are defined by 'ada-end-stmt-re'. Checks for ;; certain keywords if they follow 'end', which means they are no ;; end-statement there. - (interactive) ;; DEBUG (let ((match-dat nil) (pos nil) (found nil)) @@ -2433,18 +2610,22 @@ limit))) (goto-char (car match-dat)) - (if (not (ada-in-open-paren-p)) ;; ;; check if there is an 'end' in front of the match ;; (if (not (and - (looking-at "\\<\\(record\\|loop\\|select\\)\\>") + (looking-at + "\\<\\(record\\|loop\\|select\\|else\\|then\\)\\>") (save-excursion (ada-goto-previous-word) - (looking-at "\\<end\\>")))) - (setq found t) - + (looking-at "\\<\\(end\\|or\\|and\\)\\>")))) + (save-excursion + (goto-char (cdr match-dat)) + (ada-goto-next-word) + (if (not (looking-at "\\<\\(separate\\|new\\)\\>")) + (setq found t))) + (forward-word -1)))) ; end of loop (if found @@ -2474,18 +2655,21 @@ nil)) -(defun ada-goto-previous-word () - ;; Moves point to the beginning of the previous word of Ada code. +(defun ada-goto-next-word (&optional backward) + ;; Moves point to the beginning of the next word of Ada code. + ;; If BACKWARD is non-nil, jump to the beginning of the previous word. ;; Returns the new position of point or nil if not found. (let ((match-cons nil) (orgpoint (point))) + (if (not backward) + (skip-chars-forward "_a-zA-Z0-9\\.")) (if (setq match-cons - (ada-search-ignore-string-comment "[^ \t\n]" t nil t)) + (ada-search-ignore-string-comment "\\w" backward nil t)) ;; ;; move to the beginning of the word found ;; (progn - (goto-char (cdr match-cons)) + (goto-char (car match-cons)) (skip-chars-backward "_a-zA-Z0-9") (point)) ;; @@ -2496,6 +2680,12 @@ 'nil)))) +(defun ada-goto-previous-word () + ;; Moves point to the beginning of the previous word of Ada code. + ;; Returns the new position of point or nil if not found. + (ada-goto-next-word t)) + + (defun ada-check-matching-start (keyword) ;; Signals an error if matching block start is not KEYWORD. ;; Moves point to the matching block start. @@ -2510,45 +2700,51 @@ ;; Moves point to the beginning of the declaration. ;; - ;; 'accept' or 'package' ? - ;; - (if (not (looking-at "\\<\\(accept\\|package\\|task\\|protected\\)\\>")) - (ada-goto-matching-decl-start)) - ;; - ;; 'begin' of 'procedure'/'function'/'task' or 'declare' + ;; named block without a `declare' ;; - (save-excursion + (if (save-excursion + (ada-goto-previous-word) + (looking-at (concat "\\<" defun-name "\\> *:"))) + t ; do nothing ;; - ;; a named 'declare'-block ? + ;; 'accept' or 'package' ? ;; - (if (looking-at "\\<declare\\>") - (ada-goto-stmt-start) + (if (not (looking-at "\\<\\(accept\\|package\\|task\\|protected\\)\\>")) + (ada-goto-matching-decl-start)) + ;; + ;; 'begin' of 'procedure'/'function'/'task' or 'declare' + ;; + (save-excursion ;; - ;; no, => 'procedure'/'function'/'task'/'protected' + ;; a named 'declare'-block ? ;; - (progn - (forward-word 2) - (backward-word 1) + (if (looking-at "\\<declare\\>") + (ada-goto-stmt-start) ;; - ;; skip 'body' 'protected' 'type' + ;; no, => 'procedure'/'function'/'task'/'protected' ;; - (if (looking-at "\\<\\(body\\|type\\)\\>") - (forward-word 1)) - (forward-sexp 1) - (backward-sexp 1))) - ;; - ;; should be looking-at the correct name - ;; - (if (not (looking-at (concat "\\<" defun-name "\\>"))) - (error "matching defun has different name: %s" - (buffer-substring (point) - (progn (forward-sexp 1) (point))))))) + (progn + (forward-word 2) + (backward-word 1) + ;; + ;; skip 'body' 'type' + ;; + (if (looking-at "\\<\\(body\\|type\\)\\>") + (forward-word 1)) + (forward-sexp 1) + (backward-sexp 1))) + ;; + ;; should be looking-at the correct name + ;; + (if (not (looking-at (concat "\\<" defun-name "\\>"))) + (error "matching defun has different name: %s" + (buffer-substring (point) + (progn (forward-sexp 1) (point)))))))) (defun ada-goto-matching-decl-start (&optional noerror nogeneric) ;; Moves point to the matching declaration start of the current 'begin'. ;; If NOERROR is non-nil, it only returns nil if no match was found. - (interactive) ;; DEBUG (let ((nest-count 1) (pos nil) (first t) @@ -2578,25 +2774,26 @@ ;; ((looking-at "is") ;; check if it is only a type definition, but not a protected - ;; type definition, which should be handled like a procedure. - (if (save-excursion - (ada-goto-previous-word) - (skip-chars-backward "a-zA-Z0-9_.'") - (if (save-excursion - (backward-char 1) - (looking-at ")")) - (progn - (forward-char 1) - (backward-sexp 1) - (skip-chars-backward "a-zA-Z0-9_.'") - )) - (ada-goto-previous-word) - (and - (looking-at "\\<type\\>") - (save-match-data - (ada-goto-previous-word) - (not (looking-at "\\<protected\\>")))) - ); end of save-excursion + ;; type definition, which should be handled like a procedure. + (if (or (looking-at "is +<>") + (save-excursion + (ada-goto-previous-word) + (skip-chars-backward "a-zA-Z0-9_.'") + (if (save-excursion + (backward-char 1) + (looking-at ")")) + (progn + (forward-char 1) + (backward-sexp 1) + (skip-chars-backward "a-zA-Z0-9_.'") + )) + (ada-goto-previous-word) + (and + (looking-at "\\<type\\>") + (save-match-data + (ada-goto-previous-word) + (not (looking-at "\\<protected\\>")))) + )); end of `or' (goto-char (match-beginning 0)) (progn (setq nest-count (1- nest-count)) @@ -2625,13 +2822,11 @@ (and (zerop nest-count) (not flag) - (progn - (if (looking-at "is") - (ada-search-ignore-string-comment - ada-subprog-start-re t) - (looking-at "declare\\|generic"))))) + (if (looking-at "is") + (ada-search-ignore-string-comment ada-subprog-start-re t) + (looking-at "declare\\|generic")))) (if noerror nil - (error "no matching proc/func/task/declare/package/protected")) + (error "no matching proc/func/task/declare/package/protected")) t))) @@ -2672,7 +2867,7 @@ ;; check if keyword follows 'end' ;; (ada-goto-previous-word) - (if (looking-at "\\<end\\>") + (if (looking-at "\\<end\\> *[^;]") ;; it ends a block => increase nest depth (progn (setq nest-count (1+ nest-count)) @@ -3064,14 +3259,11 @@ (defun ada-in-comment-p () ;; Returns t if inside a comment. - ;; (save-excursion (and (re-search-backward "\\(--\\|\n\\)" nil 1) - ;; (looking-at "-")))) (nth 4 (parse-partial-sexp (save-excursion (beginning-of-line) (point)) (point)))) - (defun ada-in-string-p () ;; Returns t if point is inside a string ;; (Taken from pascal-mode.el, modified by MH). @@ -3083,14 +3275,25 @@ (point)) (point))) ;; check if 'string quote' is only a character constant (progn - (re-search-backward "\"" nil t) ; # not a string delimiter anymore + (re-search-backward "\"" nil t) ; `#' is not taken as a string delimiter (not (= (char-after (1- (point))) ?')))))) (defun ada-in-string-or-comment-p () - ;; Returns t if point is inside a string or a comment. - (or (ada-in-comment-p) - (ada-in-string-p))) + ;; Returns t if point is inside a string, a comment, or a character constant. + (let ((parse-result (parse-partial-sexp + (save-excursion (beginning-of-line) (point)) (point)))) + (or ;; in-comment-p + (nth 4 parse-result) + ;; in-string-p + (and + (nth 3 parse-result) + ;; check if 'string quote' is only a character constant + (progn + (re-search-backward "\"" nil t) ; `#' not regarded a string delimiter + (not (= (char-after (1- (point))) ?')))) + ;; in-char-const-p + (ada-in-char-const-p)))) (defun ada-in-paramlist-p () @@ -3117,10 +3320,12 @@ ;; If point is somewhere behind an open parenthesis not yet closed, ;; it returns the column # of the first non-ws behind this open ;; parenthesis, otherwise nil." - - (let ((start (if (< (point) ada-search-paren-char-count-limit) - 1 - (- (point) ada-search-paren-char-count-limit))) + (let ((start (if (<= (point) ada-search-paren-char-count-limit) + (point-min) + (save-excursion + (goto-char (- (point) ada-search-paren-char-count-limit)) + (beginning-of-line) + (point)))) parse-result (col nil)) (setq parse-result (parse-partial-sexp start (point))) @@ -3169,7 +3374,7 @@ (defun ada-indent-current-function () - "Ada Mode version of the indent-line-function." + "Ada mode version of the indent-line-function." (interactive "*") (let ((starting-point (point-marker))) (ada-beginning-of-line) @@ -3209,16 +3414,17 @@ (save-match-data (save-excursion (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward "[ \t]+$" (point-max) t) - (replace-match "" nil nil)))))) + (widen) + (goto-char (point-min)) + (while (re-search-forward "[ \t]+$" (point-max) t) + (replace-match "" nil nil)))))) (defun ada-untabify-buffer () ;; change all tabs to spaces (save-excursion - (untabify (point-min) (point-max)))) + (untabify (point-min) (point-max)) + nil)) (defun ada-uncomment-region (beg end) @@ -3234,6 +3440,23 @@ (and (fboundp 'ff-find-other-file) (ff-find-other-file t))) +;; inspired by Laurent.GUERBY@enst-bretagne.fr +(defun ada-gnat-style () + "Clean up comments, `(' and `,' for GNAT style checking switch." + (interactive) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "-- ?\\([^ -]\\)" nil t) + (replace-match "-- \\1")) + (goto-char (point-min)) + (while (re-search-forward "\\>(" nil t) + (replace-match " (")) + (goto-char (point-min)) + (while (re-search-forward ",\\<" nil t) + (replace-match ", ")) + )) + + ;;;-------------------------------;;; ;;; Moving To Procedures/Packages ;;; @@ -3304,21 +3527,25 @@ ;; Compilation (define-key ada-mode-map "\C-c\C-c" 'compile) + (define-key ada-mode-map "\C-c\C-v" 'ada-check-syntax) + (define-key ada-mode-map "\C-c\C-m" 'ada-make-local) ;; Casing (define-key ada-mode-map "\C-c\C-r" 'ada-adjust-case-region) (define-key ada-mode-map "\C-c\C-b" 'ada-adjust-case-buffer) + (define-key ada-mode-map "\177" 'backward-delete-char-untabify) + ;; Use predefined function of emacs19 for comments (RE) (define-key ada-mode-map "\C-c;" 'comment-region) (define-key ada-mode-map "\C-c:" 'ada-uncomment-region) ;; Change basic functionality - ;; `substitute-key-definition' is not defined equally in GNU Emacs + ;; `substitute-key-definition' is not defined equally in Emacs ;; and XEmacs, you cannot put in an optional 4th parameter in ;; XEmacs. I don't think it's necessary, so I leave it out for - ;; GNU Emacs as well. If you encounter any problems with the + ;; Emacs as well. If you encounter any problems with the ;; following three functions, please tell me. RE (mapcar (function (lambda (pair) (substitute-key-definition (car pair) (cdr pair) @@ -3327,7 +3554,7 @@ (end-of-line . ada-end-of-line) (forward-to-indentation . ada-forward-to-indentation) )) - ;; else GNU Emacs + ;; else Emacs ;;(mapcar (lambda (pair) ;; (substitute-key-definition (car pair) (cdr pair) ;; ada-mode-map global-map)) @@ -3342,7 +3569,7 @@ (require 'easymenu) (defun ada-add-ada-menu () - "Adds the menu 'Ada' to the menu bar in Ada Mode." + "Adds the menu 'Ada' to the menu bar in Ada mode." (easy-menu-define ada-mode-menu ada-mode-map "Menu keymap for Ada mode." '("Ada" ["Next Package" ada-next-package t] @@ -3371,7 +3598,9 @@ ["Comment Region" comment-region t] ["Uncomment Region" ada-uncomment-region t] ["----------------" nil nil] - ["Compile" compile (fboundp 'compile)] + ["Global Make" compile (fboundp 'compile)] + ["Local Make" ada-make-local t] + ["Check Syntax" ada-check-syntax t] ["Next Error" next-error (fboundp 'next-error)] ["---------------" nil nil] ["Index" imenu (fboundp 'imenu)] @@ -3382,7 +3611,7 @@ (fboundp 'ff-find-other-file)])) (if (ada-xemacs) (progn (easy-menu-add ada-mode-menu) - (setq mode-popup-menu (cons "Ada Mode" ada-mode-menu))))) + (setq mode-popup-menu (cons "Ada mode" ada-mode-menu))))) @@ -3418,37 +3647,22 @@ )) ;;;--------------------------------------------------- -;;; support for find-file +;;; support for find-file.el ;;;--------------------------------------------------- ;;;###autoload (defun ada-make-filename-from-adaname (adaname) "Determine the filename of a package/procedure from its own Ada name." - ;; this is done simply by calling gkrunch, when we work with GNAT. It + ;; this is done simply by calling `gnatkr', when we work with GNAT. It ;; must be a more complex function in other compiler environments. (interactive "s") - - ;; things that should really be done by the external process - ;; since gnat-2.0, gnatk8 can do these things. If you still use a - ;; previous version, just uncomment the following lines. (let (krunch-buf) (setq krunch-buf (generate-new-buffer "*gkrunch*")) (save-excursion (set-buffer krunch-buf) -; (insert (downcase adaname)) -; (goto-char (point-min)) -; (while (search-forward "." nil t) -; (replace-match "-" nil t)) -; (setq adaname (buffer-substring (point-min) -; (progn -; (goto-char (point-min)) -; (end-of-line) -; (point)))) -; ;; clean the buffer -; (delete-region (point-min) (point-max)) - ;; send adaname to external process "gnatk8" - (call-process "gnatk8" nil krunch-buf nil + ;; send adaname to external process `gnatkr'. + (call-process "gnatkr" nil krunch-buf nil adaname ada-krunch-args) ;; fetch output of that process (setq adaname (buffer-substring @@ -3481,74 +3695,45 @@ ;;;--------------------------------------------------- -;;; support for imenu -;;;--------------------------------------------------- - -(defun imenu-create-ada-index (&optional regexp) - "Create index alist for Ada files." - (let ((index-alist '()) - prev-pos char) - (goto-char (point-min)) - ;(imenu-progress-message prev-pos 0) - ;; Search for functions/procedures - (save-match-data - (while (re-search-forward - (or regexp ada-procedure-start-regexp) - nil t) - ;(imenu-progress-message prev-pos) - ;; do not store forward definitions - ;; right now we store them. We want to avoid them only in - ;; package bodies, not in the specs!! ???RE??? - (save-match-data -; (if (not (looking-at (concat -; "[ \t\n]*" ; WS -; "\([^)]+\)" ; parameterlist -; "\\([ \n\t]+return[ \n\t]+"; potential return -; "[a-zA-Z0-9_\\.]+\\)?" -; "[ \t]*" ; WS -; ";" ;; THIS is what we really look for -; ))) -; ; (push (imenu-example--name-and-position) index-alist) - (setq index-alist (cons (imenu-example--name-and-position) - index-alist)) -; ) - ) - ;(imenu-progress-message 100) - )) - (nreverse index-alist))) - -;;;--------------------------------------------------- ;;; support for font-lock ;;;--------------------------------------------------- -;; Strings are a real pain in Ada because both ' and " can appear in a -;; non-string quote context (the former as an operator, the latter as -;; a character string). We follow the least losing solution, in which -;; only " is a string quote. Therefore a character string of the form -;; '"' will throw fontification off on the wrong track. +;; Strings are a real pain in Ada because a single quote character is +;; overloaded as a string quote and type/instance delimiter. By default, a +;; single quote is given punctuation syntax in `ada-mode-syntax-table'. +;; So, for Font Lock mode purposes, we mark single quotes as having string +;; syntax when the gods that created Ada determine them to be. sm. + +(defconst ada-font-lock-syntactic-keywords + ;; Mark single quotes as having string quote syntax in 'c' instances. + '(("\\(\'\\).\\(\'\\)" (1 (7 . ?\')) (2 (7 . ?\'))))) (defconst ada-font-lock-keywords-1 (list ;; + ;; handle "type T is access function return S;" + ;; + (list "\\<\\(function[ \t]+return\\)\\>" '(1 font-lock-keyword-face) ) + ;; ;; accept, entry, function, package (body), protected (body|type), ;; pragma, procedure, task (body) plus name. (list (concat "\\<\\(" "accept\\|" "entry\\|" - "function\\|" - "package[ \t]+body\\|" - "package\\|" - "pragma\\|" - "procedure\\|" - "protected[ \t]+body\\|" - "protected[ \t]+type\\|" - "protected\\|" + "function\\|" + "package[ \t]+body\\|" + "package\\|" + "pragma\\|" + "procedure\\|" + "protected[ \t]+body\\|" + "protected[ \t]+type\\|" + "protected\\|" ;; "p\\(\\(ackage\\|rotected\\)\\(\\|[ \t]+\\(body\\|type\\)\\)\ ;;\\|r\\(agma\\|ocedure\\)\\)\\|" - "task\\|" "task[ \t]+body\\|" - "task[ \t]+type" + "task[ \t]+type\\|" + "task" ;; "task\\(\\|[ \t]+body\\)" "\\)\\>[ \t]*" "\\(\\sw+\\(\\.\\sw*\\)*\\)?") @@ -3575,15 +3760,15 @@ "e\\(ls\\(e\\|if\\)\\|ntry\\|x\\(ception\\|it\\)\\)\\|for\\|" "generic\\|i[fns]\\|l\\(imited\\|oop\\)\\|mod\\|n\\(ot\\|ull\\)\\|" "o\\(r\\|thers\\|ut\\)\\|pr\\(ivate\\|otected\\)\\|" - "r\\(ange\\|e\\(cord\\|m\\|names\\|queue\\|turn\\|verse\\)\\)\\|" + "r\\(a\\(ise\\|nge\\)\\|e\\(cord\\|m\\|names\\|queue\\|turn\\|verse\\)\\)\\|" "se\\(lect\\|parate\\)\\|" "t\\(agged\\|erminate\\|hen\\)\\|until\\|" ; task removed "wh\\(ile\\|en\\)\\|xor" ; "when" added "\\)\\>") ;; ;; Anything following end and not already fontified is a body name. - '("\\<\\(end\\)\\>[ \t]+\\([a-zA-Z0-9_\\.]+\\)?" - (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) + '("\\<\\(end\\)\\>\\([ \t]+\\)?\\([a-zA-Z0-9_\\.]+\\)?" + (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t)) ;; ;; Variable name plus optional keywords followed by a type name. Slow. ; (list (concat "\\<\\(\\sw+\\)\\>[ \t]*:?[ \t]*" @@ -3594,7 +3779,7 @@ ;; ;; Optional keywords followed by a type name. (list (concat ; ":[ \t]*" - "\\<\\(access\\|constant\\|in\\|in[ \t]+out\\|out\\)\\>" + "\\<\\(access\\|constant\\|in[ \t]+out\\|in\\|out\\)\\>" "[ \t]*" "\\(\\sw+\\)?") '(1 font-lock-keyword-face nil t) '(2 font-lock-type-face nil t)) @@ -3619,19 +3804,28 @@ )) "Gaudy level highlighting for Ada mode.") -;; XEmacs change -(defvar ada-font-lock-keywords (if font-lock-maximum-decoration - ada-font-lock-keywords-2 - ada-font-lock-keywords-1) - "Default Expressions to highlight in Ada mode. -See the doc to `font-lock-maximum-decoration' for user configuration.") - -;; XEmacs change -(put 'ada-mode 'font-lock-defaults - '(ada-font-lock-keywords nil t ((?\_ . "w")))) +(defvar ada-font-lock-keywords ada-font-lock-keywords-1 + "Default expressions to highlight in Ada mode.") + + +;; set font-lock properties for XEmacs +(if (ada-xemacs) + (put 'ada-mode 'font-lock-defaults + '(ada-font-lock-keywords + nil t ((?\_ . "w")(?\. . "w")) beginning-of-line))) ;;; -;;; ???? +;;; support for outline +;;; + +;; used by outline-minor-mode +(defun ada-outline-level () + (save-excursion + (skip-chars-forward "\t ") + (current-column))) + +;;; +;;; generate body ;;; (defun ada-gen-comment-until-proc () ;; comment until spec of a procedure or a function.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/modes/ada-stmt.el Mon Aug 13 09:57:07 2007 +0200 @@ -0,0 +1,630 @@ +;;; ada-stmt.el - An extension to Ada mode for inserting statement templates. + +;; Copyright (C) 1987, 1993, 1994, 1996, 1997 Free Software Foundation, Inc. + +;; Authors: Daniel Pfeiffer, Markus Heritsch, Rolf Ebert <ebert@waporo.muc.de> +;; Maintainer: Rolf Ebert <ebert@waporo.muc.de> +;; Keywords: languages, ada +;; Rolf Ebert's version: 2.26 + +;;; Commentary: + +;; +;; put the following statement in your .emacs: +;; (require 'ada-stmt) +;; + +;;; History: + +;; Created May 1987. +;; Original version from V. Bowman as in ada.el of Emacs-18 +;; (borrowed heavily from Mick Jordan's Modula-2 package for GNU, +;; as modified by Peter Robinson, Michael Schmidt, and Tom Perrine.) +;; +;; Sep 1993. Daniel Pfeiffer <pfeiffer@cict.fr> (DP) +;; Introduced statement.el for smaller code and user configurability. +;; +;; Nov 1993. Rolf Ebert <ebert@enpc.fr> (RE) Moved the +;; skeleton generation into this separate file. The code still is +;; essentially written by DP +;; +;; Adapted Jun 1994. Markus Heritsch +;; <Markus.Heritsch@studbox.uni-stuttgart.de> (MH) +;; added menu bar support for templates +;; +;; 1994/12/02 Christian Egli <cegli@hcsd.hac.com> +;; General cleanup and bug fixes. +;; +;; 1995/12/20 John Hutchison <hutchiso@epi.syr.ge.com> +;; made it work with skeleton.el from emacs-19.30. Several +;; enhancements and bug fixes. + +;; BUGS: +;;;> I have the following suggestions for the function template: 1) I +;;;> don't want it automatically assigning it a name for the return variable. I +;;;> never want it to be called "Result" because that is nondescriptive. If you +;;;> must define a variable, give me the ability to specify its name. +;;;> +;;;> 2) You do not provide a type for variable 'Result'. Its type is the same +;;;> as the function's return type, which the template knows, so why force me +;;;> to type it in? +;;;> + +;;;It would be nice if one could configure such layout details separately +;;;without patching the LISP code. Maybe the metalanguage used in ada-stmt.el +;;;could be taken even further, providing the user with some nice syntax +;;;for describing layout. Then my own hacks would survive the next +;;;update of the package :-) + + +;;; Code: + +(require 'ada-mode) +(load "skeleton") ;; bug in 19.28 through 19.30 skeleton.el, not provided. +(require 'easymenu) + +(defvar ada-stmt-use-debug t + "*Toggle to insert ada debug code parts.") + + +(defvar ada-debug-call-str "pragma Debug (%s);" + "*Debug call code to insert.") + + +(defvar ada-debug-exception-str "pragma Debug (%s);" + "*Debug exception code to insert." ) + + + +(defun ada-func-or-proc-name () + ;; Get the name of the current function or procedure." + (save-excursion + (let ((case-fold-search t)) + (if (re-search-backward ada-procedure-start-regexp nil t) + (buffer-substring (match-beginning 2) (match-end 2)) + "NAME?")))) + + +(defun ada-toggle-debugging () + "Toggles behaviour of `ada-debug-info-insertion'." + (interactive) + (setq ada-stmt-use-debug (not ada-stmt-use-debug)) + (if ada-stmt-use-debug + (message "Debugging enabled") + (message "Debugging disabled"))) + + +(defvar ada-template-map nil + "Keymap used in Ada mode for smart template operations.") + + +(let ((ada-mp (make-sparse-keymap))) + (define-key ada-mp "h" 'ada-header) +; (define-key ada-mp "p" 'ada-toggle-prompt-pseudo) + (define-key ada-mp "(" 'insert-parentheses) + (define-key ada-mp "\C-a" 'ada-array) + (define-key ada-mp "b" 'ada-exception-block) + (define-key ada-mp "d" 'ada-declare-block) + (define-key ada-mp "c" 'ada-case) + (define-key ada-mp "\C-e" 'ada-elsif) + (define-key ada-mp "e" 'ada-else) + (define-key ada-mp "\C-k" 'ada-package-spec) + (define-key ada-mp "k" 'ada-package-body) + (define-key ada-mp "\C-p" 'ada-procedure-spec) + (define-key ada-mp "\C-f" 'ada-function-spec) + (define-key ada-mp "p" 'ada-subprogram-body) + (define-key ada-mp "f" 'ada-for-loop) + (define-key ada-mp "i" 'ada-if) + (define-key ada-mp "l" 'ada-loop) + (define-key ada-mp "\C-r" 'ada-record) + (define-key ada-mp "\C-s" 'ada-subtype) + (define-key ada-mp "S" 'ada-tabsize) + (define-key ada-mp "\C-t" 'ada-task-spec) + (define-key ada-mp "t" 'ada-task-body) + (define-key ada-mp "\C-y" 'ada-type) + (define-key ada-mp "\C-v" 'ada-private) + (define-key ada-mp "u" 'ada-use) + (define-key ada-mp "\C-u" 'ada-with) + (define-key ada-mp "\C-w" 'ada-when) + (define-key ada-mp "w" 'ada-while-loop) + (define-key ada-mp "\C-x" 'ada-exception) + (define-key ada-mp "x" 'ada-exit) + (setq ada-template-map ada-mp)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Place the templates into Ada Mode. They may be inserted under any key. +;; C-c C-t will be the default. If you use templates alot, you +;; may want to consider moving the binding to another key in your .emacs +;; file. Be sure to (require 'ada-stmt) first. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;(define-key ada-mode-map "\C-ct" ada-template-map) +(define-key ada-mode-map "\C-c\C-t" ada-template-map) + +;;; ---- statement skeletons ------------------------------------------ + +(define-skeleton ada-array + "Insert array type definition. Uses the minibuffer to prompt +for component type and index subtypes." + () + "array (" ("index definition: " str ", " ) -2 ") of " _ ?\;) + + +(define-skeleton ada-case + "Build skeleton case statement, prompting for the selector expression. +Also builds the first when clause." + "[selector expression]: " + "case " str " is" \n + > "when " ("discrete choice: " str " | ") -3 " =>" \n + > _ \n + < < "end case;") + + +(define-skeleton ada-when + "Start a case statement alternative with a when clause." + () + < "when " ("discrete choice: " str " | ") -3 " =>" \n + >) + + +(define-skeleton ada-declare-block + "Insert a block with a declare part. +Indent for the first declaration." + "[block name]: " + < str & ?: & \n + > "declare" \n + > _ \n + < "begin" \n + > \n + < "end " str | -1 ?\;) + + +(define-skeleton ada-exception-block + "Insert a block with an exception part. +Indent for the first line of code." + "[block name]: " + < str & ?: & \n + > "begin" \n + > _ \n + < "exception" \n + > \n + < "end " str | -1 ?\;) + + +(define-skeleton ada-exception + "Insert an indented exception part into a block." + () + < "exception" \n + >) + + +(define-skeleton ada-exit-1 + "Insert then exit condition of the exit statement, prompting for condition." + "[exit condition]: " + "when " str | -5) + + +(define-skeleton ada-exit + "Insert an exit statement, prompting for loop name and condition." + "[name of loop to exit]: " + "exit " str & ?\ + (ada-exit-1) + | -1 ?\;) + + +(defun ada-header () + "Insert a descriptive header at the top of the file." + (interactive "*") + (save-excursion + (goto-char (point-min)) + (if (fboundp 'make-header) + (make-header) + (ada-header-tmpl)))) + + +(define-skeleton ada-header-tmpl + "Insert a comment block containing the module title, author, etc." + "[Description]: " + "-- -*- Mode: Ada -*-" + "\n-- Filename : " (buffer-name) + "\n-- Description : " str + "\n-- Author : " (user-full-name) + "\n-- Created On : " (current-time-string) + "\n-- Last Modified By: ." + "\n-- Last Modified On: ." + "\n-- Update Count : 0" + "\n-- Status : Unknown, Use with caution!" + "\n") + + +(define-skeleton ada-display-comment + "Inserts three comment lines, making a display comment." + () + "--\n-- " _ "\n--") + + +(define-skeleton ada-if + "Insert skeleton if statment, prompting for a boolean-expression." + "[condition]: " + "if " str " then" \n + > _ \n + < "end if;") + + +(define-skeleton ada-elsif + "Add an elsif clause to an if statement, +prompting for the boolean-expression." + "[condition]: " + < "elsif " str " then" \n + >) + + +(define-skeleton ada-else + "Add an else clause inside an if-then-end-if clause." + () + < "else" \n + >) + + +(define-skeleton ada-loop + "Insert a skeleton loop statement. The exit statement is added by hand." + "[loop name]: " + < str & ?: & \n + > "loop" \n + > _ \n + < "end loop " str | -1 ?\;) + + +(define-skeleton ada-for-loop-prompt-variable + "Prompt for the loop variable." + "[loop variable]: " + str) + + +(define-skeleton ada-for-loop-prompt-range + "Prompt for the loop range." + "[loop range]: " + str) + + +(define-skeleton ada-for-loop + "Build a skeleton for-loop statement, prompting for the loop parameters." + "[loop name]: " + < str & ?: & \n + > "for " + (ada-for-loop-prompt-variable) + " in " + (ada-for-loop-prompt-range) + " loop" \n + > _ \n + < "end loop " str | -1 ?\;) + + +(define-skeleton ada-while-loop-prompt-entry-condition + "Prompt for the loop entry condition." + "[entry condition]: " + str) + + +(define-skeleton ada-while-loop + "Insert a skeleton while loop statement." + "[loop name]: " + < str & ?: & \n + > "while " + (ada-while-loop-prompt-entry-condition) + " loop" \n + > _ \n + < "end loop " str | -1 ?\;) + + +(define-skeleton ada-package-spec + "Insert a skeleton package specification." + "[package name]: " + "package " str " is" \n + > _ \n + < "end " str ?\;) + + +(define-skeleton ada-package-body + "Insert a skeleton package body -- includes a begin statement." + "[package name]: " + "package body " str " is" \n + > _ \n +; < "begin" \n + < "end " str ?\;) + + +(define-skeleton ada-private + "Undent and start a private section of a package spec. Reindent." + () + < "private" \n + >) + + +(define-skeleton ada-function-spec-prompt-return + "Prompts for function result type." + "[result type]: " + str) + + +(define-skeleton ada-function-spec + "Insert a function specification. Prompts for name and arguments." + "[function name]: " + "function " str + " (" ("[parameter_specification]: " str "; " ) -2 ")" + " return " + (ada-function-spec-prompt-return) + ";" \n ) + + +(define-skeleton ada-procedure-spec + "Insert a procedure specification, prompting for its name and arguments." + "[procedure name]: " + "procedure " str + " (" ("[parameter_specification]: " str "; " ) -2 ")" + ";" \n ) + + +(define-skeleton ada-subprogram-body + "Insert frame for subprogram body. +Invoke right after `ada-function-spec' or `ada-procedure-spec'." + () + ;; Remove `;' from subprogram decl + (save-excursion + (ada-search-ignore-string-comment ada-subprog-start-re t nil) + (ada-search-ignore-string-comment "(" nil nil t) + (backward-char 1) + (forward-sexp 1) + (if (looking-at ";") + (delete-char 1))) + < "is" \n + > _ \n + < "begin" \n + > (if ada-stmt-use-debug + (format ada-debug-call-str (ada-func-or-proc-name))) \n + > \n + < (if ada-stmt-use-debug + "exception") & \n + > (if ada-stmt-use-debug + "when others =>") & \n + > (if ada-stmt-use-debug + (format ada-debug-exception-str (ada-func-or-proc-name))) \n + < < "end " + (ada-func-or-proc-name) + ?\;) + + +(define-skeleton ada-separate + "Finish a body stub with `separate'." + () + > "separate;" \n + <) + + +;(define-skeleton ada-with +; "Inserts a with clause, prompting for the list of units depended upon." +; "[list of units depended upon]: " +; "with " str ?\;) + +;(define-skeleton ada-use +; "Inserts a use clause, prompting for the list of packages used." +; "[list of packages used]: " +; "use " str ?\;) + + +(define-skeleton ada-record + "Insert a skeleton record type declaration." + () + "record" \n + > _ \n + < "end record;") + + +(define-skeleton ada-subtype + "Start insertion of a subtype declaration, prompting for the subtype name." + "[subtype name]: " + "subtype " str " is " _ ?\; + (not (message "insert subtype indication."))) + + +(define-skeleton ada-type + "Start insertion of a type declaration, prompting for the type name." + "[type name]: " + "type " str ?\( + ("[discriminant specs]: " str " ") + | (backward-delete-char 1) | ?\) + " is " + (not (message "insert type definition."))) + + +(define-skeleton ada-task-body + "Insert a task body, prompting for the task name." + "[task name]: " + "task body " str " is\n" + "begin\n" + > _ \n + < "end " str ";" ) + + +(define-skeleton ada-task-spec + "Insert a task specification, prompting for the task name." + "[task name]: " + "task " str + " (" ("[discriminant]: " str "; ") ") is\n" + > "entry " _ \n + <"end " str ";" ) + + +(define-skeleton ada-get-param1 + "Prompt for arguments and if any enclose them in brackets." + () + ("[parameter_specification]: " str "; " ) & -2 & ")" + ) + + +(define-skeleton ada-get-param + "Prompt for arguments and if any enclose them in brackets." + () + " (" + (ada-get-param1) | -2 + ) + + +(define-skeleton ada-entry + "Insert a task entry, prompting for the entry name." + "[entry name]: " + "entry " str + (ada-get-param) + ";" \n +; (ada-indent-current) +) + + +(define-skeleton ada-entry-family-prompt-discriminant + "Insert a entry specification, prompting for the entry name." + "[discriminant name]: " + str) + + +(define-skeleton ada-entry-family + "Insert a entry specification, prompting for the entry name." + "[entry name]: " + "entry " str + " (" (ada-entry-family-prompt-discriminant) ")" + (ada-get-param) + ";" \n + ;(ada-indent-current) +) + + +(define-skeleton ada-select + "Insert a select block." + () + "select\n" + > _ \n + < "end select;") + + +(define-skeleton ada-accept-1 + "Insert a condition statement, prompting for the condition name." + "[condition]: " + "when " str | -5 ) + + +(define-skeleton ada-accept-2 + "Insert an accept statement, prompting for the name and arguments." + "[accept name]: " + > "accept " str + (ada-get-param) +; " (" ("[parameter_specification]: " str "; ") -2 ")" + " do" \n + > _ \n + < "end " str ";" ) + + +(define-skeleton ada-accept + "Insert an accept statement (prompt for condition, name and arguments)." + () + > (ada-accept-1) & " =>\n" + (ada-accept-2) +) + + +(define-skeleton ada-or-accept + "Insert a or statement, prompting for the condition name." + () + < "or\n" + (ada-accept) +) + + +(define-skeleton ada-or-delay + "Insert a delay statement, prompting for the delay value." + "[delay value]: " + < "or\n" + > "delay " str ";") + + +(define-skeleton ada-or-terminate + "Insert a terminate statement." + () + < "or\n" + > "terminate;") + + +;; ---- +(defun ada-adjust-case-skeleton () + "Adjusts the case of the text inserted by a skeleton." + (save-excursion + (let ((aa-end (point))) + (ada-adjust-case-region + (progn (goto-char beg) (forward-word -1) (point)) + (goto-char aa-end)) + ))) + + +;; ---- add menu 'Statements' in Ada mode (MH) +(defun ada-add-statement-menu () + "Adds the menu 'Statements' to the menu bar in Ada mode." + (easy-menu-define ada-stmt-menu ada-mode-map + "Menu for statement templates in Ada." + '("Statements" +; ["Toggle Prompt/Pseudo Code" toggle-skeleton-no-prompt t] + ["Toggle: Debugging" ada-toggle-debugging t] +; ["-------" nil nil] + ["Header" (ada-header) t] + ["-------" nil nil] + ["package Body" (ada-package-body) t] + ["package Spec" (ada-package-spec) t] + ["function Spec" (ada-function-spec) t] + ["procedure Spec" (ada-procedure-spec) t] + ["proc/func Body" (ada-subprogram-body) t] + ["task Body" (ada-task-body) t] + ["task Spec" (ada-task-spec) t] + ["declare Block" (ada-declare-block) t] + ["exception Block" (ada-exception-block) t] + ["------" nil nil] + ["entry" (ada-entry) t] + ["entry family" (ada-entry-family) t] + ["select" (ada-select) t] + ["accept" (ada-accept) t] + ["or accept" (ada-or-accept) t] + ["or delay" (ada-or-delay) t] + ["or terminate" (ada-or-terminate) t] + ["-----" nil nil] + ["type" (ada-type) t] + ["private" (ada-private) t] + ["subtype" (ada-subtype) t] + ["record" (ada-record) t] + ["array" (ada-array) t] + ["------" nil nil] + ["if" (ada-if) t] + ["else" (ada-else) t] + ["elsif" (ada-elsif) t] + ["case" (ada-case) t] + ["-----" nil nil] + ["while Loop" (ada-while-loop) t] + ["for Loop" (ada-for-loop) t] + ["loop" (ada-loop) t] + ["---" nil nil] + ["exception" (ada-exception) t] + ["exit" (ada-exit) t] + ["when" (ada-when) t] + )) + (if (ada-xemacs) + (progn + (easy-menu-add ada-stmt-menu) + (setq mode-popup-menu (cons "Ada Mode" ada-stmt-menu))))) + + + +(add-hook 'ada-mode-hook 'ada-add-statement-menu) +(add-hook 'ada-mode-hook '(lambda () + (setq skeleton-further-elements + '((< '(backward-delete-char-untabify + (min ada-indent (current-column)))))) + (add-hook 'skeleton-end-hook + 'ada-adjust-case-skeleton))) + +(provide 'ada-stmt) + +;;; ada-stmt.el ends here
--- a/lisp/modes/arc-mode.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/modes/arc-mode.el Mon Aug 13 09:57:07 2007 +0200 @@ -101,118 +101,216 @@ ;; ------------------------------------------------------------------------- ;; Section: Configuration. -(defvar archive-dos-members t - "*If non-nil then recognize member files using ^M^J as line terminator.") +(defgroup archive nil + "Simple editing of archives." + :group 'data) + +(defgroup archive-arc nil + "ARC-specific options to archive." + :group 'archive) + +(defgroup archive-lzh nil + "LZH-specific options to archive." + :group 'archive) -(defvar archive-tmpdir +(defgroup archive-zip nil + "ZIP-specific options to archive." + :group 'archive) + +(defgroup archive-zoo nil + "ZOO-specific options to archive." + :group 'archive) + + +(defcustom archive-dos-members t + "*If non-nil then recognize member files using ^M^J as line terminator." + :type 'boolean + :group 'archive) + +(defcustom archive-tmpdir (expand-file-name (make-temp-name (if (eq system-type 'ms-dos) "ar" "archive.tmp")) (or (getenv "TMPDIR") (getenv "TMP") "/tmp")) - "*Directory for temporary files made by arc-mode.el") + "*Directory for temporary files made by arc-mode.el" + :type 'directory + :group 'archive) -(defvar archive-remote-regexp "^/[^/:]*[^/:.]:" +(defcustom archive-remote-regexp "^/[^/:]*[^/:.]:" "*Regexp recognizing archive files names that are not local. A non-local file is one whose file name is not proper outside Emacs. -A local copy of the archive will be used when updating.") +A local copy of the archive will be used when updating." + :type 'regexp + :group 'archive) -(defvar archive-extract-hooks nil - "*Hooks to run when an archive member has been extracted.") +(defcustom archive-extract-hooks nil + "*Hooks to run when an archive member has been extracted." + :type 'hook + :group 'archive) ;; ------------------------------ ;; Arc archive configuration ;; We always go via a local file since there seems to be no reliable way ;; to extract to stdout without junk getting added. -(defvar archive-arc-extract +(defcustom archive-arc-extract '("arc" "x") "*Program and its options to run in order to extract an arc file member. Extraction should happen to the current directory. Archive and member -name will be added.") +name will be added." + :type '(list (string :tag "Program") + (repeat :tag "Options" + :inline t + (string :format "%v"))) + :group 'archive-arc) -(defvar archive-arc-expunge +(defcustom archive-arc-expunge '("arc" "d") "*Program and its options to run in order to delete arc file members. -Archive and member names will be added.") +Archive and member names will be added." + :type '(list (string :tag "Program") + (repeat :tag "Options" + :inline t + (string :format "%v"))) + :group 'archive-arc) -(defvar archive-arc-write-file-member +(defcustom archive-arc-write-file-member '("arc" "u") "*Program and its options to run in order to update an arc file member. -Archive and member name will be added.") +Archive and member name will be added." + :type '(list (string :tag "Program") + (repeat :tag "Options" + :inline t + (string :format "%v"))) + :group 'archive-arc) ;; ------------------------------ ;; Lzh archive configuration -(defvar archive-lzh-extract +(defcustom archive-lzh-extract '("lha" "pq") "*Program and its options to run in order to extract an lzh file member. Extraction should happen to standard output. Archive and member name will -be added.") +be added." + :type '(list (string :tag "Program") + (repeat :tag "Options" + :inline t + (string :format "%v"))) + :group 'archive-lzh) -(defvar archive-lzh-expunge +(defcustom archive-lzh-expunge '("lha" "d") "*Program and its options to run in order to delete lzh file members. -Archive and member names will be added.") +Archive and member names will be added." + :type '(list (string :tag "Program") + (repeat :tag "Options" + :inline t + (string :format "%v"))) + :group 'archive-lzh) -(defvar archive-lzh-write-file-member +(defcustom archive-lzh-write-file-member '("lha" "a") "*Program and its options to run in order to update an lzh file member. -Archive and member name will be added.") +Archive and member name will be added." + :type '(list (string :tag "Program") + (repeat :tag "Options" + :inline t + (string :format "%v"))) + :group 'archive-lzh) ;; ------------------------------ ;; Zip archive configuration -(defvar archive-zip-use-pkzip (memq system-type '(ms-dos windows-nt)) +(defcustom archive-zip-use-pkzip (memq system-type '(ms-dos windows-nt)) "*If non-nil then pkzip option are used instead of zip options. -Only set to true for msdog systems!") +Only set to true for msdog systems!" + :type 'boolean + :group 'archive-zip) -(defvar archive-zip-extract +(defcustom archive-zip-extract (if archive-zip-use-pkzip '("pkunzip" "-e") '("unzip" "-qq" "-c")) "*Program and its options to run in order to extract a zip file member. Extraction should happen to standard output. Archive and member name will be added. If `archive-zip-use-pkzip' is non-nil then this program is -expected to extract to a file junking the directory part of the name.") +expected to extract to a file junking the directory part of the name." + :type '(list (string :tag "Program") + (repeat :tag "Options" + :inline t + (string :format "%v"))) + :group 'archive-zip) ;; For several reasons the latter behaviour is not desirable in general. ;; (1) It uses more disk space. (2) Error checking is worse or non- ;; existent. (3) It tends to do funny things with other systems' file ;; names. -(defvar archive-zip-expunge +(defcustom archive-zip-expunge (if archive-zip-use-pkzip '("pkzip" "-d") '("zip" "-d" "-q")) "*Program and its options to run in order to delete zip file members. -Archive and member names will be added.") +Archive and member names will be added." + :type '(list (string :tag "Program") + (repeat :tag "Options" + :inline t + (string :format "%v"))) + :group 'archive-zip) -(defvar archive-zip-update +(defcustom archive-zip-update (if archive-zip-use-pkzip '("pkzip" "-u") '("zip" "-q")) "*Program and its options to run in order to update a zip file member. Options should ensure that specified directory will be put into the zip -file. Archive and member name will be added.") +file. Archive and member name will be added." + :type '(list (string :tag "Program") + (repeat :tag "Options" + :inline t + (string :format "%v"))) + :group 'archive-zip) -(defvar archive-zip-update-case +(defcustom archive-zip-update-case (if archive-zip-use-pkzip archive-zip-update '("zip" "-q" "-k")) "*Program and its options to run in order to update a case fiddled zip member. Options should ensure that specified directory will be put into the zip file. -Archive and member name will be added.") +Archive and member name will be added." + :type '(list (string :tag "Program") + (repeat :tag "Options" + :inline t + (string :format "%v"))) + :group 'archive-zip) -(defvar archive-zip-case-fiddle t +(defcustom archive-zip-case-fiddle t "*If non-nil then zip file members are case fiddled. Case fiddling will only happen for members created by a system that -uses caseless file names.") +uses caseless file names." + :type 'boolean + :group 'archive-zip) ;; ------------------------------ ;; Zoo archive configuration -(defvar archive-zoo-extract +(defcustom archive-zoo-extract '("zoo" "xpq") "*Program and its options to run in order to extract a zoo file member. Extraction should happen to standard output. Archive and member name will -be added.") +be added." + :type '(list (string :tag "Program") + (repeat :tag "Options" + :inline t + (string :format "%v"))) + :group 'archive-zoo) -(defvar archive-zoo-expunge +(defcustom archive-zoo-expunge '("zoo" "DqPP") "*Program and its options to run in order to delete zoo file members. -Archive and member names will be added.") +Archive and member names will be added." + :type '(list (string :tag "Program") + (repeat :tag "Options" + :inline t + (string :format "%v"))) + :group 'archive-zoo) -(defvar archive-zoo-write-file-member +(defcustom archive-zoo-write-file-member '("zoo" "a") "*Program and its options to run in order to update a zoo file member. -Archive and member name will be added.") +Archive and member name will be added." + :type '(list (string :tag "Program") + (repeat :tag "Options" + :inline t + (string :format "%v"))) + :group 'archive-zoo) ;; ------------------------------------------------------------------------- ;; Section: Variables
--- a/lisp/modes/auto-autoloads.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/modes/auto-autoloads.el Mon Aug 13 09:57:07 2007 +0200 @@ -8,7 +8,7 @@ ;;;### (autoloads (ada-make-filename-from-adaname ada-mode) "ada-mode" "modes/ada-mode.el") (autoload 'ada-mode "ada-mode" "\ -Ada Mode is the major mode for editing Ada code. +Ada mode is the major mode for editing Ada code. Bindings are as follows: (Note: 'LFD' is control-j.) @@ -28,7 +28,7 @@ Fill comment paragraph and justify each line '\\[ada-fill-comment-paragraph-justify]' Fill comment paragraph, justify and append postfix '\\[ada-fill-comment-paragraph-postfix]' - Next func/proc/task '\\[ada-next-procedure]' Previous func/proc/task '\\[ada-previous-procedure]' + Next func/proc/task '\\[ada-next-procedure]' Previous func/proc/task '\\[ada-previous-procedure]' Next package '\\[ada-next-package]' Previous package '\\[ada-previous-package]' Goto matching start of current 'end ...;' '\\[ada-move-to-start]' @@ -482,9 +482,7 @@ ;;;### (autoloads (hs-minor-mode hs-hide-block hs-hide-all) "hideshow" "modes/hideshow.el") -(defvar hs-minor-mode nil "\ -Non-nil if using hideshow mode as a minor mode of some other mode. -Use the command `hs-minor-mode' to toggle this variable.") +(defcustom hs-minor-mode nil "Non-nil if using hideshow mode as a minor mode of some other mode.\nUse the command `hs-minor-mode' to toggle this variable." :type 'boolean :set (lambda (symbol value) (hs-minor-mode (or value 0))) :initialize 'custom-initialize-default :require 'hideshow :group 'hideshow) (autoload 'hs-hide-all "hideshow" "\ Hides all top-level blocks, displaying only first and last lines. @@ -569,7 +567,7 @@ ;;;### (autoloads (ksh-mode) "ksh-mode" "modes/ksh-mode.el") (autoload 'ksh-mode "ksh-mode" "\ -ksh-mode $Revision: 1.9 $ - Major mode for editing (Bourne, Korn or Bourne again) +ksh-mode $Revision: 1.10 $ - Major mode for editing (Bourne, Korn or Bourne again) shell scripts. Special key bindings and commands: \\{ksh-mode-map} @@ -1277,18 +1275,6 @@ ;;;### (autoloads (resize-minibuffer-mode) "rsz-minibuf" "modes/rsz-minibuf.el") -(defgroup resize-minibuffer nil "Dynamically resize minibuffer to display entire contents" :group 'frames) - -(defcustom resize-minibuffer-window-max-height nil "*Maximum size the minibuffer window is allowed to become.\nIf less than 1 or not a number, the limit is the height of the frame in\nwhich the active minibuffer window resides." :type '(choice (const nil) integer) :group 'resize-minibuffer) - -(defcustom resize-minibuffer-window-exactly t "*If non-`nil', make minibuffer exactly the size needed to display all its contents.\nOtherwise, the minibuffer window can temporarily increase in size but\nnever get smaller while it is active." :type 'boolean :group 'resize-minibuffer) - -(defcustom resize-minibuffer-frame nil "*If non-`nil' and the active minibuffer is the sole window in its frame, allow changing the frame height." :type 'boolean :group 'resize-minibuffer) - -(defcustom resize-minibuffer-frame-max-height nil "*Maximum size the minibuffer frame is allowed to become.\nIf less than 1 or not a number, there is no limit.") - -(defcustom resize-minibuffer-frame-exactly nil "*If non-`nil', make minibuffer frame exactly the size needed to display all its contents.\nOtherwise, the minibuffer frame can temporarily increase in size but\nnever get smaller while it is active." :type 'boolean :group 'resize-minibuffer) - (autoload 'resize-minibuffer-mode "rsz-minibuf" "\ Enable or disable resize-minibuffer mode. A negative prefix argument disables this mode. A positive argument or @@ -1560,8 +1546,7 @@ ;;;### (autoloads (strokes-compose-complex-stroke strokes-decode-buffer strokes-mode strokes-list-strokes strokes-load-user-strokes strokes-help strokes-describe-stroke strokes-do-complex-stroke strokes-do-stroke strokes-read-stroke strokes-global-set-stroke) "strokes" "modes/strokes.el") -(defvar strokes-mode nil "\ -Non-nil when `strokes' is globally enabled") +(defcustom strokes-mode nil "Non-nil when `strokes' is globally enabled." :type 'boolean :set (lambda (symbol value) (strokes-mode (or value 0))) :initialize 'custom-initialize-default :require 'strokes :group 'strokes) (autoload 'strokes-global-set-stroke "strokes" "\ Interactively give STROKE the global binding as COMMAND. @@ -1935,7 +1920,7 @@ (autoload 'vhdl-mode "vhdl-mode" "\ Major mode for editing VHDL code. -vhdl-mode $Revision: 1.9 $ +vhdl-mode $Revision: 1.10 $ 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
--- a/lisp/modes/cl-indent.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/modes/cl-indent.el Mon Aug 13 09:57:07 2007 +0200 @@ -51,7 +51,7 @@ ;;; Code: (defgroup lisp-indent nil - "Indentation in Lisp" + "Enhanced lisp-indent mode." :group 'lisp)
--- a/lisp/modes/custom-load.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/modes/custom-load.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,31 +1,6 @@ -(custom-put 'xrdb 'custom-loads '("xrdb-mode")) -(custom-put 'winmgr 'custom-loads '("winmgr-mode")) -(custom-put 'whitespace 'custom-loads '("whitespace-mode")) -(custom-put 'vrml 'custom-loads '("vrml-mode")) -(custom-put 'verilog 'custom-loads '("verilog-mode")) -(custom-put 'texinfo 'custom-loads '("texinfo")) -(custom-put 'tcl 'custom-loads '("tcl")) +(custom-put 'extensions 'custom-loads '(("auto-show") "strokes")) +(custom-put 'mouse 'custom-loads '("strokes")) +(custom-put 'environment 'custom-loads '(("rsz-minibuf"))) +(custom-put 'lisp 'custom-loads '("strokes")) (custom-put 'strokes 'custom-loads '("strokes")) -(custom-put 'sh-script 'custom-loads '("sh-script")) -(custom-put 'sh 'custom-loads '("sh-script")) -(custom-put 'resize-minibuffer 'custom-loads '("rsz-minibuf")) -(custom-put 'rexx 'custom-loads '("rexx-mode")) -(custom-put 'reftex-label-support 'custom-loads '("reftex")) -(custom-put 'reftex 'custom-loads '("reftex")) -(custom-put 'prolog 'custom-loads '("prolog")) -(custom-put 'pascal 'custom-loads '("pascal")) -(custom-put 'outl-mouse 'custom-loads '("outl-mouse")) -(custom-put 'makefile-mode 'custom-loads '("make-mode")) -(custom-put 'mail-abbrevs 'custom-loads '("mail-abbrevs")) -(custom-put 'icon 'custom-loads '("icon")) -(custom-put 'fortran-comment 'custom-loads '("fortran")) -(custom-put 'fortran-indent 'custom-loads '("fortran")) -(custom-put 'fortran 'custom-loads '("f90" "fortran")) -(custom-put 'f90-indent 'custom-loads '("f90")) -(custom-put 'f90 'custom-loads '("f90")) -(custom-put 'executable 'custom-loads '("executable")) -(custom-put 'enriched 'custom-loads '("enriched")) -(custom-put 'c-macro 'custom-loads '("cmacexp")) -(custom-put 'lisp-indent 'custom-loads '("cl-indent")) -(custom-put 'auto-show 'custom-loads '("auto-show")) -(custom-put 'asm 'custom-loads '("asm-mode")) +(custom-put 'display 'custom-loads '(("auto-show")))
--- a/lisp/modes/hideshow.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/modes/hideshow.el Mon Aug 13 09:57:07 2007 +0200 @@ -84,7 +84,25 @@ ;;;---------------------------------------------------------------------------- ;;; user-configurable variables -(defvar hs-unbalance-handler-method 'top-level +(defgroup hideshow nil + "Selectively display blocks of code." + :prefix "hs-" + :group 'outlines + :group 'tools) + + +;;;###autoload +(defcustom hs-minor-mode nil + "Non-nil if using hideshow mode as a minor mode of some other mode. +Use the command `hs-minor-mode' to toggle this variable." + :type 'boolean + :set (lambda (symbol value) + (hs-minor-mode (or value 0))) + :initialize 'custom-initialize-default + :require 'hideshow + :group 'hideshow) + +(defcustom hs-unbalance-handler-method 'top-level "*Symbol representing how \"unbalanced parentheses\" should be handled. This error is usually signaled by `hs-show-block'. One of four values: `top-level', `next-line', `signal' or `ignore'. Default is `top-level'. @@ -96,9 +114,14 @@ - `signal' -- Pass the error through, stopping execution. - `ignore' -- Ignore the error, continuing execution. -Values other than these four will be interpreted as `signal'.") +Values other than these four will be interpreted as `signal'." + :type '(radio (const :tag "Show top-level block" top-level) + (const :tag "Show block to next line" next-line) + (sexp :format "%t\n" :tag "Signal the error" signal) + (const :tag "Ignore the error" ignore)) + :group 'hideshow) -(defvar hs-special-modes-alist '((c-mode "{" "}") +(defcustom hs-special-modes-alist '((c-mode "{" "}") (c++-mode "{" "}")) "*Alist of the form (MODE START-RE END-RE FORWARD-SEXP-FUNC). If present, hideshow will use these values for the start and end regexps, @@ -116,26 +139,30 @@ \t(pushnew '(simula-mode \"begin\" \"end\" simula-next-statement) \t hs-special-modes-alist :test 'equal) -Note that the regexps should not contain leading or trailing whitespace.") +Note that the regexps should not contain leading or trailing whitespace." + :type 'sexp ; too hard to do right + :group 'hideshow) -(defvar hs-hide-hook nil - "*Hooks called at the end of `hs-hide-all' and `hs-hide-block'.") +(defcustom hs-hide-hook nil + "*Hooks called at the end of `hs-hide-all' and `hs-hide-block'." + :type 'hook + :group 'hideshow) -(defvar hs-show-hook nil +(defcustom hs-show-hook nil "*Hooks called at the end of commands to show text. -These commands include `hs-show-all', `hs-show-block' and `hs-show-region'.") +These commands include `hs-show-all', `hs-show-block' and `hs-show-region'." + :type 'hook + :group 'hideshow) -(defvar hs-minor-mode-prefix "\C-c" - "*Prefix key to use for hideshow commands in hideshow minor mode.") +(defcustom hs-minor-mode-prefix "\C-c" + "*Prefix key to use for hideshow commands in hideshow minor mode." + :type 'hook + :group 'hideshow) ;;;---------------------------------------------------------------------------- ;;; internal variables -;;;###autoload -(defvar hs-minor-mode nil - "Non-nil if using hideshow mode as a minor mode of some other mode. -Use the command `hs-minor-mode' to toggle this variable.") (defvar hs-minor-mode-map (make-sparse-keymap) "Mode map for hideshow minor mode.")
--- a/lisp/modes/lisp-mode.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/modes/lisp-mode.el Mon Aug 13 09:57:07 2007 +0200 @@ -746,6 +746,7 @@ (put 'save-current-buffer 'lisp-indent-function 0) (put 'with-current-buffer 'lisp-indent-function 1) (put 'with-temp-file 'lisp-indent-function 1) +(put 'with-temp-buffer 'lisp-indent-function 0) (put 'with-output-to-string 'lisp-indent-function 0) (put 'with-output-to-temp-buffer 'lisp-indent-function 1)
--- a/lisp/modes/rsz-minibuf.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/modes/rsz-minibuf.el Mon Aug 13 09:57:07 2007 +0200 @@ -8,7 +8,6 @@ ;; Modified for Lucid Emacs By: Peter Stout <pds@cs.cmu.edu> ;; Maintainer: friedman@prep.ai.mit.edu ;; Keywords: minibuffer, window, frames, display -;; Status: Known to work in FSF GNU Emacs 19.23 and Lucid Emacs 19.9. ;; This file is part of XEmacs. @@ -34,7 +33,7 @@ ;; This file has received maintenance by the XEmacs development team. -;; $Id: rsz-minibuf.el,v 1.5 1997/06/26 02:31:05 steve Exp $ +;; $Id: rsz-minibuf.el,v 1.6 1997/09/17 05:19:26 steve Exp $ ;; This package allows the entire contents (or as much as possible) of the ;; minibuffer to be visible at once when typing. As the end of a line is @@ -67,7 +66,6 @@ ;;; Code: -;;;###autoload (defgroup resize-minibuffer nil "Dynamically resize minibuffer to display entire contents" @@ -77,9 +75,9 @@ (defcustom resize-minibuffer-mode nil "*If non-`nil', resize the minibuffer so its entire contents are visible." :type 'boolean + :require 'rsz-minibuf :group 'resize-minibuffer) -;;;###autoload (defcustom resize-minibuffer-window-max-height nil "*Maximum size the minibuffer window is allowed to become. If less than 1 or not a number, the limit is the height of the frame in @@ -87,7 +85,6 @@ :type '(choice (const nil) integer) :group 'resize-minibuffer) -;;;###autoload (defcustom resize-minibuffer-window-exactly t "*If non-`nil', make minibuffer exactly the size needed to display all its contents. Otherwise, the minibuffer window can temporarily increase in size but @@ -96,18 +93,15 @@ :group 'resize-minibuffer) -;;;###autoload (defcustom resize-minibuffer-frame nil "*If non-`nil' and the active minibuffer is the sole window in its frame, allow changing the frame height." :type 'boolean :group 'resize-minibuffer) -;;;###autoload (defcustom resize-minibuffer-frame-max-height nil "*Maximum size the minibuffer frame is allowed to become. If less than 1 or not a number, there is no limit.") -;;;###autoload (defcustom resize-minibuffer-frame-exactly nil "*If non-`nil', make minibuffer frame exactly the size needed to display all its contents. Otherwise, the minibuffer frame can temporarily increase in size but @@ -150,32 +144,12 @@ (t (setq resize-minibuffer-mode nil)))) -;;; Glue code to make things work in both FSF and Lucid Emacsen. -(if (string-match "Lucid" emacs-version) - (progn - (fset 'resize-frame-parameters 'screen-parameters) - (fset 'resize-frame-height 'screen-height) - (fset 'resize-frame-width 'screen-width) - (fset 'resize-selected-frame 'selected-screen) - (fset 'resize-set-frame-size 'set-screen-size) - (defun resize-minibuffer-frame-alist () - "Return the frame alist for the minibuffer." - minibuffer-alist)) - (fset 'resize-frame-parameters 'frame-parameters) - (fset 'resize-frame-height 'frame-height) - (fset 'resize-frame-width 'frame-width) - (fset 'resize-selected-frame 'selected-frame) - (fset 'resize-set-frame-size 'set-frame-size) - (defun resize-minibuffer-frame-alist () - "Return the frame alist for the minibuffer." - minibuffer-frame-alist)) - (defun resize-minibuffer-setup () (cond (resize-minibuffer-mode (cond ((and (not (eq 'tty (console-type))) - (eq 'only (cdr (assq 'minibuffer (resize-frame-parameters))))) + (eq 'only (plist-get (frame-properties) 'minibuffer))) (and resize-minibuffer-frame (progn (make-local-hook 'minibuffer-exit-hook) @@ -211,16 +185,6 @@ (goto-char start) (vertical-motion (buffer-size)))))) -;; Why isn't `min' a subr? -;; Do not pretend this is a real definition of `min'. It suffices for this -;; packages's purposes (and is reasonably fast for a lisp call) but a real -;; min function would be able to take more than 2 arguments. -(defun resize-minibuffer-min (x y) - "Return the lesser of X or Y." - (if (< x y) - x - y)) - ;; Resize the minibuffer window to contain the minibuffer's contents. ;; The minibuffer must be the current window. @@ -229,7 +193,7 @@ (lines (1+ (resize-minibuffer-count-window-lines)))) (and (numberp resize-minibuffer-window-max-height) (> resize-minibuffer-window-max-height 0) - (setq lines (resize-minibuffer-min + (setq lines (min lines resize-minibuffer-window-max-height))) (or (if resize-minibuffer-window-exactly @@ -241,30 +205,25 @@ ;; Resize the minibuffer frame to contain the minibuffer's contents. ;; The minibuffer frame must be the current frame. (defun resize-minibuffer-frame () - (let ((height (resize-frame-height)) + (let ((height (frame-height)) (lines (1+ (resize-minibuffer-count-window-lines)))) (and (numberp resize-minibuffer-frame-max-height) (> resize-minibuffer-frame-max-height 0) - (setq lines (resize-minibuffer-min + (setq lines (min lines resize-minibuffer-frame-max-height))) (cond ((> lines height) - (resize-set-frame-size (resize-selected-frame) - (resize-frame-width) - lines)) + (set-frame-size (selected-frame) (frame-width) lines)) ((and resize-minibuffer-frame-exactly - (> height (cdr (assq 'height (resize-minibuffer-frame-alist)))) + (> height (plist-get minibuffer-frame-plist 'height)) (< lines height)) - (resize-set-frame-size (resize-selected-frame) - (resize-frame-width) - lines))))) + (set-frame-size (selected-frame) (frame-width) lines))))) ;; Restore the original height of the frame. (defun resize-minibuffer-frame-restore () - (resize-set-frame-size (resize-selected-frame) - (resize-frame-width) - (cdr (assq 'height (resize-minibuffer-frame-alist))))) + (set-frame-size (selected-frame) (frame-width) + (plist-get minibuffer-frame-plist 'height))) (provide 'rsz-minibuf)
--- a/lisp/modes/scribe.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/modes/scribe.el Mon Aug 13 09:57:07 2007 +0200 @@ -3,7 +3,7 @@ ;; Copyright (C) 1985 Free Software Foundation, Inc. -;; This file might become part of GNU Emacs. +;; This file is part of XEmacs. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but without any warranty. No author or distributor @@ -19,6 +19,10 @@ ;; It should be in a file named COPYING. Among other things, the ;; copyright notice and this notice must be preserved on all copies. +(defgroup scribe nil + "Scribe mode, and its idiosyncratic commands." + :group 'wp) + (defvar scribe-mode-syntax-table nil "Syntax table used while in scribe mode.") @@ -26,15 +30,21 @@ (defvar scribe-mode-abbrev-table nil "Abbrev table used while in scribe mode.") -(defvar scribe-fancy-paragraphs nil - "*Non-NIL makes Scribe mode use a different style of paragraph separation.") +(defcustom scribe-fancy-paragraphs nil + "*Non-NIL makes Scribe mode use a different style of paragraph separation." + :type 'boolean + :group 'scribe) -(defvar scribe-electric-quote nil - "*Non-NIL makes insert of double quote use `` or '' depending on context.") +(defcustom scribe-electric-quote nil + "*Non-NIL makes insert of double quote use `` or '' depending on context." + :type 'boolean + :group 'scribe) -(defvar scribe-electric-parenthesis nil +(defcustom scribe-electric-parenthesis nil "*Non-NIL makes parenthesis char ( (]}> ) automatically insert its close -if typed after an @Command form.") +if typed after an @Command form." + :type 'boolean + :group 'scribe) (defconst scribe-open-parentheses "[({<" "Open parenthesis characters for Scribe.") @@ -150,7 +160,7 @@ "Surround current word with Scribe construct @STRING[...]. COUNT specifies how many words to surround. A negative count means to skip backward." - (let ((spos (point)) (epos (point)) (ccoun 0) noparens) + (let ((spos (point)) (epos (point)) (ccoun 0)) (if (not (zerop count)) (progn (if (= (char-syntax (preceding-char)) ?w) (forward-sexp (min -1 count)))
--- a/lisp/modes/sh-script.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/modes/sh-script.el Mon Aug 13 09:57:07 2007 +0200 @@ -50,15 +50,10 @@ (require 'executable) (defgroup sh nil - "Shell programming utilities" + "Shell programming mode." :group 'unix :group 'languages) -(defgroup sh-script nil - "Shell script mode" - :group 'sh - :prefix "sh-") - ;;; interpreter-mode-alist is not compatible between Emacs and XEmacs. ;;; So fake it. @@ -106,12 +101,12 @@ (defcustom sh-mode-hook nil "*Hook run by `sh-mode'." :type 'hook - :group 'sh-script) + :group 'sh) (defcustom sh-set-shell-hook nil "*Hook run by `sh-set-shell'." :type 'hook - :group 'sh-script) + :group 'sh) (defcustom sh-ancestor-alist '((ash . sh) @@ -154,7 +149,7 @@ posix IEEE 1003.2 Shell Standard wsh ? Shell" :type '(repeat (cons symbol symbol)) - :group 'sh-script) + :group 'sh) (defcustom sh-alias-alist @@ -169,13 +164,13 @@ Use this where the name of the executable doesn't correspond to the type of shell it really is." :type '(repeat (cons symbol symbol)) - :group 'sh-script) + :group 'sh) (defcustom sh-shell-file (or (getenv "SHELL") "/bin/sh") "*The executable file name for the shell being programmed." :type 'string - :group 'sh-script) + :group 'sh) (defcustom sh-shell-arg @@ -199,7 +194,7 @@ (cons :format "Evaluate: %v" (const :format "" eval) sexp)))) - :group 'sh-script) + :group 'sh) (defvar sh-shell-variables nil "Alist of shell variable names that should be included in completion. @@ -350,7 +345,7 @@ comint-dynamic-complete-filename) "*Functions for doing TAB dynamic completion." :type '(repeat function) - :group 'sh-script) + :group 'sh) (defcustom sh-require-final-newline @@ -365,7 +360,7 @@ (cons :format "Evaluate: %v" (const :format "" eval) sexp)))) - :group 'sh-script) + :group 'sh) (defcustom sh-comment-prefix @@ -381,7 +376,7 @@ (cons :format "Evaluate: %v" (const :format "" eval) sexp)))) - :group 'sh-script) + :group 'sh) (defcustom sh-assignment-regexp @@ -398,19 +393,19 @@ (cons :format "Evaluate: %v" (const :format "" eval) sexp)))) - :group 'sh-script) + :group 'sh) (defcustom sh-indentation 4 "The width for further indentation in Shell-Script mode." :type 'integer - :group 'sh-script) + :group 'sh) (defcustom sh-remember-variable-min 3 "*Don't remember variables less than this length for completing reads." :type 'integer - :group 'sh-script) + :group 'sh) (defvar sh-header-marker nil @@ -423,7 +418,7 @@ "*Regexp to determine the beginning of a shell command. The actual command starts at the beginning of the second \\(grouping\\)." :type 'regexp - :group 'sh-script) + :group 'sh) (defcustom sh-end-of-command @@ -431,7 +426,7 @@ "*Regexp to determine the end of a shell command. The actual command ends at the end of the first \\(grouping\\)." :type 'regexp - :group 'sh-script) + :group 'sh) @@ -515,7 +510,7 @@ (cons :format "Evaluate: %v" (const :format "" eval) sexp)))) - :group 'sh-script) + :group 'sh) @@ -536,7 +531,7 @@ (cons :format "Evaluate: %v" (const :format "" eval) sexp)))) - :group 'sh-script) + :group 'sh) (defcustom sh-other-keywords @@ -572,7 +567,7 @@ (cons :format "Evaluate: %v" (const :format "" eval) sexp)))) - :group 'sh-script) + :group 'sh) @@ -1533,6 +1528,6 @@ (if (re-search-forward sh-end-of-command nil t) (goto-char (match-end 1)))) -(provide 'sh-script) +(provide 'sh) ;; sh-script.el ends here
--- a/lisp/modes/simula.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/modes/simula.el Mon Aug 13 09:57:07 2007 +0200 @@ -41,54 +41,86 @@ (provide 'simula-mode) -(defconst simula-tab-always-indent nil +(defgroup simula nil + "SIMULA 87 code editing commands for Emacs." + :group 'languages) + + +(defcustom simula-tab-always-indent nil "*Non-nil means TAB in SIMULA mode should always reindent the current line. Otherwise TAB indents only when point is within -the run of whitespace at the beginning of the line.") - -(defconst simula-indent-level 3 - "*Indentation of SIMULA statements with respect to containing block.") +the run of whitespace at the beginning of the line." + :type 'boolean + :group 'simula) -(defconst simula-substatement-offset 3 - "*Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE.") +(defcustom simula-indent-level 3 + "*Indentation of SIMULA statements with respect to containing block." + :type 'integer + :group 'simula) -(defconst simula-continued-statement-offset 3 +(defcustom simula-substatement-offset 3 + "*Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE." + :type 'integer + :group 'simula) + +(defcustom simula-continued-statement-offset 3 "*Extra indentation for lines not starting a statement or substatement. If value is a list, each line in a multipleline continued statement will have the car of the list extra indentation with respect to -the previous line of the statement.") +the previous line of the statement." + :type 'integer + :group 'simula) -(defconst simula-label-offset -4711 - "*Offset of SIMULA label lines relative to usual indentation.") +(defcustom simula-label-offset -4711 + "*Offset of SIMULA label lines relative to usual indentation." + :type 'integer + :group 'simula) -(defconst simula-if-indent '(0 . 0) +(defcustom simula-if-indent '(0 . 0) "*Extra indentation of THEN and ELSE with respect to the starting IF. Value is a cons cell, the car is extra THEN indentation and the cdr -extra ELSE indentation. IF after ELSE is indented as the starting IF.") +extra ELSE indentation. IF after ELSE is indented as the starting IF." + :type '(cons (integer :tag "THEN") + (integer :tag "ELSE")) + :group 'simula) -(defconst simula-inspect-indent '(0 . 0) +(defcustom simula-inspect-indent '(0 . 0) "*Extra indentation of WHEN and OTHERWISE with respect to the INSPECT. Value is a cons cell, the car is extra WHEN indentation -and the cdr extra OTHERWISE indentation.") +and the cdr extra OTHERWISE indentation." + :type '(cons (integer :tag "WHEN") + (integer :tag "OTHERWISE")) + :group 'simula) -(defconst simula-electric-indent nil - "*Non-nil means `simula-indent-line' function may reindent previous line.") +(defcustom simula-electric-indent nil + "*Non-nil means `simula-indent-line' function may reindent previous line." + :type 'boolean + :group 'simula) -(defconst simula-abbrev-keyword 'upcase +(defcustom simula-abbrev-keyword 'upcase "*Specify how to convert case for SIMULA keywords. Value is one of the symbols `upcase', `downcase', `capitalize', -\(as in) `abbrev-table' or nil if they should not be changed.") +\(as in) `abbrev-table' or nil if they should not be changed." + :type '(choice (const upcase) (const downcase) (const capitalize) + (const abbrev-table) (const nil)) + :group 'simula) -(defconst simula-abbrev-stdproc 'abbrev-table +(defcustom simula-abbrev-stdproc 'abbrev-table "*Specify how to convert case for standard SIMULA procedure and class names. Value is one of the symbols `upcase', `downcase', `capitalize', -\(as in) `abbrev-table', or nil if they should not be changed.") +\(as in) `abbrev-table', or nil if they should not be changed." + :type '(choice (const upcase) (const downcase) (const capitalize) + (const abbrev-table) (const nil)) + :group 'simula) -(defvar simula-abbrev-file nil +(defcustom simula-abbrev-file nil "*File with extra abbrev definitions for use in SIMULA mode. These are used together with the standard abbrev definitions for SIMULA. Please note that the standard definitions are required -for SIMULA mode to function correctly.") +for SIMULA mode to function correctly." + :type '(choice (const :tag "None") + file) + :group 'simula) (defvar simula-mode-syntax-table nil "Syntax table in SIMULA mode buffers.")
--- a/lisp/modes/strokes.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/modes/strokes.el Mon Aug 13 09:57:07 2007 +0200 @@ -145,7 +145,8 @@ ;; byte-compiled) and then add the following to your .emacs file (or ;; wherever you put XEmacs-specific startup preferences): -;; (if window-system (require 'strokes)) +;; (and (console-on-window-system-p) +;; (require 'strokes)) ;; Once loaded, you can start stroking. You can also toggle between ;; strokes mode by simple typing @@ -373,7 +374,21 @@ (defgroup strokes nil "Control Emacs through mouse strokes." - :group 'mouse) + :group 'mouse + :group 'lisp + :group 'extensions) + +;; This is an internal variable, but we defcustom it so Customize can +;; use it. +;;;###autoload +(defcustom strokes-mode nil + "Non-nil when `strokes' is globally enabled." + :type 'boolean + :set (lambda (symbol value) + (strokes-mode (or value 0))) + :initialize 'custom-initialize-default + :require 'strokes + :group 'strokes) (defcustom strokes-modeline-string " Strokes" "*Modeline identification when strokes are on \(default is \" Strokes\"\)." @@ -446,10 +461,6 @@ ;;; internal variables... -;;;###autoload -(defvar strokes-mode nil - "Non-nil when `strokes' is globally enabled") - (defvar strokes-window-configuration nil "The special window configuration used when entering strokes. This is set properly in the function `strokes-update-window-configuration'.") @@ -577,7 +588,7 @@ Example of how one might fix up a command that's bound to button2 and which is an interactive funcion of one event argument: -(strokes-fix-button2-command 'vm-mouse-button-2)" +\(strokes-fix-button2-command 'vm-mouse-button-2)" (let ((command (eval command))) `(progn (defadvice ,command (around strokes-fix-button2 compile preactivate) @@ -586,31 +597,37 @@ ',(intern (format "ad-Orig-%s" command)))) (strokes-do-stroke (ad-get-arg 0))))))) -(strokes-fix-button2-command 'vm-mouse-button-2) -(strokes-fix-button2-command 'rmail-summary-mouse-goto-msg) -(strokes-fix-button2-command 'Buffer-menu-mouse-select) -(strokes-fix-button2-command 'w3-widget-button-click) -(strokes-fix-button2-command 'widget-image-button-press) -(strokes-fix-button2-command 'Info-follow-clicked-node) -(strokes-fix-button2-command 'compile-mouse-goto-error) -(strokes-fix-button2-command 'gdbsrc-select-or-yank) -(strokes-fix-button2-command 'hypropos-mouse-get-doc) -(strokes-fix-button2-command 'gnus-mouse-pick-group) -(strokes-fix-button2-command 'gnus-mouse-pick-article) -(strokes-fix-button2-command 'gnus-article-push-button) -(strokes-fix-button2-command 'dired-mouse-find-file) -(strokes-fix-button2-command 'url-dired-find-file-mouse) -(strokes-fix-button2-command 'dired-u-r-mouse-toggle) -(strokes-fix-button2-command 'dired-u-w-mouse-toggle) -(strokes-fix-button2-command 'dired-u-x-mouse-toggle) -(strokes-fix-button2-command 'dired-g-r-mouse-toggle) -(strokes-fix-button2-command 'dired-g-w-mouse-toggle) -(strokes-fix-button2-command 'dired-g-x-mouse-toggle) -(strokes-fix-button2-command 'dired-o-r-mouse-toggle) -(strokes-fix-button2-command 'dired-o-w-mouse-toggle) -(strokes-fix-button2-command 'isearch-yank-x-selection) -(strokes-fix-button2-command 'occur-mode-mouse-goto) -(strokes-fix-button2-command 'cvs-mouse-find-file) +(defvar strokes-insinuated nil) + +(defun strokes-insinuate () + "Insinuate Emacs with strokes advices." + (unless strokes-insinuated + (strokes-fix-button2-command 'vm-mouse-button-2) + (strokes-fix-button2-command 'rmail-summary-mouse-goto-msg) + (strokes-fix-button2-command 'Buffer-menu-mouse-select) + (strokes-fix-button2-command 'w3-widget-button-click) + (strokes-fix-button2-command 'widget-image-button-press) + (strokes-fix-button2-command 'Info-follow-clicked-node) + (strokes-fix-button2-command 'compile-mouse-goto-error) + (strokes-fix-button2-command 'gdbsrc-select-or-yank) + (strokes-fix-button2-command 'hypropos-mouse-get-doc) + (strokes-fix-button2-command 'gnus-mouse-pick-group) + (strokes-fix-button2-command 'gnus-mouse-pick-article) + (strokes-fix-button2-command 'gnus-article-push-button) + (strokes-fix-button2-command 'dired-mouse-find-file) + (strokes-fix-button2-command 'url-dired-find-file-mouse) + (strokes-fix-button2-command 'dired-u-r-mouse-toggle) + (strokes-fix-button2-command 'dired-u-w-mouse-toggle) + (strokes-fix-button2-command 'dired-u-x-mouse-toggle) + (strokes-fix-button2-command 'dired-g-r-mouse-toggle) + (strokes-fix-button2-command 'dired-g-w-mouse-toggle) + (strokes-fix-button2-command 'dired-g-x-mouse-toggle) + (strokes-fix-button2-command 'dired-o-r-mouse-toggle) + (strokes-fix-button2-command 'dired-o-w-mouse-toggle) + (strokes-fix-button2-command 'isearch-yank-x-selection) + (strokes-fix-button2-command 'occur-mode-mouse-goto) + (strokes-fix-button2-command 'cvs-mouse-find-file)) + (setq strokes-insinuated t)) ;;; I can fix the customize widget button click, but then ;;; people will get confused when they try to customize @@ -1690,8 +1707,9 @@ (> (prefix-numeric-value arg) 0) (not strokes-mode)))) (cond ((not (device-on-window-system-p)) - (error "Can't use strokes without windows")) + (warn "Can't use strokes without windows")) (on-p ; turn on strokes + (strokes-insinuate) (and (file-exists-p strokes-file) (null strokes-global-map) (strokes-load-user-strokes)) @@ -1736,13 +1754,10 @@ ; but what can you do? ;;(unless (find-face 'strokes-char-face) -(copy-face 'default 'strokes-char-face) -(set-face-background 'strokes-char-face "lightgray") ; I should really - ; make this a - ; user-option, - ; but I'm too - ; lazy right now. - ; In a few days. + +(defface strokes-char-face '((t (:background "lightgray"))) + "Face for strokes characters." + :group 'strokes) (defconst strokes-char-table (make-char-table 'generic) ; "The table which stores values for the character keys.") @@ -2071,4 +2086,4 @@ (provide 'strokes) (run-hooks 'strokes-load-hook) -;;; strokes.el ends here \ No newline at end of file +;;; strokes.el ends here
--- a/lisp/modes/tcl.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/modes/tcl.el Mon Aug 13 09:57:07 2007 +0200 @@ -378,9 +378,10 @@ ;; (defgroup tcl nil - "Tcl programming language" + "Tcl programming language." :group 'languages) + (defcustom tcl-indent-level 4 "*Indentation of Tcl statements with respect to containing block." :type 'integer @@ -413,7 +414,7 @@ 6. Move backward to start of comment, indenting if necessary." :type '(choice (const :tag "on" t) (const :tag "off" nil) - (const :tag "The Works" other)) + (sexp :format "%t\n" :tag "The Works" other)) :group 'tcl) (defcustom tcl-use-hairy-comment-detector t
--- a/lisp/modes/texinfo.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/modes/texinfo.el Mon Aug 13 09:57:07 2007 +0200 @@ -27,8 +27,10 @@ ;;; Synched up with: FSF 19.30. (defgroup texinfo nil - "Texinfo Mode" - :group 'docs) + "Major mode for editing Texinfo files." + :group 'docs + :group 'tex + :group 'wp) ;;; Autoloads:
--- a/lisp/modes/vhdl-mode.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/modes/vhdl-mode.el Mon Aug 13 09:57:07 2007 +0200 @@ -7,8 +7,8 @@ ;; Author: Rodney J. Whitby <rwhitby@geocities.com> ;; Maintainer: Rodney J. Whitby <rwhitby@geocities.com> ;; Created: June 1994, adapted from cc-mode.el 4.29 by Barry A. Warsaw. -;; Version: $Revision: 1.6 $ -;; Last Modified: $Date: 1997/08/01 03:27:57 $ +;; Version: $Revision: 1.7 $ +;; Last Modified: $Date: 1997/09/17 05:19:27 $ ;; Keywords: languages VHDL ;; Archive: http://www.geocities.com/SiliconValley/Park/8287/ @@ -67,7 +67,7 @@ ;; LCD Archive Entry: ;; vhdl-mode.el|Rodney J. Whitby|rwhitby@geocities.com ;; |Major mode for editing VHDL code -;; |$Date: 1997/08/01 03:27:57 $|$Revision: 1.6 $ +;; |$Date: 1997/09/17 05:19:27 $|$Revision: 1.7 $ ;; |http://www.geocities.com/SiliconValley/Park/8287/ @@ -76,17 +76,33 @@ ;; user definable variables ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv -(defvar vhdl-inhibit-startup-warnings-p nil - "*If non-nil, inhibits start up compatibility warnings.") -(defvar vhdl-strict-syntax-p nil +(defgroup vhdl nil + "Major mode for editing VHDL code." + :group 'languages) + + +(defcustom vhdl-inhibit-startup-warnings-p nil + "*If non-nil, inhibits start up compatibility warnings." + :type 'boolean + :group 'vhdl) + +(defcustom vhdl-strict-syntax-p nil "*If non-nil, all syntactic symbols must be found in `vhdl-offsets-alist'. If the syntactic symbol for a particular line does not match a symbol in the offsets alist, an error is generated, otherwise no error is -reported and the syntactic symbol is ignored.") -(defvar vhdl-echo-syntactic-information-p nil - "*If non-nil, syntactic info is echoed when the line is indented.") -(defvar vhdl-basic-offset 2 - "*Amount of basic offset used by + and - symbols in `vhdl-offsets-alist'.") +reported and the syntactic symbol is ignored." + :type 'boolean + :group 'vhdl) + +(defcustom vhdl-echo-syntactic-information-p nil + "*If non-nil, syntactic info is echoed when the line is indented." + :type 'boolean + :group 'vhdl) + +(defcustom vhdl-basic-offset 2 + "*Amount of basic offset used by + and - symbols in `vhdl-offsets-alist'." + :type 'integer + :group 'vhdl) (defconst vhdl-offsets-alist-default '((string . -1000) @@ -112,7 +128,7 @@ Do not change this constant! See the variable `vhdl-offsets-alist' for more information.") -(defvar vhdl-offsets-alist (copy-alist vhdl-offsets-alist-default) +(defcustom vhdl-offsets-alist (copy-alist vhdl-offsets-alist-default) "*Association list of syntactic element symbols and indentation offsets. As described below, each cons cell in this list has the form: @@ -172,9 +188,11 @@ package -- inside a package declaration architecture -- inside an architecture body package-body -- inside a package body -") +" + :type 'sexp + :group 'vhdl) -(defvar vhdl-tab-always-indent t +(defcustom vhdl-tab-always-indent t "*Controls the operation of the TAB key. If t, hitting TAB always just indents the current line. If nil, hitting TAB indents the current line if point is at the left margin or @@ -184,9 +202,14 @@ directives, but line is always reindented. Note that indentation of lines containing only comments is also -controlled by the `vhdl-comment-only-line-offset' variable.") +controlled by the `vhdl-comment-only-line-offset' variable." + :type '(radio (const :tag "Always indent" t) + (const :tag "Indent if point in indentation" nil) + (sexp :format "%t\n" + :tag "Insert if point within literals" other)) + :group 'vhdl) -(defvar vhdl-comment-only-line-offset 0 +(defcustom vhdl-comment-only-line-offset 0 "*Extra offset for line which contains only the start of a comment. Can contain an integer or a cons cell of the form: @@ -195,11 +218,18 @@ Where NON-ANCHORED-OFFSET is the amount of offset given to non-column-zero anchored comment-only lines, and ANCHORED-OFFSET is the amount of offset to give column-zero anchored comment-only lines. -Just an integer as value is equivalent to (<val> . 0)") +Just an integer as value is equivalent to (<val> . 0)" + :type '(choice integer + (cons :value (0 . 0) + (integer :tag "Non-anchored offset") + (integer :tag "Anchored offset"))) + :group 'vhdl) -(defvar vhdl-special-indent-hook nil +(defcustom vhdl-special-indent-hook nil "*Hook for user defined special indentation adjustments. -This hook gets called after a line is indented by the mode.") +This hook gets called after a line is indented by the mode." + :type 'hook + :group 'vhdl) (defvar vhdl-style-alist '(("IEEE" @@ -283,7 +313,7 @@ (cond ((= major 18) (setq major 'v18)) ;Emacs 18 ((= major 4) (setq major 'v18)) ;Epoch 4 - ((>= major 19) (setq major 'v19 ;Emacs 19 or later + ((= major 19) (setq major 'v19 ;Emacs 19 flavor (cond ((string-match "Win-Emacs" emacs-version) 'Win-Emacs) @@ -292,6 +322,10 @@ 'XEmacs) (t 'FSF)))) + ((>= major 20) (setq major 'v20 ;Emacs 20 or later + flavor (if (string-match "XEmacs" emacs-version) + 'XEmacs + 'FSF))) ;; I don't know (t (error "Cannot recognize major version number: %s" major))) ;; lets do some minimal sanity checking. @@ -537,7 +571,7 @@ ;;;###autoload (defun vhdl-mode () "Major mode for editing VHDL code. -vhdl-mode $Revision: 1.6 $ +vhdl-mode $Revision: 1.7 $ 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 @@ -744,7 +778,8 @@ (let* ((syntax (vhdl-get-syntactic-context)) (len (length syntax)) (ic (format "%s" (car (nth (1- len) syntax))))) - (if (memq 'v19 vhdl-emacs-features) + (if (or (memq 'v19 vhdl-emacs-features) + (memq 'v20 vhdl-emacs-features)) (cons ic 0) ic)) ))) @@ -2562,6 +2597,9 @@ ;; Support for Barry Warsaw's elp (emacs lisp profiler) package: +(eval-when-compile + (require 'elp)) + (setq elp-all-instrumented-list nil) (setq elp-function-list '( @@ -2613,7 +2651,7 @@ ;; Defuns for submitting bug reports: -(defconst vhdl-version "$Revision: 1.6 $" +(defconst vhdl-version "$Revision: 1.7 $" "vhdl-mode version number.") (defconst vhdl-mode-help-address "rwhitby@geocities.com" "Address accepting submission of bug reports.")
--- a/lisp/modes/vrml-mode.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/modes/vrml-mode.el Mon Aug 13 09:57:07 2007 +0200 @@ -45,7 +45,7 @@ ;; (defgroup vrml nil - "VRML Language." + "Major mode for editing VRML (.wrl) files." :group 'languages) @@ -76,7 +76,7 @@ 6. Move backward to start of comment, indenting if necessary." :type '(choice (const :tag "on" t) (const :tag "off" nil) - (const :tag "The Works" other)) + (sexp :format "%t\n" :tag "The Works" other)) :group 'vrml) (defcustom vrml-use-hairy-comment-detector t
--- a/lisp/modes/whitespace-mode.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/modes/whitespace-mode.el Mon Aug 13 09:57:07 2007 +0200 @@ -26,7 +26,7 @@ ;;; Commentary: -;; $Id: whitespace-mode.el,v 1.4 1997/07/26 22:09:50 steve Exp $ +;; $Id: whitespace-mode.el,v 1.5 1997/09/17 05:19:29 steve Exp $ ;; Description: ;; ;; This is a minor mode, which highlights whitespaces (blanks and @@ -93,6 +93,17 @@ :group 'matching) +(defcustom whitespace-mode nil + "Non-nil, if the `whitespace-mode' is active." + :type 'boolean + :set (lambda (symbol value) + (whitespace-mode (or value 0))) + :require 'whitespace-mode + :initialize 'custom-initialize-default + :group 'whitespace) + +(make-variable-buffer-local 'whitespace-mode) + (defcustom whitespace-chars 'tabs-and-blanks "*Determines, which whitespaces are highlighted. Valid values are: @@ -363,11 +374,6 @@ (whitespace-dehighlight-region beg end) (whitespace-highlight-region beg end))) -(defvar whitespace-mode nil - "Non-nil, if the `whitespace-mode' is active.") - -(make-variable-buffer-local 'whitespace-mode) - (defun whitespace-mode (&optional arg) "Toggle whitespace mode. With arg, turn whitespace mode on iff arg is positive.
--- a/lisp/modes/xrdb-mode.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/modes/xrdb-mode.el Mon Aug 13 09:57:07 2007 +0200 @@ -69,6 +69,7 @@ ;; These variables are available for your customization (defgroup xrdb nil "Mode for editing X resource database files." + :group 'data :group 'languages) (defcustom xrdb-mode-hook nil
--- a/lisp/mule/auto-autoloads.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/mule/auto-autoloads.el Mon Aug 13 09:57:07 2007 +0200 @@ -95,30 +95,7 @@ ;;;*** -;;;### (autoloads (decompose-composite-char compose-chars decompose-region compose-region set-coding-system-alist lookup-nested-alist set-nested-alist nested-alist-p truncate-string-to-width store-substring string-to-vector string-to-list string-to-sequence) "mule-util" "mule/mule-util.el") - -(autoload 'string-to-sequence "mule-util" "\ -Convert STRING to a sequence of TYPE which contains characters in STRING. -TYPE should be `list' or `vector'. -Multibyte characters are concerned." nil nil) - -(autoload 'string-to-list "mule-util" "\ -Return a list of characters in STRING." nil nil) - -(autoload 'string-to-vector "mule-util" "\ -Return a vector of characters in STRING." nil nil) - -(autoload 'store-substring "mule-util" "\ -Embed OBJ (string or character) at index IDX of STRING." nil nil) - -(autoload 'truncate-string-to-width "mule-util" "\ -Truncate string STR to fit in WIDTH columns. -Optional 1st arg START-COLUMN if non-nil specifies the starting column. -Optional 2nd arg PADDING if non-nil is a padding character to be padded at -the head and tail of the resulting string to fit in WIDTH if necessary. -If PADDING is nil, the resulting string may be narrower than WIDTH." nil nil) - -(defalias 'truncate-string 'truncate-string-to-width) +;;;### (autoloads (decompose-composite-char compose-chars decompose-region compose-region set-coding-system-alist lookup-nested-alist set-nested-alist nested-alist-p) "mule-util" "mule/mule-util.el") (autoload 'nested-alist-p "mule-util" "\ Return t if OBJ is a nesetd alist.
--- a/lisp/oobr/auto-autoloads.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/oobr/auto-autoloads.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,5 +1,5 @@ ;;; DO NOT MODIFY THIS FILE -(if (featurep 'oobr-autoloads) (error "Already loaded")) +(if (featurep '-autoloads) (error "Already loaded")) ;;;### (autoloads (br-env-load br-env-browse) "br-env" "oobr/br-env.el") @@ -130,4 +130,4 @@ ;;;*** -(provide 'oobr-autoloads) +(provide '-autoloads)
--- a/lisp/packages/auto-autoloads.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/packages/auto-autoloads.el Mon Aug 13 09:57:07 2007 +0200 @@ -113,11 +113,7 @@ ;;;### (autoloads (mouse-avoidance-mode) "avoid" "packages/avoid.el") -(defvar mouse-avoidance-mode nil "\ -Value is t or a symbol if the mouse pointer should avoid the cursor. -See function `mouse-avoidance-mode' for possible values. Changing this -variable is NOT the recommended way to change modes; use that function -instead.") +(defcustom mouse-avoidance-mode nil "Value is t or a symbol if the mouse pointer should avoid the cursor.\nSee function `mouse-avoidance-mode' for possible values. Changing this\nvariable is NOT the recommended way to change modes; use that function \ninstead." :type '(radio (const :tag "No mouse avoidance" nil) (const :tag "Move the mouse on keypress" banish) (const :tag "Move the mouse if the cursor gets too close" exile) (const :tag "Displace the mouse if the cursor gets too close" jump) (const :tag "Animate the mouse" animate) (const :tag "Animate + change shape" proteus)) :set (lambda (symbol value) (mouse-avoidance-mode (or value 'none))) :initialize 'custom-initialize-default :require 'avoid :group 'avoid) (autoload 'mouse-avoidance-mode "avoid" "\ Set cursor avoidance mode to MODE. @@ -1759,7 +1755,7 @@ ;;;### (autoloads (blink-paren paren-set-mode) "paren" "packages/paren.el") -(defcustom paren-mode nil "*Sets the style of parenthesis highlighting.\nValid values are nil, `blink-paren', `paren', and `sexp'.\n nil no parenthesis highlighting.\n blink-paren causes the matching paren to blink.\n paren causes the matching paren to be highlighted but not to blink.\n sexp whole expression enclosed by the local paren at its mate.\n nested (not yet implemented) use variable shading to see the\n nesting of an expression. Also groks regular expressions\n and shell quoting.\n\nThis variable is global by default, but you can make it buffer-local and\nhighlight parentheses differently in different major modes." :type '(radio (const nil) (const blink-paren) (const paren) (const sexp) (const nested)) :group 'paren-matching) +(defcustom paren-mode nil "*Sets the style of parenthesis highlighting.\nValid values are nil, `blink-paren', `paren', and `sexp'.\n nil no parenthesis highlighting.\n blink-paren causes the matching paren to blink.\n paren causes the matching paren to be highlighted but not to blink.\n sexp whole expression enclosed by the local paren at its mate.\n nested (not yet implemented) use variable shading to see the\n nesting of an expression. Also groks regular expressions\n and shell quoting.\n\nThis variable is global by default, but you can make it buffer-local and\nhighlight parentheses differently in different major modes." :type '(radio (const :tag "None (default)" nil) (const :tag "Blinking Paren" blink-paren) (const :tag "Highlighted Paren" paren) (const :tag "Highlighted Expression" sexp)) :set (lambda (symbol value) (paren-set-mode value)) :initialize 'custom-initialize-default :require 'paren :group 'paren-matching) (autoload 'paren-set-mode "paren" "\ Cycles through possible values for `paren-mode', force off with negative arg. @@ -2218,7 +2214,9 @@ merge in the changes into your working copy." t nil) (autoload 'vc-register "vc" "\ -Register the current file into your version-control system." t nil) +Register the current file into your version-control system. +The default initial version number, taken to be `vc-default-init-version', +can be overridden by giving a prefix arg." t nil) (autoload 'vc-checkout "vc" "\ Retrieve a copy of the latest version of the given file." nil nil)
--- a/lisp/packages/autoinsert.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/packages/autoinsert.el Mon Aug 13 09:57:07 2007 +0200 @@ -45,7 +45,12 @@ ;;; Code: -(defvar auto-insert 'not-modified +(defgroup auto-insert nil + "Automatic mode-dependent insertion of text into new files." + :group 'tools) + + +(defcustom auto-insert 'not-modified "*Controls automatic insertion into newly found empty files: nil do nothing t insert if possible @@ -55,17 +60,30 @@ save it with \\[write-file] RET. This variable is used when `auto-insert' is called as a function, e.g. when you do (add-hook 'find-file-hooks 'auto-insert). -With \\[auto-insert], this is always treated as if it were `t'.") +With \\[auto-insert], this is always treated as if it were `t'." + :type '(radio (const :tag "Do nothing" nil) + (const :tag "Insert if possible" t) + (sexp :format "%t\n" + :tag "Insert if possible, but mark as unmodified" + other)) + :require 'autoinsert + :group 'auto-insert) -(defvar auto-insert-query 'function +(defcustom auto-insert-query 'function "*If non-`nil', ask user before auto-inserting. -When this is `function', only ask when called non-interactively.") +When this is `function', only ask when called non-interactively." + :type '(choice (const :tag "Don't ask" nil) + (const :tag "Ask when non-interactive" function) + (sexp :format "%t\n" :tag "Ask" other)) + :group 'auto-insert) -(defvar auto-insert-prompt "Perform %s auto-insertion? " +(defcustom auto-insert-prompt "Perform %s auto-insertion? " "*Prompt to use when querying whether to auto-insert. -If this contains a %s, that will be replaced by the matching rule.") +If this contains a %s, that will be replaced by the matching rule." + :type 'string + :group 'auto-insert) (defvar auto-insert-alist
--- a/lisp/packages/avoid.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/packages/avoid.el Mon Aug 13 09:57:07 2007 +0200 @@ -79,11 +79,23 @@ ;;;###autoload -(defvar mouse-avoidance-mode nil +(defcustom mouse-avoidance-mode nil "Value is t or a symbol if the mouse pointer should avoid the cursor. See function `mouse-avoidance-mode' for possible values. Changing this variable is NOT the recommended way to change modes; use that function -instead.") +instead." + :type '(radio + (const :tag "No mouse avoidance" nil) + (const :tag "Move the mouse on keypress" banish) + (const :tag "Move the mouse if the cursor gets too close" exile) + (const :tag "Displace the mouse if the cursor gets too close" jump) + (const :tag "Animate the mouse" animate) + (const :tag "Animate + change shape" proteus)) + :set (lambda (symbol value) + (mouse-avoidance-mode (or value 'none))) + :initialize 'custom-initialize-default + :require 'avoid + :group 'avoid) (defcustom mouse-avoidance-nudge-dist 15 "*Average distance that mouse will be moved when approached by cursor.
--- a/lisp/packages/balloon-help.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/packages/balloon-help.el Mon Aug 13 09:57:07 2007 +0200 @@ -60,8 +60,14 @@ (defvar balloon-help-version "1.06" "Version string for Balloon Help.") -(defvar balloon-help-mode nil - "*Non-nil means Balloon help mode is enabled.") +(defcustom balloon-help-mode nil + "*Non-nil means Balloon help mode is enabled." + :type 'boolean + :set (lambda (symbol value) + (balloon-help-mode (or value 0))) + :initialize 'custom-initialize-default + :require 'balloon-help + :group 'balloon-help) (defcustom balloon-help-timeout 1500 "*Display help after this many milliseconds of mouse inactivity."
--- a/lisp/packages/bookmark.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/packages/bookmark.el Mon Aug 13 09:57:07 2007 +0200 @@ -99,12 +99,20 @@ ;;; User Variables -(defvar bookmark-use-annotations nil - "*If non-nil, saving a bookmark will query for an annotation in a -buffer.") +(defgroup bookmarks nil + "Set bookmarks, maybe annotate them, jump to them later." + :prefix "bookmark-" + :group 'editing) -(defvar bookmark-save-flag t +(defcustom bookmark-use-annotations nil + "*If non-nil, saving a bookmark will query for an annotation in a +buffer." + :type 'boolean + :group 'bookmarks) + + +(defcustom bookmark-save-flag t "*Controls when Emacs saves bookmarks to a file. --> Nil means never save bookmarks, except when `bookmark-save' is explicitly called \(\\[bookmark-save]\). @@ -120,7 +128,11 @@ behavior.\) To specify the file in which to save them, modify the variable -bookmark-default-file, which is `~/.emacs.bmk' by default.") +bookmark-default-file, which is `~/.emacs.bmk' by default." + :type '(choice (const :tag "Never" nil) + (const :tag "On Exit" t) + (number :tag "Frequency" 1)) + :group 'bookmarks) (defconst bookmark-old-default-file "~/.emacs-bkmrks" @@ -139,43 +151,57 @@ "*File in which to save bookmarks by default.") -(defvar bookmark-version-control 'nospecial +(defcustom bookmark-version-control 'nospecial "*Whether or not to make numbered backups of the bookmark file. It can have four values: t, nil, `never', and `nospecial'. The first three have the same meaning that they do for the variable `version-control', and the final value `nospecial' means just -use the value of `version-control'.") +use the value of `version-control'." + :type '(choice (const t) (const nil) (const never) (const nospecial)) + :group 'bookmarks) -(defvar bookmark-completion-ignore-case t - "*Non-nil means bookmark functions ignore case in completion.") +(defcustom bookmark-completion-ignore-case t + "*Non-nil means bookmark functions ignore case in completion." + :type 'boolean + :group 'bookmarks) -(defvar bookmark-sort-flag t +(defcustom bookmark-sort-flag t "*Non-nil means that bookmarks will be displayed sorted by bookmark name. Otherwise they will be displayed in LIFO order (that is, most -recently set ones come first, oldest ones come last).") - - -(defvar bookmark-automatically-show-annotations t - "*Nil means don't show annotations when jumping to a bookmark.") +recently set ones come first, oldest ones come last)." + :type 'boolean + :group 'bookmarks) -(defvar bookmark-bmenu-file-column 30 - "*Column at which to display filenames in a buffer listing bookmarks. -You can toggle whether files are shown with \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-toggle-filenames].") +(defcustom bookmark-automatically-show-annotations t + "*Nil means don't show annotations when jumping to a bookmark." + :type 'boolean + :group 'bookmarks) -(defvar bookmark-bmenu-toggle-filenames t +(defcustom bookmark-bmenu-file-column 30 + "*Column at which to display filenames in a buffer listing bookmarks. +You can toggle whether files are shown with \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-toggle-filenames]." + :type 'integer + :group 'bookmarks) + + +(defcustom bookmark-bmenu-toggle-filenames t "*Non-nil means show filenames when listing bookmarks. This may result in truncated bookmark names. To disable this, put the following in your .emacs: -\(setq bookmark-bmenu-toggle-filenames nil\)") +\(setq bookmark-bmenu-toggle-filenames nil\)" + :type 'boolean + :group 'bookmarks) -(defvar bookmark-menu-length 70 - "*Maximum length of a bookmark name displayed on a popup menu.") +(defcustom bookmark-menu-length 70 + "*Maximum length of a bookmark name displayed on a popup menu." + :type 'integer + :group 'bookmarks) ;;; No user-serviceable parts beyond this point.
--- a/lisp/packages/compile.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/packages/compile.el Mon Aug 13 09:57:07 2007 +0200 @@ -34,8 +34,10 @@ ;;; Code: (defgroup compilation nil - "Compilation buffer processing" - :group 'programming) + "Run compiler as inferior of Emacs, parse error messages." + :group 'programming + :group 'tools + :group 'processes) ;;;###autoload @@ -147,7 +149,13 @@ ultrix: the operating system See also the variable `compilation-error-regexp-alist-alist'." - :type '(choice (const all) (repeat symbol)) + :type '(choice (const all) + (set :menu-tag "Pick" + (const gnu) (const lcc) (const ada) + (const of) (const comma) (const 4bsd) + (const msft) (const borland) (const mips) + (const sgi) (const cray) (const ibm) + (const aix) (const ultrix))) :group 'compilation) (defun compilation-build-compilation-error-regexp-alist ()
--- a/lisp/packages/custom-load.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/packages/custom-load.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,46 +1,89 @@ +(custom-put 'extensions 'custom-loads '("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")) -(custom-put 'time-stamp 'custom-loads '("time-stamp")) -(custom-put 'texinfo-tex 'custom-loads '("texnfo-tex")) -(custom-put 'supercite-hooks 'custom-loads '("supercite")) -(custom-put 'supercite-cite 'custom-loads '("supercite")) -(custom-put 'supercite-attr 'custom-loads '("supercite")) -(custom-put 'supercite-frames 'custom-loads '("supercite")) -(custom-put 'supercite 'custom-loads '("supercite")) -(custom-put 'save-place 'custom-loads '("saveplace")) (custom-put 'recent-files-menu 'custom-loads '("recent-files")) +(custom-put 'mouse 'custom-loads '("avoid")) +(custom-put 'tex 'custom-loads '("texnfo-tex")) +(custom-put 'tar 'custom-loads '("tar-mode")) +(custom-put 'etags 'custom-loads '("etags")) +(custom-put 'igrep 'custom-loads '("igrep")) +(custom-put 'menu 'custom-loads '("recent-files")) +(custom-put 'minibuffer 'custom-loads '("icomplete")) +(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")) +(custom-put 'ispell 'custom-loads '("ispell")) +(custom-put 'mail 'custom-loads '("feedmail" "metamail" "supercite")) +(custom-put 'ps-print-face 'custom-loads '("ps-print")) +(custom-put 'crypt 'custom-loads '("crypt")) +(custom-put 'object 'custom-loads '("gopher")) +(custom-put 'man 'custom-loads '("man")) +(custom-put 'lpr 'custom-loads '("lpr")) +(custom-put 'ps-print-header 'custom-loads '("ps-print")) +(custom-put 'docs 'custom-loads '("hyper-apropos" "info" "makeinfo")) +(custom-put 'completion 'custom-loads '("completion")) +(custom-put 'tools 'custom-loads '("add-log" "autoinsert" "compile" "diff" "etags" "func-menu" "generic-sc" "hyper-apropos" "rcompile")) (custom-put 'recent-files 'custom-loads '("recent-files")) -(custom-put 'remote-compile 'custom-loads '("rcompile")) -(custom-put 'ps-print-face 'custom-loads '("ps-print")) -(custom-put 'ps-print-color 'custom-loads '("ps-print")) +(custom-put 'display-time-balloon 'custom-loads '("time")) +(custom-put 'dabbrev 'custom-loads '("dabbrev")) +(custom-put 'display-time 'custom-loads '("time")) +(custom-put 'hypermedia 'custom-loads '("gopher" "metamail")) +(custom-put 'save-place 'custom-loads '("saveplace")) +(custom-put 'lisp 'custom-loads '("func-menu" "hyper-apropos")) +(custom-put 'jka-compr 'custom-loads '("jka-compr")) +(custom-put 'diff 'custom-loads '("diff")) +(custom-put 'supercite-cite 'custom-loads '("supercite")) +(custom-put 'applications 'custom-loads '("time")) +(custom-put 'paren-matching 'custom-loads '("paren")) +(custom-put 'time-stamp 'custom-loads '("time-stamp")) +(custom-put 'avoid 'custom-loads '("avoid")) +(custom-put 'help 'custom-loads '("hyper-apropos" "info" "man")) +(custom-put 'supercite 'custom-loads '("supercite")) +(custom-put 'generic-sc 'custom-loads '("generic-sc")) +(custom-put 'local 'custom-loads '("gopher")) +(custom-put 'keyboard 'custom-loads '("pending-del")) +(custom-put 'data 'custom-loads '("auto-save" "jka-compr" "saveplace" "tar-mode" "time-stamp")) +(custom-put 'ps-print 'custom-loads '("ps-print")) +(custom-put 'compression 'custom-loads '("jka-compr")) +(custom-put 'comm 'custom-loads '("gopher")) (custom-put 'ps-print-font 'custom-loads '("ps-print")) -(custom-put 'ps-print-header 'custom-loads '("ps-print")) -(custom-put 'ps-print-vertical 'custom-loads '("ps-print")) -(custom-put 'ps-print-horizontal 'custom-loads '("ps-print")) -(custom-put 'ps-print 'custom-loads '("ps-print")) -(custom-put 'pages 'custom-loads '("page-ext")) +(custom-put 'frames 'custom-loads '("balloon-help" "desktop")) +(custom-put 'supercite-attr 'custom-loads '("supercite")) +(custom-put 'bookmarks 'custom-loads '("bookmark")) +(custom-put 'desktop 'custom-loads '("desktop")) +(custom-put 'abbrev 'custom-loads '("dabbrev")) +(custom-put 'remote-compile 'custom-loads '("rcompile")) +(custom-put 'programming 'custom-loads '("compile")) (custom-put 'metamail 'custom-loads '("metamail")) -(custom-put 'man 'custom-loads '("man")) +(custom-put 'icomplete 'custom-loads '("icomplete")) +(custom-put 'compilation 'custom-loads '("compile")) (custom-put 'makeinfo 'custom-loads '("makeinfo")) -(custom-put 'lpr 'custom-loads '("lpr")) -(custom-put 'ispell 'custom-loads '("ispell")) -(custom-put 'info 'custom-loads '("info")) -(custom-put 'hyper-apropos-faces 'custom-loads '("hyper-apropos")) -(custom-put 'hyper-apropos 'custom-loads '("hyper-apropos")) -(custom-put 'gopher 'custom-loads '("gopher")) -(custom-put 'gnuserv 'custom-loads '("gnuserv")) -(custom-put 'generic-sc 'custom-loads '("generic-sc")) (custom-put 'fume 'custom-loads '("func-menu")) -(custom-put 'filladapt 'custom-loads '("filladapt")) -(custom-put 'feedmail 'custom-loads '("feedmail")) +(custom-put 'auto-insert 'custom-loads '("autoinsert")) +(custom-put 'files 'custom-loads '("recent-files")) (custom-put 'fast-lock 'custom-loads '("fast-lock")) -(custom-put 'etags 'custom-loads '("etags")) -(custom-put 'diff 'custom-loads '("diff")) -(custom-put 'desktop 'custom-loads '("desktop")) -(custom-put 'dabbrev 'custom-loads '("dabbrev")) -(custom-put 'completion 'custom-loads '("completion")) -(custom-put 'compilation 'custom-loads '("compile")) +(custom-put 'gnuserv 'custom-loads '("gnuserv")) +(custom-put 'ps-print-horizontal 'custom-loads '("ps-print")) +(custom-put 'maint 'custom-loads '("add-log" "upd-copyr")) +(custom-put 'fill 'custom-loads '("filladapt")) (custom-put 'balloon-help 'custom-loads '("balloon-help")) -(custom-put 'avoid 'custom-loads '("avoid")) -(custom-put 'auto-save 'custom-loads '("auto-save")) -(custom-put 'change-log 'custom-loads '("add-log")) -(custom-put 'igrep 'custom-loads '("igrep")) +(custom-put 'supercite-hooks 'custom-loads '("supercite")) +(custom-put 'texinfo-tex 'custom-loads '("texnfo-tex")) +(custom-put 'faces 'custom-loads '("fast-lock" "hyper-apropos" "ps-print")) +(custom-put 'pages 'custom-loads '("page-ext")) +(custom-put 'supercite-frames 'custom-loads '("supercite")) +(custom-put 'feedmail 'custom-loads '("feedmail")) +(custom-put 'processes 'custom-loads '("compile" "gnuserv" "igrep" "ispell" "metamail" "rcompile")) +(custom-put 'news 'custom-loads '("supercite")) +(custom-put 'hyper-apropos 'custom-loads '("hyper-apropos")) +(custom-put 'wp 'custom-loads '("lpr" "ps-print")) +(custom-put 'ps-print-vertical 'custom-loads '("ps-print")) +(custom-put 'gopher 'custom-loads '("gopher")) +(custom-put 'editing 'custom-loads '("bookmark")) +(custom-put 'matching 'custom-loads '("paren" "completion" "hyper-apropos")) +(custom-put 'ps-print-color 'custom-loads '("ps-print")) +(custom-put 'info 'custom-loads '("info")) +(custom-put 'unix 'custom-loads '("tar-mode")) +(custom-put 'c 'custom-loads '("func-menu"))
--- a/lisp/packages/emerge.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/packages/emerge.el Mon Aug 13 09:57:07 2007 +0200 @@ -28,16 +28,6 @@ ;;; Code -(defmacro emerge-eval-in-buffer (buffer &rest forms) - "Macro to switch to BUFFER, evaluate FORMS, returns to original buffer. -Differs from `save-excursion' in that it doesn't save the point and mark." - (` (let ((StartBuffer (current-buffer))) - (unwind-protect - (progn - (set-buffer (, buffer)) - (,@ forms)) - (set-buffer StartBuffer))))) - (defconst emerge-xemacs-p (not (not (string-match "XEmacs" emacs-version))) "Non-nil if this is XEmacs. Don't alter manually, because it also turns on work-arounds for bugs.") @@ -596,32 +586,31 @@ (if output-file (setq emerge-last-dir-output (file-name-directory output-file))) ;; Make sure the entire files are seen, and they reflect what is on disk - (emerge-eval-in-buffer - buffer-A - (widen) - (if (emerge-remote-file-p) - (progn - ;; Store in a local file - (setq file-A (emerge-make-temp-file "A")) - (write-region (point-min) (point-max) file-A nil 'no-message) - (setq startup-hooks - (cons (` (lambda () (delete-file (, file-A)))) - startup-hooks))) - ;; Verify that the file matches the buffer - (emerge-verify-file-buffer))) - (emerge-eval-in-buffer - buffer-B - (widen) - (if (emerge-remote-file-p) - (progn - ;; Store in a local file - (setq file-B (emerge-make-temp-file "B")) - (write-region (point-min) (point-max) file-B nil 'no-message) - (setq startup-hooks - (cons (` (lambda () (delete-file (, file-B)))) - startup-hooks))) - ;; Verify that the file matches the buffer - (emerge-verify-file-buffer))) + (with-current-buffer buffer-A + (widen) + (if (emerge-remote-file-p) + (progn + ;; Store in a local file + (setq file-A (emerge-make-temp-file "A")) + (write-region (point-min) (point-max) file-A nil 'no-message) + (setq startup-hooks + (cons (` (lambda () (delete-file (, file-A)))) + startup-hooks))) + ;; Verify that the file matches the buffer + (emerge-verify-file-buffer))) + (with-current-buffer + buffer-B + (widen) + (if (emerge-remote-file-p) + (progn + ;; Store in a local file + (setq file-B (emerge-make-temp-file "B")) + (write-region (point-min) (point-max) file-B nil 'no-message) + (setq startup-hooks + (cons (` (lambda () (delete-file (, file-B)))) + startup-hooks))) + ;; Verify that the file matches the buffer + (emerge-verify-file-buffer))) (emerge-setup buffer-A file-A buffer-B file-B startup-hooks quit-hooks output-file))) @@ -634,48 +623,48 @@ (let* ((merge-buffer-name (emerge-unique-buffer-name "*merge" "*")) ;; create the merge buffer from buffer A, so it inherits buffer A's ;; default directory, etc. - (merge-buffer (emerge-eval-in-buffer - buffer-A - (get-buffer-create merge-buffer-name)))) - (emerge-eval-in-buffer - merge-buffer - (emerge-copy-modes buffer-A) - (setq buffer-read-only nil) - (auto-save-mode 1) - (setq emerge-mode t) - (setq emerge-A-buffer buffer-A) - (setq emerge-B-buffer buffer-B) - (setq emerge-ancestor-buffer nil) - (setq emerge-merge-buffer merge-buffer) - (setq emerge-output-description - (if output-file - (concat "Output to file: " output-file) - (concat "Output to buffer: " (buffer-name merge-buffer)))) - (insert-buffer emerge-A-buffer) - (emerge-set-keys) - (setq emerge-difference-list (emerge-make-diff-list file-A file-B)) - (setq emerge-number-of-differences (length emerge-difference-list)) - (setq emerge-current-difference -1) - (setq emerge-quit-hook quit-hooks) - (emerge-remember-buffer-characteristics) - (emerge-handle-local-variables)) + (merge-buffer (with-current-buffer + buffer-A + (get-buffer-create merge-buffer-name)))) + (with-current-buffer + merge-buffer + (emerge-copy-modes buffer-A) + (setq buffer-read-only nil) + (auto-save-mode 1) + (setq emerge-mode t) + (setq emerge-A-buffer buffer-A) + (setq emerge-B-buffer buffer-B) + (setq emerge-ancestor-buffer nil) + (setq emerge-merge-buffer merge-buffer) + (setq emerge-output-description + (if output-file + (concat "Output to file: " output-file) + (concat "Output to buffer: " (buffer-name merge-buffer)))) + (insert-buffer emerge-A-buffer) + (emerge-set-keys) + (setq emerge-difference-list (emerge-make-diff-list file-A file-B)) + (setq emerge-number-of-differences (length emerge-difference-list)) + (setq emerge-current-difference -1) + (setq emerge-quit-hook quit-hooks) + (emerge-remember-buffer-characteristics) + (emerge-handle-local-variables)) (emerge-setup-windows buffer-A buffer-B merge-buffer t) - (emerge-eval-in-buffer merge-buffer - (run-hooks 'startup-hooks 'emerge-startup-hook) - (setq buffer-read-only t)))) + (with-current-buffer merge-buffer + (run-hooks 'startup-hooks 'emerge-startup-hook) + (setq buffer-read-only t)))) ;; Generate the Emerge difference list between two files (defun emerge-make-diff-list (file-A file-B) (let ((diff-buffer (get-buffer-create "*emerge-diff*"))) - (emerge-eval-in-buffer - diff-buffer - (erase-buffer) - (shell-command - (format "%s %s %s %s" - emerge-diff-program emerge-diff-options - (emerge-protect-metachars file-A) - (emerge-protect-metachars file-B)) - t)) + (with-current-buffer + diff-buffer + (erase-buffer) + (shell-command + (format "%s %s %s %s" + emerge-diff-program emerge-diff-options + (emerge-protect-metachars file-A) + (emerge-protect-metachars file-B)) + t)) (emerge-prepare-error-list emerge-diff-ok-lines-regexp diff-buffer) (emerge-convert-diffs-to-markers emerge-A-buffer emerge-B-buffer emerge-merge-buffer @@ -683,55 +672,55 @@ (defun emerge-extract-diffs (diff-buffer) (let (list) - (emerge-eval-in-buffer - diff-buffer - (goto-char (point-min)) - (while (re-search-forward emerge-match-diff-line nil t) - (let* ((a-begin (string-to-int (buffer-substring (match-beginning 1) - (match-end 1)))) - (a-end (let ((b (match-beginning 3)) - (e (match-end 3))) + (with-current-buffer + diff-buffer + (goto-char (point-min)) + (while (re-search-forward emerge-match-diff-line nil t) + (let* ((a-begin (string-to-int (buffer-substring (match-beginning 1) + (match-end 1)))) + (a-end (let ((b (match-beginning 3)) + (e (match-end 3))) + (if b + (string-to-int (buffer-substring b e)) + a-begin))) + (diff-type (buffer-substring (match-beginning 4) (match-end 4))) + (b-begin (string-to-int (buffer-substring (match-beginning 5) + (match-end 5)))) + (b-end (let ((b (match-beginning 7)) + (e (match-end 7))) (if b (string-to-int (buffer-substring b e)) - a-begin))) - (diff-type (buffer-substring (match-beginning 4) (match-end 4))) - (b-begin (string-to-int (buffer-substring (match-beginning 5) - (match-end 5)))) - (b-end (let ((b (match-beginning 7)) - (e (match-end 7))) - (if b - (string-to-int (buffer-substring b e)) - b-begin)))) - ;; fix the beginning and end numbers, because diff is somewhat - ;; strange about how it numbers lines - (if (string-equal diff-type "a") - (progn - (setq b-end (1+ b-end)) - (setq a-begin (1+ a-begin)) - (setq a-end a-begin)) - (if (string-equal diff-type "d") - (progn - (setq a-end (1+ a-end)) - (setq b-begin (1+ b-begin)) - (setq b-end b-begin)) - ;; (string-equal diff-type "c") - (progn - (setq a-end (1+ a-end)) - (setq b-end (1+ b-end))))) - (setq list (cons (vector a-begin a-end - b-begin b-end - 'default-A) - list))))) + b-begin)))) + ;; fix the beginning and end numbers, because diff is somewhat + ;; strange about how it numbers lines + (if (string-equal diff-type "a") + (progn + (setq b-end (1+ b-end)) + (setq a-begin (1+ a-begin)) + (setq a-end a-begin)) + (if (string-equal diff-type "d") + (progn + (setq a-end (1+ a-end)) + (setq b-begin (1+ b-begin)) + (setq b-end b-begin)) + ;; (string-equal diff-type "c") + (progn + (setq a-end (1+ a-end)) + (setq b-end (1+ b-end))))) + (setq list (cons (vector a-begin a-end + b-begin b-end + 'default-A) + list))))) (nreverse list))) ;; Set up buffer of diff/diff3 error messages. (defun emerge-prepare-error-list (ok-regexp diff-buffer) (setq emerge-diff-error-buffer (get-buffer-create "*emerge-diff-errors*")) - (emerge-eval-in-buffer - emerge-diff-error-buffer - (erase-buffer) - (insert-buffer diff-buffer) - (delete-matching-lines ok-regexp))) + (with-current-buffer + emerge-diff-error-buffer + (erase-buffer) + (insert-buffer diff-buffer) + (delete-matching-lines ok-regexp))) ;;; Top-level and setup functions for three-file mode. @@ -754,45 +743,45 @@ (if output-file (setq emerge-last-dir-output (file-name-directory output-file))) ;; Make sure the entire files are seen, and they reflect what is on disk - (emerge-eval-in-buffer - buffer-A - (widen) - (if (emerge-remote-file-p) - (progn - ;; Store in a local file - (setq file-A (emerge-make-temp-file "A")) - (write-region (point-min) (point-max) file-A nil 'no-message) - (setq startup-hooks - (cons (` (lambda () (delete-file (, file-A)))) - startup-hooks))) - ;; Verify that the file matches the buffer - (emerge-verify-file-buffer))) - (emerge-eval-in-buffer - buffer-B - (widen) - (if (emerge-remote-file-p) - (progn - ;; Store in a local file - (setq file-B (emerge-make-temp-file "B")) - (write-region (point-min) (point-max) file-B nil 'no-message) - (setq startup-hooks - (cons (` (lambda () (delete-file (, file-B)))) - startup-hooks))) - ;; Verify that the file matches the buffer - (emerge-verify-file-buffer))) - (emerge-eval-in-buffer - buffer-ancestor - (widen) - (if (emerge-remote-file-p) - (progn - ;; Store in a local file - (setq file-ancestor (emerge-make-temp-file "anc")) - (write-region (point-min) (point-max) file-ancestor nil 'no-message) - (setq startup-hooks - (cons (` (lambda () (delete-file (, file-ancestor)))) - startup-hooks))) - ;; Verify that the file matches the buffer - (emerge-verify-file-buffer))) + (with-current-buffer + buffer-A + (widen) + (if (emerge-remote-file-p) + (progn + ;; Store in a local file + (setq file-A (emerge-make-temp-file "A")) + (write-region (point-min) (point-max) file-A nil 'no-message) + (setq startup-hooks + (cons (` (lambda () (delete-file (, file-A)))) + startup-hooks))) + ;; Verify that the file matches the buffer + (emerge-verify-file-buffer))) + (with-current-buffer + buffer-B + (widen) + (if (emerge-remote-file-p) + (progn + ;; Store in a local file + (setq file-B (emerge-make-temp-file "B")) + (write-region (point-min) (point-max) file-B nil 'no-message) + (setq startup-hooks + (cons (` (lambda () (delete-file (, file-B)))) + startup-hooks))) + ;; Verify that the file matches the buffer + (emerge-verify-file-buffer))) + (with-current-buffer + buffer-ancestor + (widen) + (if (emerge-remote-file-p) + (progn + ;; Store in a local file + (setq file-ancestor (emerge-make-temp-file "anc")) + (write-region (point-min) (point-max) file-ancestor nil 'no-message) + (setq startup-hooks + (cons (` (lambda () (delete-file (, file-ancestor)))) + startup-hooks))) + ;; Verify that the file matches the buffer + (emerge-verify-file-buffer))) (emerge-setup-with-ancestor buffer-A file-A buffer-B file-B buffer-ancestor file-ancestor startup-hooks quit-hooks output-file))) @@ -809,52 +798,52 @@ (let* ((merge-buffer-name (emerge-unique-buffer-name "*merge" "*")) ;; create the merge buffer from buffer A, so it inherits buffer A's ;; default directory, etc. - (merge-buffer (emerge-eval-in-buffer - buffer-A - (get-buffer-create merge-buffer-name)))) - (emerge-eval-in-buffer - merge-buffer - (emerge-copy-modes buffer-A) - (setq buffer-read-only nil) - (auto-save-mode 1) - (setq emerge-mode t) - (setq emerge-A-buffer buffer-A) - (setq emerge-B-buffer buffer-B) - (setq emerge-ancestor-buffer buffer-ancestor) - (setq emerge-merge-buffer merge-buffer) - (setq emerge-output-description - (if output-file - (concat "Output to file: " output-file) - (concat "Output to buffer: " (buffer-name merge-buffer)))) - (insert-buffer emerge-A-buffer) - (emerge-set-keys) - (setq emerge-difference-list - (emerge-make-diff3-list file-A file-B file-ancestor)) - (setq emerge-number-of-differences (length emerge-difference-list)) - (setq emerge-current-difference -1) - (setq emerge-quit-hook quit-hooks) - (emerge-remember-buffer-characteristics) - (emerge-select-prefer-Bs) - (emerge-handle-local-variables)) + (merge-buffer (with-current-buffer + buffer-A + (get-buffer-create merge-buffer-name)))) + (with-current-buffer + merge-buffer + (emerge-copy-modes buffer-A) + (setq buffer-read-only nil) + (auto-save-mode 1) + (setq emerge-mode t) + (setq emerge-A-buffer buffer-A) + (setq emerge-B-buffer buffer-B) + (setq emerge-ancestor-buffer buffer-ancestor) + (setq emerge-merge-buffer merge-buffer) + (setq emerge-output-description + (if output-file + (concat "Output to file: " output-file) + (concat "Output to buffer: " (buffer-name merge-buffer)))) + (insert-buffer emerge-A-buffer) + (emerge-set-keys) + (setq emerge-difference-list + (emerge-make-diff3-list file-A file-B file-ancestor)) + (setq emerge-number-of-differences (length emerge-difference-list)) + (setq emerge-current-difference -1) + (setq emerge-quit-hook quit-hooks) + (emerge-remember-buffer-characteristics) + (emerge-select-prefer-Bs) + (emerge-handle-local-variables)) (emerge-setup-windows buffer-A buffer-B merge-buffer t) - (emerge-eval-in-buffer merge-buffer - (run-hooks 'startup-hooks 'emerge-startup-hook) - (setq buffer-read-only t)))) + (with-current-buffer merge-buffer + (run-hooks 'startup-hooks 'emerge-startup-hook) + (setq buffer-read-only t)))) ;; Generate the Emerge difference list between two files with an ancestor (defun emerge-make-diff3-list (file-A file-B file-ancestor) (let ((diff-buffer (get-buffer-create "*emerge-diff*"))) - (emerge-eval-in-buffer - diff-buffer - (erase-buffer) - (shell-command - (format "%s %s %s %s %s" - emerge-diff3-program emerge-diff-options - ;; #### - fsf reverses file-ancestor and file-A, why? - (emerge-protect-metachars file-ancestor) - (emerge-protect-metachars file-A) - (emerge-protect-metachars file-B)) - t)) + (with-current-buffer + diff-buffer + (erase-buffer) + (shell-command + (format "%s %s %s %s %s" + emerge-diff3-program emerge-diff-options + ;; #### - fsf reverses file-ancestor and file-A, why? + (emerge-protect-metachars file-ancestor) + (emerge-protect-metachars file-A) + (emerge-protect-metachars file-B)) + t)) (emerge-prepare-error-list emerge-diff3-ok-lines-regexp diff-buffer) (emerge-convert-diffs-to-markers emerge-A-buffer emerge-B-buffer emerge-merge-buffer @@ -862,26 +851,26 @@ (defun emerge-extract-diffs3 (diff-buffer) (let (list) - (emerge-eval-in-buffer - diff-buffer - (while (re-search-forward "^====\\(.?\\)$" nil t) - ;; leave point after matched line - (beginning-of-line 2) - (let ((agreement (buffer-substring (match-beginning 1) (match-end 1)))) - ;; if the A and B files are the same, ignore the difference - (if (not (string-equal agreement "1")) ; this goes with the file-A/ancestor reversal - (setq list - (cons - (let* ((pos (point)) - (group-2 (emerge-get-diff3-group "2")) - (group-3 (progn (goto-char pos) - (emerge-get-diff3-group "3")))) - (vector (car group-2) (car (cdr group-2)) - (car group-3) (car (cdr group-3)) - (cond ((string-equal agreement "2") 'prefer-A) - ((string-equal agreement "3") 'prefer-B) - (t 'default-A)))) - list)))))) + (with-current-buffer + diff-buffer + (while (re-search-forward "^====\\(.?\\)$" nil t) + ;; leave point after matched line + (beginning-of-line 2) + (let ((agreement (buffer-substring (match-beginning 1) (match-end 1)))) + ;; if the A and B files are the same, ignore the difference + (if (not (string-equal agreement "1")) ; this goes with the file-A/ancestor reversal + (setq list + (cons + (let* ((pos (point)) + (group-2 (emerge-get-diff3-group "2")) + (group-3 (progn (goto-char pos) + (emerge-get-diff3-group "3")))) + (vector (car group-2) (car (cdr group-2)) + (car group-3) (car (cdr group-3)) + (cond ((string-equal agreement "2") 'prefer-A) + ((string-equal agreement "3") 'prefer-B) + (t 'default-A)))) + list)))))) (nreverse list))) (defun emerge-get-diff3-group (file) @@ -974,12 +963,12 @@ (interactive "bBuffer A to merge: \nbBuffer B to merge: ") (let ((emerge-file-A (emerge-make-temp-file "A")) (emerge-file-B (emerge-make-temp-file "B"))) - (emerge-eval-in-buffer - buffer-A - (write-region (point-min) (point-max) emerge-file-A nil 'no-message)) - (emerge-eval-in-buffer - buffer-B - (write-region (point-min) (point-max) emerge-file-B nil 'no-message)) + (with-current-buffer + buffer-A + (write-region (point-min) (point-max) emerge-file-A nil 'no-message)) + (with-current-buffer + buffer-B + (write-region (point-min) (point-max) emerge-file-B nil 'no-message)) (emerge-setup (get-buffer buffer-A) emerge-file-A (get-buffer buffer-B) emerge-file-B (cons (` (lambda () @@ -999,16 +988,16 @@ (let ((emerge-file-A (emerge-make-temp-file "A")) (emerge-file-B (emerge-make-temp-file "B")) (emerge-file-ancestor (emerge-make-temp-file "anc"))) - (emerge-eval-in-buffer - buffer-A - (write-region (point-min) (point-max) emerge-file-A nil 'no-message)) - (emerge-eval-in-buffer - buffer-B - (write-region (point-min) (point-max) emerge-file-B nil 'no-message)) - (emerge-eval-in-buffer - buffer-ancestor - (write-region (point-min) (point-max) emerge-file-ancestor nil - 'no-message)) + (with-current-buffer + buffer-A + (write-region (point-min) (point-max) emerge-file-A nil 'no-message)) + (with-current-buffer + buffer-B + (write-region (point-min) (point-max) emerge-file-B nil 'no-message)) + (with-current-buffer + buffer-ancestor + (write-region (point-min) (point-max) emerge-file-ancestor nil + 'no-message)) (emerge-setup-with-ancestor (get-buffer buffer-A) emerge-file-A (get-buffer buffer-B) emerge-file-B (get-buffer buffer-ancestor) @@ -1137,22 +1126,22 @@ (emerge-file-A (emerge-make-temp-file "A")) (emerge-file-B (emerge-make-temp-file "B"))) ;; Get the revisions into buffers - (emerge-eval-in-buffer - buffer-A - (erase-buffer) - (shell-command - (format "%s -q -p%s %s" emerge-rcs-co-program revision-A file) - t) - (write-region (point-min) (point-max) emerge-file-A nil 'no-message) - (set-buffer-modified-p nil)) - (emerge-eval-in-buffer - buffer-B - (erase-buffer) - (shell-command - (format "%s -q -p%s %s" emerge-rcs-co-program revision-B file) - t) - (write-region (point-min) (point-max) emerge-file-B nil 'no-message) - (set-buffer-modified-p nil)) + (with-current-buffer + buffer-A + (erase-buffer) + (shell-command + (format "%s -q -p%s %s" emerge-rcs-co-program revision-A file) + t) + (write-region (point-min) (point-max) emerge-file-A nil 'no-message) + (set-buffer-modified-p nil)) + (with-current-buffer + buffer-B + (erase-buffer) + (shell-command + (format "%s -q -p%s %s" emerge-rcs-co-program revision-B file) + t) + (write-region (point-min) (point-max) emerge-file-B nil 'no-message) + (set-buffer-modified-p nil)) ;; Do the merge (emerge-setup buffer-A emerge-file-A buffer-B emerge-file-B @@ -1175,31 +1164,31 @@ (emerge-file-B (emerge-make-temp-file "B")) (emerge-ancestor (emerge-make-temp-file "ancestor"))) ;; Get the revisions into buffers - (emerge-eval-in-buffer - buffer-A - (erase-buffer) - (shell-command - (format "%s -q -p%s %s" emerge-rcs-co-program - revision-A file) - t) - (write-region (point-min) (point-max) emerge-file-A nil 'no-message) - (set-buffer-modified-p nil)) - (emerge-eval-in-buffer - buffer-B - (erase-buffer) - (shell-command - (format "%s -q -p%s %s" emerge-rcs-co-program revision-B file) - t) - (write-region (point-min) (point-max) emerge-file-B nil 'no-message) - (set-buffer-modified-p nil)) - (emerge-eval-in-buffer - buffer-ancestor - (erase-buffer) - (shell-command - (format "%s -q -p%s %s" emerge-rcs-co-program ancestor file) - t) - (write-region (point-min) (point-max) emerge-ancestor nil 'no-message) - (set-buffer-modified-p nil)) + (with-current-buffer + buffer-A + (erase-buffer) + (shell-command + (format "%s -q -p%s %s" emerge-rcs-co-program + revision-A file) + t) + (write-region (point-min) (point-max) emerge-file-A nil 'no-message) + (set-buffer-modified-p nil)) + (with-current-buffer + buffer-B + (erase-buffer) + (shell-command + (format "%s -q -p%s %s" emerge-rcs-co-program revision-B file) + t) + (write-region (point-min) (point-max) emerge-file-B nil 'no-message) + (set-buffer-modified-p nil)) + (with-current-buffer + buffer-ancestor + (erase-buffer) + (shell-command + (format "%s -q -p%s %s" emerge-rcs-co-program ancestor file) + t) + (write-region (point-min) (point-max) emerge-ancestor nil 'no-message) + (set-buffer-modified-p nil)) ;; Do the merge (emerge-setup-with-ancestor buffer-A emerge-file-A buffer-B emerge-file-B @@ -1426,7 +1415,7 @@ (if pos (goto-char (point-min))) ;; If diff/diff3 reports errors, display them rather than the merge buffer. - (if (/= 0 (emerge-eval-in-buffer emerge-diff-error-buffer (buffer-size))) + (if (/= 0 (with-current-buffer emerge-diff-error-buffer (buffer-size))) (progn (ding) (message "Errors found in diff/diff3 output. Merge buffer is %s." @@ -1483,30 +1472,30 @@ (do-auto-save) ;; remember and alter buffer characteristics (setq emerge-A-buffer-values - (emerge-eval-in-buffer - emerge-A-buffer - (prog1 - (emerge-save-variables emerge-saved-variables) - (emerge-restore-variables emerge-saved-variables - emerge-merging-values)))) + (with-current-buffer + emerge-A-buffer + (prog1 + (emerge-save-variables emerge-saved-variables) + (emerge-restore-variables emerge-saved-variables + emerge-merging-values)))) (setq emerge-B-buffer-values - (emerge-eval-in-buffer - emerge-B-buffer - (prog1 - (emerge-save-variables emerge-saved-variables) - (emerge-restore-variables emerge-saved-variables - emerge-merging-values))))) + (with-current-buffer + emerge-B-buffer + (prog1 + (emerge-save-variables emerge-saved-variables) + (emerge-restore-variables emerge-saved-variables + emerge-merging-values))))) (defun emerge-restore-buffer-characteristics () "Restores characteristics saved by `emerge-remember-buffer-characteristics'." (let ((A-values emerge-A-buffer-values) (B-values emerge-B-buffer-values)) - (emerge-eval-in-buffer emerge-A-buffer - (emerge-restore-variables emerge-saved-variables - A-values)) - (emerge-eval-in-buffer emerge-B-buffer - (emerge-restore-variables emerge-saved-variables - B-values)))) + (with-current-buffer emerge-A-buffer + (emerge-restore-variables emerge-saved-variables + A-values)) + (with-current-buffer emerge-B-buffer + (emerge-restore-variables emerge-saved-variables + B-values)))) ;; Move to line DESIRED-LINE assuming we are at line CURRENT-LINE. ;; Return DESIRED-LINE. (defun emerge-goto-line (desired-line current-line) @@ -1518,15 +1507,15 @@ merge-buffer lineno-list) (let* (marker-list - (A-point-min (emerge-eval-in-buffer A-buffer (point-min))) + (A-point-min (with-current-buffer A-buffer (point-min))) (offset (1- A-point-min)) - (B-point-min (emerge-eval-in-buffer B-buffer (point-min))) + (B-point-min (with-current-buffer B-buffer (point-min))) ;; Record current line number in each buffer ;; so we don't have to count from the beginning. (a-line 1) (b-line 1)) - (emerge-eval-in-buffer A-buffer (goto-char (point-min))) - (emerge-eval-in-buffer B-buffer (goto-char (point-min))) + (with-current-buffer A-buffer (goto-char (point-min))) + (with-current-buffer B-buffer (goto-char (point-min))) (while lineno-list (let* ((list-element (car lineno-list)) a-begin-marker @@ -1541,18 +1530,18 @@ (b-end (aref list-element 3)) (state (aref list-element 4))) ;; place markers at the appropriate places in the buffers - (emerge-eval-in-buffer - A-buffer - (setq a-line (emerge-goto-line a-begin a-line)) - (setq a-begin-marker (point-marker)) - (setq a-line (emerge-goto-line a-end a-line)) - (setq a-end-marker (point-marker))) - (emerge-eval-in-buffer - B-buffer - (setq b-line (emerge-goto-line b-begin b-line)) - (setq b-begin-marker (point-marker)) - (setq b-line (emerge-goto-line b-end b-line)) - (setq b-end-marker (point-marker))) + (with-current-buffer + A-buffer + (setq a-line (emerge-goto-line a-begin a-line)) + (setq a-begin-marker (point-marker)) + (setq a-line (emerge-goto-line a-end a-line)) + (setq a-end-marker (point-marker))) + (with-current-buffer + B-buffer + (setq b-line (emerge-goto-line b-begin b-line)) + (setq b-begin-marker (point-marker)) + (setq b-line (emerge-goto-line b-end b-line)) + (setq b-end-marker (point-marker))) (setq merge-begin-marker (set-marker (make-marker) (- (marker-position a-begin-marker) @@ -1978,14 +1967,14 @@ ;; Actually select the A variant (defun emerge-select-A-edit (merge-begin merge-end A-begin A-end) - (emerge-eval-in-buffer - emerge-merge-buffer - (delete-region merge-begin merge-end) - (goto-char merge-begin) - (insert-buffer-substring emerge-A-buffer A-begin A-end) - (goto-char merge-begin) - (aset diff-vector 6 'A) - (emerge-refresh-mode-line))) + (with-current-buffer + emerge-merge-buffer + (delete-region merge-begin merge-end) + (goto-char merge-begin) + (insert-buffer-substring emerge-A-buffer A-begin A-end) + (goto-char merge-begin) + (aset diff-vector 6 'A) + (emerge-refresh-mode-line))) (defun emerge-select-B (&optional force) "Select the B variant of this difference. @@ -2007,14 +1996,14 @@ ;; Actually select the B variant (defun emerge-select-B-edit (merge-begin merge-end B-begin B-end) - (emerge-eval-in-buffer - emerge-merge-buffer - (delete-region merge-begin merge-end) - (goto-char merge-begin) - (insert-buffer-substring emerge-B-buffer B-begin B-end) - (goto-char merge-begin) - (aset diff-vector 6 'B) - (emerge-refresh-mode-line))) + (with-current-buffer + emerge-merge-buffer + (delete-region merge-begin merge-end) + (goto-char merge-begin) + (insert-buffer-substring emerge-B-buffer B-begin B-end) + (goto-char merge-begin) + (aset diff-vector 6 'B) + (emerge-refresh-mode-line))) (defun emerge-default-A (force) "Make the A variant the default from here down. @@ -2219,34 +2208,34 @@ (switch-to-buffer buf) (other-window 1))))) (with-output-to-temp-buffer "*Help*" - (emerge-eval-in-buffer emerge-A-buffer - (if buffer-file-name - (progn - (princ "File A is: ") - (princ buffer-file-name)) - (progn - (princ "Buffer A is: ") - (princ (buffer-name)))) - (princ "\n")) - (emerge-eval-in-buffer emerge-B-buffer - (if buffer-file-name - (progn - (princ "File B is: ") - (princ buffer-file-name)) - (progn - (princ "Buffer B is: ") - (princ (buffer-name)))) - (princ "\n")) + (with-current-buffer emerge-A-buffer + (if buffer-file-name + (progn + (princ "File A is: ") + (princ buffer-file-name)) + (progn + (princ "Buffer A is: ") + (princ (buffer-name)))) + (princ "\n")) + (with-current-buffer emerge-B-buffer + (if buffer-file-name + (progn + (princ "File B is: ") + (princ buffer-file-name)) + (progn + (princ "Buffer B is: ") + (princ (buffer-name)))) + (princ "\n")) (if emerge-ancestor-buffer - (emerge-eval-in-buffer emerge-ancestor-buffer - (if buffer-file-name - (progn - (princ "Ancestor file is: ") - (princ buffer-file-name)) - (progn - (princ "Ancestor buffer is: ") - (princ (buffer-name)))) - (princ "\n"))) + (with-current-buffer emerge-ancestor-buffer + (if buffer-file-name + (progn + (princ "Ancestor file is: ") + (princ buffer-file-name)) + (progn + (princ "Ancestor buffer is: ") + (princ (buffer-name)))) + (princ "\n"))) (princ emerge-output-description) (save-excursion (set-buffer standard-output) @@ -2310,10 +2299,10 @@ ;; check that this is a valid difference (emerge-validate-difference) ;; get the point values and old difference - (let ((A-point (emerge-eval-in-buffer emerge-A-buffer - (point-marker))) - (B-point (emerge-eval-in-buffer emerge-B-buffer - (point-marker))) + (let ((A-point (with-current-buffer emerge-A-buffer + (point-marker))) + (B-point (with-current-buffer emerge-B-buffer + (point-marker))) (merge-point (point-marker)) (old-diff (aref emerge-difference-list n))) ;; check location of the points, give error if they aren't in the @@ -2394,12 +2383,12 @@ (while success (setq size (min size (- bottom-a top-a) (- bottom-b top-b) (- bottom-m top-m))) - (setq sa (emerge-eval-in-buffer emerge-A-buffer - (buffer-substring top-a - (+ size top-a)))) - (setq sb (emerge-eval-in-buffer emerge-B-buffer - (buffer-substring top-b - (+ size top-b)))) + (setq sa (with-current-buffer emerge-A-buffer + (buffer-substring top-a + (+ size top-a)))) + (setq sb (with-current-buffer emerge-B-buffer + (buffer-substring top-b + (+ size top-b)))) (setq sm (buffer-substring top-m (+ size top-m))) (setq success (and (> size 0) (equal sa sb) (equal sb sm))) (if success @@ -2416,12 +2405,12 @@ (while success (setq size (min size (- bottom-a top-a) (- bottom-b top-b) (- bottom-m top-m))) - (setq sa (emerge-eval-in-buffer emerge-A-buffer - (buffer-substring (- bottom-a size) - bottom-a))) - (setq sb (emerge-eval-in-buffer emerge-B-buffer - (buffer-substring (- bottom-b size) - bottom-b))) + (setq sa (with-current-buffer emerge-A-buffer + (buffer-substring (- bottom-a size) + bottom-a))) + (setq sb (with-current-buffer emerge-B-buffer + (buffer-substring (- bottom-b size) + bottom-b))) (setq sm (buffer-substring (- bottom-m size) bottom-m)) (setq success (and (> size 0) (equal sa sb) (equal sb sm))) (if success @@ -2432,20 +2421,20 @@ ;; {top,bottom}-{a,b,m} are now set at the new beginnings and ends ;; of the difference regions. Move them to the beginning of lines, as ;; appropriate. - (emerge-eval-in-buffer emerge-A-buffer - (goto-char top-a) - (beginning-of-line) - (aset diff 0 (point-marker)) - (goto-char bottom-a) - (beginning-of-line 2) - (aset diff 1 (point-marker))) - (emerge-eval-in-buffer emerge-B-buffer - (goto-char top-b) - (beginning-of-line) - (aset diff 2 (point-marker)) - (goto-char bottom-b) - (beginning-of-line 2) - (aset diff 3 (point-marker))) + (with-current-buffer emerge-A-buffer + (goto-char top-a) + (beginning-of-line) + (aset diff 0 (point-marker)) + (goto-char bottom-a) + (beginning-of-line 2) + (aset diff 1 (point-marker))) + (with-current-buffer emerge-B-buffer + (goto-char top-b) + (beginning-of-line) + (aset diff 2 (point-marker)) + (goto-char bottom-b) + (beginning-of-line 2) + (aset diff 3 (point-marker))) (goto-char top-m) (beginning-of-line) (aset diff 4 (point-marker)) @@ -2490,7 +2479,7 @@ ;; search for the point in the A buffer, using the markers ;; for the beginning and end of the differences in the A buffer (emerge-find-difference1 arg - (emerge-eval-in-buffer emerge-A-buffer (point)) + (with-current-buffer emerge-A-buffer (point)) 0 1)) (defun emerge-find-difference-B (arg) @@ -2503,7 +2492,7 @@ ;; search for the point in the B buffer, using the markers ;; for the beginning and end of the differences in the B buffer (emerge-find-difference1 arg - (emerge-eval-in-buffer emerge-B-buffer (point)) + (with-current-buffer emerge-B-buffer (point)) 2 3)) (defun emerge-find-difference1 (arg location begin end) @@ -2554,10 +2543,10 @@ (diff (and valid-diff (aref emerge-difference-list emerge-current-difference))) (merge-line (emerge-line-number-in-buf 4 5)) - (A-line (emerge-eval-in-buffer emerge-A-buffer - (emerge-line-number-in-buf 0 1))) - (B-line (emerge-eval-in-buffer emerge-B-buffer - (emerge-line-number-in-buf 2 3)))) + (A-line (with-current-buffer emerge-A-buffer + (emerge-line-number-in-buf 0 1))) + (B-line (with-current-buffer emerge-B-buffer + (emerge-line-number-in-buf 2 3)))) (message "At lines: merge = %d, A = %d, B = %d" merge-line A-line B-line))) @@ -2638,33 +2627,33 @@ (defun emerge-combine-versions-edit (merge-begin merge-end A-begin A-end B-begin B-end template) - (emerge-eval-in-buffer - emerge-merge-buffer - (delete-region merge-begin merge-end) - (goto-char merge-begin) - (let ((i 0)) - (while (< i (length template)) - (let ((c (aref template i))) - (if (= c ?%) - (progn - (setq i (1+ i)) - (setq c - (condition-case nil - (aref template i) - (error ?%))) - (cond ((= c ?a) - (insert-buffer-substring emerge-A-buffer A-begin A-end)) - ((= c ?b) - (insert-buffer-substring emerge-B-buffer B-begin B-end)) - ((= c ?%) - (insert ?%)) - (t - (insert c)))) - (insert c))) - (setq i (1+ i)))) - (goto-char merge-begin) - (aset diff-vector 6 'combined) - (emerge-refresh-mode-line))) + (with-current-buffer + emerge-merge-buffer + (delete-region merge-begin merge-end) + (goto-char merge-begin) + (let ((i 0)) + (while (< i (length template)) + (let ((c (aref template i))) + (if (= c ?%) + (progn + (setq i (1+ i)) + (setq c + (condition-case nil + (aref template i) + (error ?%))) + (cond ((= c ?a) + (insert-buffer-substring emerge-A-buffer A-begin A-end)) + ((= c ?b) + (insert-buffer-substring emerge-B-buffer B-begin B-end)) + ((= c ?%) + (insert ?%)) + (t + (insert c)))) + (insert c))) + (setq i (1+ i)))) + (goto-char merge-begin) + (aset diff-vector 6 'combined) + (emerge-refresh-mode-line))) (defun emerge-set-merge-mode (mode) "Set the major mode in a merge buffer. @@ -2699,9 +2688,9 @@ (defun emerge-place-flags-in-buffer (buffer difference before-index after-index) (if buffer - (emerge-eval-in-buffer - buffer - (emerge-place-flags-in-buffer1 difference before-index after-index)) + (with-current-buffer + buffer + (emerge-place-flags-in-buffer1 difference before-index after-index)) (emerge-place-flags-in-buffer1 difference before-index after-index))) (defun emerge-place-flags-in-buffer1 (difference before-index after-index) @@ -2792,22 +2781,22 @@ ;; XEmacs -- remove highlighting (emerge-remove-flags-in-buffer-xemacs buffer before after) ;; Else remove character flags - (emerge-eval-in-buffer - buffer - (let ((buffer-read-only nil)) - ;; remove the flags, if they're there - (goto-char (- before (1- emerge-before-flag-length))) - (if (looking-at emerge-before-flag-match) - (delete-char emerge-before-flag-length) - ;; the flag isn't there - (ding) - (message "Trouble removing flag")) - (goto-char (1- after)) - (if (looking-at emerge-after-flag-match) - (delete-char emerge-after-flag-length) - ;; the flag isn't there - (ding) - (message "Trouble removing flag")))))) + (with-current-buffer + buffer + (let ((buffer-read-only nil)) + ;; remove the flags, if they're there + (goto-char (- before (1- emerge-before-flag-length))) + (if (looking-at emerge-before-flag-match) + (delete-char emerge-before-flag-length) + ;; the flag isn't there + (ding) + (message "Trouble removing flag")) + (goto-char (1- after)) + (if (looking-at emerge-after-flag-match) + (delete-char emerge-after-flag-length) + ;; the flag isn't there + (ding) + (message "Trouble removing flag")))))) (defun emerge-remove-flags-in-buffer-xemacs (buffer before after) (map-extents (function (lambda (x y) @@ -2949,14 +2938,14 @@ (while (< x-begin x-end) ;; bite off and compare no more than 1000 characters at a time (let* ((compare-length (min (- x-end x-begin) 1000)) - (x-string (emerge-eval-in-buffer - buffer-x - (buffer-substring x-begin - (+ x-begin compare-length)))) - (y-string (emerge-eval-in-buffer - buffer-y - (buffer-substring y-begin - (+ y-begin compare-length))))) + (x-string (with-current-buffer + buffer-x + (buffer-substring x-begin + (+ x-begin compare-length)))) + (y-string (with-current-buffer + buffer-y + (buffer-substring y-begin + (+ y-begin compare-length))))) (if (not (string-equal x-string y-string)) (throw 'exit nil) (setq x-begin (+ x-begin compare-length)) @@ -3091,7 +3080,7 @@ ;; buffer. (defun emerge-copy-modes (buffer) ;; Set the major mode - (funcall (emerge-eval-in-buffer buffer major-mode))) + (funcall (with-current-buffer buffer major-mode))) ;; Define a key, even if a prefix of it is defined (defun emerge-force-define-key (keymap key definition)
--- a/lisp/packages/etags.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/packages/etags.el Mon Aug 13 09:57:07 2007 +0200 @@ -4,7 +4,7 @@ ;; Keywords: tools -;; This file is part of GNU Emacs. +;; This file is part of XEmacs. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY. No author or distributor @@ -183,21 +183,16 @@ ;; Auxiliary functions (defun tags-delete (item list) - "delete the item from the list, testing with equal. Copies the list." - (cond ((null list) - nil) - ((equal item (car list)) - (tags-delete item (cdr list))) - (t - (cons (car list) (tags-delete item (cdr list)))))) + "Delete the item from the list, testing with equal. Copies the list." + (delete item (copy-list list))) (defun tags-remove-duplicates (list) - "delete equal duplicates from the list; copies the list." - (cond ((null list) - nil) - (t - (cons (car list) - (tags-remove-duplicates (tags-delete (car list) (cdr list))))))) + "Delete equal duplicates from the list; copies the list." + (let (res) + (dolist (el list) + (unless (member el res) + (push el res))) + (nreverse res))) ;; derived from generate-new-buffer ;; now defined in C @@ -422,9 +417,11 @@ been built. this is nil, t, or 'disabled.") (make-variable-buffer-local 'tag-table-completion-status) -(defvar make-tags-files-invisible nil - "*If true, TAGS-files will not show up in buffer-lists or be -selectable (or deletable.)") +(defcustom make-tags-files-invisible nil + "*If non-nil, TAGS-files will not show up in buffer-lists or be +selectable (or deletable.)" + :type 'boolean + :group 'etags) (defconst tag-table-files nil "If the current buffer is a TAGS table, this holds a list of the files
--- a/lisp/packages/filladapt.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/packages/filladapt.el Mon Aug 13 09:57:07 2007 +0200 @@ -96,6 +96,7 @@ "*Non-nil means that Filladapt minor mode is enabled. Use the filladapt-mode command to toggle the mode on/off." :type 'boolean + :require 'filladapt :group 'filladapt) (make-variable-buffer-local 'filladapt-mode)
--- a/lisp/packages/func-menu.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/packages/func-menu.el Mon Aug 13 09:57:07 2007 +0200 @@ -218,7 +218,9 @@ (defgroup fume nil "Jump to a function within a buffer." :tag "Func Menu" - :group 'tools) + :group 'tools + :group 'c + :group 'lisp) (defconst fume-developer "David Hughes <d.hughes@videonetworks.com>")
--- a/lisp/packages/gopher.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/packages/gopher.el Mon Aug 13 09:57:07 2007 +0200 @@ -200,8 +200,9 @@ )) (defgroup gopher nil - "An Emacs gopher client." - :group 'hypermedia) + "Emacs gopher client." + :group 'hypermedia + :group 'comm) (defcustom gopher-root-node (vector ?1 "root" "" "ucs_gopher" 70)
--- a/lisp/packages/icomplete.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/packages/icomplete.el Mon Aug 13 09:57:07 2007 +0200 @@ -4,7 +4,7 @@ ;; Author: Ken Manheimer <klm@python.org> ;; Maintainer: Ken Manheimer <klm@python.org> -;; Version: $Id: icomplete.el,v 1.4 1997/06/06 00:57:26 steve Exp $ +;; Version: $Id: icomplete.el,v 1.5 1997/09/17 05:19:35 steve Exp $ ;; Created: Mar 1993 klm@nist.gov - first release to usenet ;; Keywords: help, abbrev @@ -44,13 +44,14 @@ ;; customize icomplete setup for interoperation with other ;; minibuffer-oriented packages. -;; To activate icomplete mode, simply load the package. You can -;; subsequently deactivate it by invoking the function icomplete-mode -;; with a negative prefix-arg (C-U -1 ESC-x icomplete-mode). Also, -;; you can prevent activation of the mode during package load by -;; first setting the variable `icomplete-mode' to nil. Icompletion -;; can be enabled any time after the package is loaded by invoking -;; icomplete-mode without a prefix arg. +;; To activate icomplete mode, load the package and use the +;; `icomplete-mode' function. You can subsequently deactivate it by +;; invoking the function icomplete-mode with a negative prefix-arg +;; (C-U -1 ESC-x icomplete-mode). Also, you can prevent activation of +;; the mode during package load by first setting the variable +;; `icomplete-mode' to nil. Icompletion can be enabled any time after +;; the package is loaded by invoking icomplete-mode without a prefix +;; arg. ;; Thanks to everyone for their suggestions for refinements of this ;; package. I particularly have to credit Michael Cook, who @@ -66,18 +67,38 @@ ;;;_* Provide (provide 'icomplete) +(defgroup icomplete nil + "Minibuffer completion incremental feedback." + :group 'minibuffer) + + +(defcustom icomplete-mode nil + "*Non-nil activates incremental minibuffer completion." + :type 'boolean + :set (lambda (symbol value) + (icomplete-mode (if value 1 -1))) + :initialize 'custom-initialize-default + :require 'icomplete + :group 'icomplete) + ;;;_* User Customization variables -(defvar icomplete-compute-delay .3 +(defcustom icomplete-compute-delay .3 "*Completions-computation stall, used only with large-number -completions - see `icomplete-delay-completions-threshold'.") -(defvar icomplete-delay-completions-threshold 400 - "*Pending-completions number over which to apply icomplete-compute-delay.") -(defvar icomplete-max-delay-chars 3 - "*Maximum number of initial chars to apply icomplete compute delay.") +completions - see `icomplete-delay-completions-threshold'." + :type 'number + :group 'icomplete) +(defcustom icomplete-delay-completions-threshold 400 + "*Pending-completions number over which to apply icomplete-compute-delay." + :type 'integer + :group 'icomplete) +(defcustom icomplete-max-delay-chars 3 + "*Maximum number of initial chars to apply icomplete compute delay." + :type 'integer + :group 'icomplete) ;;;_* Initialization ;;;_ = icomplete-minibuffer-setup-hook -(defvar icomplete-minibuffer-setup-hook nil +(defcustom icomplete-minibuffer-setup-hook nil "*Icomplete-specific customization of minibuffer setup. This hook is run during minibuffer setup iff icomplete will be active. @@ -91,12 +112,14 @@ \(setq resize-minibuffer-window-max-height 3)))) will constrain rsz-mini to a maximum minibuffer height of 3 lines when -icompletion is occurring.") +icompletion is occurring." + :type 'hook + :group 'icomplete) ;;;_ + Internal Variables ;;;_ = icomplete-mode -(defvar icomplete-mode t - "*Nil inhibits activated incremental minibuffer completion.") +;(defvar icomplete-mode t +; "*Nil inhibits activated incremental minibuffer completion.") ;;;_ = icomplete-eoinput 1 (defvar icomplete-eoinput 1 "Point where minibuffer input ends and completion info begins.")
--- a/lisp/packages/info.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/packages/info.el Mon Aug 13 09:57:07 2007 +0200 @@ -7,6 +7,7 @@ ;; Richard Stallman <rms@gnu.ai.mit.edu> ;; Maintainer: Dave Gillespie <daveg@synaptics.com> ;; Version: 1.07 of 7/22/93 +;; Keywords: docs, help ;; This file is part of XEmacs. @@ -306,8 +307,10 @@ ;; Code: (defgroup info nil - "Info subsystem" - :group 'help) + "The info package for Emacs." + :group 'help + :group 'docs) + (defcustom Info-inhibit-toolbar nil "*Non-nil means don't use the specialized Info toolbar." @@ -356,9 +359,9 @@ If nil, they beep and remain in the current node. If t, they move to the next node (like Info-global-next/prev). If anything else, they must be pressed twice to move to the next node." - :type '(radio (const :tag "off" nil) - (const :tag "advance" t) - (const :tag "confirm" twice)) + :type '(choice (const :tag "off" nil) + (const :tag "advance" t) + (const :tag "confirm" twice)) :group 'info) (defcustom Info-fontify t @@ -2257,6 +2260,11 @@ (and (>= x w/3) (<= x (+ w/3 w/3)))) (Info-up) t) + ;; In the bottom 1/4 and inside the middle 1/3 + ((and (>= y (+ h/4 h/4 h/4)) + (and (>= x w/3) (<= x (+ w/3 w/3)))) + (Info-nth-menu-item 1) + t) ;; In the lower 3/4 and the right 1/2 ;; OR in the upper 1/4 and the right 1/3 ((or (and (>= y h/4) (>= x w/2))
--- a/lisp/packages/jka-compr.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/packages/jka-compr.el Mon Aug 13 09:57:07 2007 +0200 @@ -105,11 +105,9 @@ "Data compression utilities" :group 'data) -(progn - (defgroup jka-compr nil - "jka-compr customization" - :group 'compression) - ) +(defgroup jka-compr nil + "jka-compr customization" + :group 'compression) (defcustom jka-compr-shell "sh" @@ -175,7 +173,8 @@ Because of the way `call-process' is defined, discarding the stderr output of a program adds the overhead of starting a shell each time the program is invoked." - :type '(repeat (vector regexp + :type '(repeat (vector :tag "Compression Technique" + regexp (choice :tag "Compress Message" (string :format "%v") (const :tag "No Message" nil)) @@ -231,7 +230,6 @@ (defun jka-compr-error (prog args infile message &optional errfile) - (let ((errbuf (get-buffer-create " *jka-compr-error*")) (curbuf (current-buffer))) (set-buffer errbuf) @@ -246,10 +244,11 @@ (set-buffer curbuf) (display-buffer errbuf)) + (signal 'compression-error (list "Opening input file" + (format "error %s" message) + infile))) - (signal 'compression-error (list "Opening input file" (format "error %s" message) infile))) - - + (defvar jka-compr-dd-program "/bin/dd") @@ -862,13 +861,8 @@ (rassq 'jka-compr-handler file-name-handler-alist)) -;;; Add the file I/O hook if it does not already exist. -;;; Make sure that jka-compr-file-name-handler-entry is eq to the -;;; entry for jka-compr in file-name-handler-alist. -(and (jka-compr-installed-p) - (jka-compr-uninstall)) - -(jka-compr-install) +;; No no no no! +;(jka-compr-install) (provide 'jka-compr)
--- a/lisp/packages/makeinfo.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/packages/makeinfo.el Mon Aug 13 09:57:07 2007 +0200 @@ -50,7 +50,7 @@ (require 'compile) (defgroup makeinfo nil - "Run makeinfo conveniently" + "Run makeinfo conveniently." :group 'docs)
--- a/lisp/packages/man.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/packages/man.el Mon Aug 13 09:57:07 2007 +0200 @@ -31,7 +31,7 @@ ;; I've deleted. ] (defgroup man nil - "Browse manual pages" + "Browse Unix manual pages" :group 'help) (defcustom Manual-program "man" "\ @@ -44,9 +44,9 @@ nil means leave the buffer in fundamental-mode in another window. t means use `view-buffer' to display the man page in the current window. Any other value means use `view-buffer-other-window'." - :type '(choice (const :tag "fundamental-mode other window" nil) - (const :tag "view-mode current window" t) - (const :tag "view-mode other window" other)) + :type '(radio (const :tag "Fundamental-mode other window" nil) + (const :tag "View-mode current window" t) + (sexp :format "%t\n" :tag "View-mode other window" other)) :group 'man) (defcustom Manual-mode-hook nil @@ -77,71 +77,70 @@ :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 +;;pages formatted for a variety of UNIX flavors (not [tn]roff source) +;;and produces as output a variety of file formats. Currently +;;RosettaMan accepts man pages as formatted by the following flavors of +;;UNIX: Hewlett-Packard HP-UX, AT&T System V, SunOS, Sun Solaris, OSF/1, +;;DEC Ultrix, SGI IRIX, Linux, SCO; and produces output for the following +;;formats: printable ASCII only (stripping page headers and footers), +;;section and subsection headers only, TkMan, [tn]roff, Ensemble, RTF, +;;SGML (soon--I finally found a DTD), HTML, MIME, LaTeX, LaTeX 2e, Perl 5's pod. + +;;RosettaMan improves on other man page filters in several ways: (1) its +;;analysis recognizes the structural pieces of man pages, enabling high +;;quality output, (2) its modular structure permits easy augmentation of +;;output formats, (3) it accepts man pages formatted with the varient +;;macros of many different flavors of UNIX, and (4) it doesn't require +;;modification or cooperation with any other program. + +;;RosettaMan is a rewrite of TkMan's man page filter, called bs2tk. (If +;;you haven't heard about TkMan, a hypertext man page browser, you +;;should grab it via anonymous ftp from ftp.cs.berkeley.edu: +;;/ucb/people/phelps/tkman.tar.Z.) Whereas bs2tk generated output only for +;;TkMan, RosettaMan generalizes the process so that the analysis can be +;;leveraged to new output formats. A single analysis engine recognizes +;;section heads, subsection heads, body text, lists, references to other +;;man pages, boldface, italics, bold italics, special characters (like +;;bullets), tables (to a degree) and strips out page headers and +;;footers. The engine sends signals to the selected output functions so +;;that an enhancement in the engine improves the quality of output of +;;all of them. Output format functions are easy to add, and thus far +;;average about about 75 lines of C code each. + + + +;;*** NOTES ON CURRENT VERSION *** + +;;Help! I'm looking for people to help with the following projects. +;;\(1) Better RTF output format. The current one works, but could be +;;made better. (2) Roff macros that produce text that is easily +;;parsable. RosettaMan handles a great variety, but some things, like +;;H-P's tables, are intractable. If you write an output format or +;;otherwise improve RosettaMan, please send in your code so that I may +;;share the wealth in future releases. + +;;This version can try to identify tables (turn this on with the -T +;;switch) by looking for lines with a large amount of interword spacing, +;;reasoning that this is space between columns of a table. This +;;heuristic doesn't always work and sometimes misidentifies ordinary +;;text as tables. In general I think it is impossible to perfectly +;;identify tables from nroff formatted text. However, I do think the +;;heuristics can be tuned, so if you have a collection of manual pages +;;with unrecognized tables, send me the lot, in formatted form (i.e., +;;after formatting with nroff -man), and uuencode them to preserve the +;;control characters. Better, if you can think of heuristics that +;;distinguish tables from ordinary text, I'd like to hear them. + +;;Notes for HTML consumers: This filter does real (heuristic) +;;parsing--no <PRE>! Man page references are turned into hypertext links. + (defcustom Manual-use-rosetta-man (not (null (locate-file "rman" exec-path))) "\ If non-nil, use RosettaMan (rman) to filter man pages. This makes man-page cleanup virtually instantaneous, instead of -potentially taking a long time. - -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 -pages formatted for a variety of UNIX flavors (not [tn]roff source) -and produces as output a variety of file formats. Currently -RosettaMan accepts man pages as formatted by the following flavors of -UNIX: Hewlett-Packard HP-UX, AT&T System V, SunOS, Sun Solaris, OSF/1, -DEC Ultrix, SGI IRIX, Linux, SCO; and produces output for the following -formats: printable ASCII only (stripping page headers and footers), -section and subsection headers only, TkMan, [tn]roff, Ensemble, RTF, -SGML (soon--I finally found a DTD), HTML, MIME, LaTeX, LaTeX 2e, Perl 5's pod. - -RosettaMan improves on other man page filters in several ways: (1) its -analysis recognizes the structural pieces of man pages, enabling high -quality output, (2) its modular structure permits easy augmentation of -output formats, (3) it accepts man pages formatted with the varient -macros of many different flavors of UNIX, and (4) it doesn't require -modification or cooperation with any other program. - -RosettaMan is a rewrite of TkMan's man page filter, called bs2tk. (If -you haven't heard about TkMan, a hypertext man page browser, you -should grab it via anonymous ftp from ftp.cs.berkeley.edu: -/ucb/people/phelps/tkman.tar.Z.) Whereas bs2tk generated output only for -TkMan, RosettaMan generalizes the process so that the analysis can be -leveraged to new output formats. A single analysis engine recognizes -section heads, subsection heads, body text, lists, references to other -man pages, boldface, italics, bold italics, special characters (like -bullets), tables (to a degree) and strips out page headers and -footers. The engine sends signals to the selected output functions so -that an enhancement in the engine improves the quality of output of -all of them. Output format functions are easy to add, and thus far -average about about 75 lines of C code each. - - - -*** NOTES ON CURRENT VERSION *** - -Help! I'm looking for people to help with the following projects. -\(1) Better RTF output format. The current one works, but could be -made better. (2) Roff macros that produce text that is easily -parsable. RosettaMan handles a great variety, but some things, like -H-P's tables, are intractable. If you write an output format or -otherwise improve RosettaMan, please send in your code so that I may -share the wealth in future releases. - -This version can try to identify tables (turn this on with the -T -switch) by looking for lines with a large amount of interword spacing, -reasoning that this is space between columns of a table. This -heuristic doesn't always work and sometimes misidentifies ordinary -text as tables. In general I think it is impossible to perfectly -identify tables from nroff formatted text. However, I do think the -heuristics can be tuned, so if you have a collection of manual pages -with unrecognized tables, send me the lot, in formatted form (i.e., -after formatting with nroff -man), and uuencode them to preserve the -control characters. Better, if you can think of heuristics that -distinguish tables from ordinary text, I'd like to hear them. - - -Notes for HTML consumers: This filter does real (heuristic) -parsing--no <PRE>! Man page references are turned into hypertext links." +potentially taking a long time." :type 'boolean :group 'man)
--- a/lisp/packages/paren.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/packages/paren.el Mon Aug 13 09:57:07 2007 +0200 @@ -54,6 +54,36 @@ ;;; Code: +(defgroup paren-matching nil + "Highlight (un)matching of parens and expressions." + :prefix "paren-" + :group 'matching) + + +;;;###autoload +(defcustom paren-mode nil + "*Sets the style of parenthesis highlighting. +Valid values are nil, `blink-paren', `paren', and `sexp'. + nil no parenthesis highlighting. + blink-paren causes the matching paren to blink. + paren causes the matching paren to be highlighted but not to blink. + sexp whole expression enclosed by the local paren at its mate. + nested (not yet implemented) use variable shading to see the + nesting of an expression. Also groks regular expressions + and shell quoting. + +This variable is global by default, but you can make it buffer-local and +highlight parentheses differently in different major modes." + :type '(radio (const :tag "None (default)" nil) + (const :tag "Blinking Paren" blink-paren) + (const :tag "Highlighted Paren" paren) + (const :tag "Highlighted Expression" sexp)) + :set (lambda (symbol value) + (paren-set-mode value)) + :initialize 'custom-initialize-default + :require 'paren + :group 'paren-matching) + (defcustom paren-message-offscreen t "*Display message if matching open paren is offscreen." :type 'boolean @@ -71,24 +101,6 @@ (const :tag "other" other)) :group 'paren-matching) -;;;###autoload -(defcustom paren-mode nil - "*Sets the style of parenthesis highlighting. -Valid values are nil, `blink-paren', `paren', and `sexp'. - nil no parenthesis highlighting. - blink-paren causes the matching paren to blink. - paren causes the matching paren to be highlighted but not to blink. - sexp whole expression enclosed by the local paren at its mate. - nested (not yet implemented) use variable shading to see the - nesting of an expression. Also groks regular expressions - and shell quoting. - -This variable is global by default, but you can make it buffer-local and -highlight parentheses differently in different major modes." - :type '(radio (const nil) (const blink-paren) (const paren) - (const sexp) (const nested)) - :group 'paren-matching) - (make-face 'paren-match) (or (face-differs-from-default-p 'paren-match) (copy-face 'highlight 'paren-match)) @@ -116,15 +128,19 @@ ;; this is either paren-match or paren-mismatch... (defvar paren-blink-on-face nil) -(defvar paren-blink-interval 0.2 +(defcustom paren-blink-interval 0.2 "*If the cursor is on a parenthesis, the matching parenthesis will blink. This variable controls how long each phase of the blink lasts in seconds. -This should be a fractional part of a second (a float.)") +This should be a fractional part of a second (a float.)" + :type 'number + :group 'paren-matching) -(defvar paren-max-blinks (* 5 60 5) ; 5 minutes is plenty... +(defcustom paren-max-blinks (* 5 60 5) ; 5 minutes is plenty... ;; idea from Eric Eide <eeide@jaguar.cs.utah.edu> "*Maximum number of times that a matching parenthesis will blink. -Set this to NIL if you want indefinite blinking.") +Set this to NIL if you want indefinite blinking." + :type 'number + :group 'paren-matching) ;; timeout to blink the face (defvar paren-timeout-id nil) @@ -310,10 +326,6 @@ paren-blink-interval)))))) )))) -;; kill off the competition, er, uh, eliminate redundancy... -(setq post-command-hook (delq 'show-paren-command-hook post-command-hook)) -(setq pre-command-hook (delq 'blink-paren-pre-command pre-command-hook)) -(setq post-command-hook (delq 'blink-paren-post-command post-command-hook)) ;;;###autoload (defun paren-set-mode (arg &optional quiet) @@ -321,6 +333,11 @@ When called from lisp, a symbolic value for `paren-mode' can be passed directly. See also `paren-mode' and `paren-highlight'." (interactive "P") + ;; kill off the competition, er, uh, eliminate redundancy... + (setq post-command-hook (delq 'show-paren-command-hook post-command-hook)) + (setq pre-command-hook (delq 'blink-paren-pre-command pre-command-hook)) + (setq post-command-hook (delq 'blink-paren-post-command post-command-hook)) + (let* ((paren-modes '(blink-paren paren sexp)) (paren-next-modes (cons nil (append paren-modes (list nil))))) (setq paren-mode (if (and (numberp arg) (< arg 0)) @@ -348,14 +365,15 @@ ;; suppress compiler warning. (defvar highlight-paren-expression)) -(paren-set-mode (if (and (boundp 'highlight-paren-expression) - ;; bletcherous blink-paren no-naming-convention - highlight-paren-expression) - 'sexp - (if (eq 'x (device-type (selected-device))) - 'blink-paren - 'paren)) - t) +;; No no no! +;(paren-set-mode (if (and (boundp 'highlight-paren-expression) +; ;; bletcherous blink-paren no-naming-convention +; highlight-paren-expression) +; 'sexp +; (if (eq 'x (device-type (selected-device))) +; 'blink-paren +; 'paren)) +; t) ;;;###autoload (make-obsolete 'blink-paren 'paren-set-mode)
--- a/lisp/packages/pending-del.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/packages/pending-del.el Mon Aug 13 09:57:07 2007 +0200 @@ -36,13 +36,20 @@ ;;; Code: -(defvar pending-delete-mode nil +(defcustom pending-delete-mode nil "Non-nil when Pending Delete mode is enabled. -In Pending Delete mode, typed text replaces the selected region.") +In Pending Delete mode, typed text replaces the selected region." + :type 'boolean + :set (lambda (symbol value) + (pending-delete-mode (or value 0))) + :initialize 'custom-initialize-default + :require 'pending-del + :group 'keyboard) (defcustom pending-delete-modeline-string " PenDel" "*String to display in the modeline when Pending Delete mode is active." - :type 'string) + :type 'string + :group 'keyboard) (add-minor-mode 'pending-delete-mode 'pending-delete-modeline-string)
--- a/lisp/packages/recent-files.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/packages/recent-files.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,5 +1,5 @@ ;;; recent-files.el --- Maintain menu of recently opened files. -;;; $Header: /afs/informatik.uni-tuebingen.de/local/web/xemacs/xemacs-cvs/XEmacs/xemacs/lisp/packages/Attic/recent-files.el,v 1.2 1997/04/19 23:21:11 steve Exp $ +;;; $Header: /afs/informatik.uni-tuebingen.de/local/web/xemacs/xemacs-cvs/XEmacs/xemacs/lisp/packages/Attic/recent-files.el,v 1.3 1997/09/17 05:19:36 steve Exp $ ;;; ;;; Copyright (C) 1994, 1995 Juergen Nickelsen <nickel@cs.tu-berlin.de> ;;; @@ -208,7 +208,8 @@ (defgroup recent-files nil "Maintain a menu of recently opened files." - :group 'data) + :group 'files + :group 'menu) (defgroup recent-files-menu nil "Menu options of recent-files." @@ -415,7 +416,7 @@ "Return a string identifying the current verion of recent-files. If called interactively, show it in the echo area." (interactive) - (let ((version "$Header: /afs/informatik.uni-tuebingen.de/local/web/xemacs/xemacs-cvs/XEmacs/xemacs/lisp/packages/Attic/recent-files.el,v 1.2 1997/04/19 23:21:11 steve Exp $")) + (let ((version "$Header: /afs/informatik.uni-tuebingen.de/local/web/xemacs/xemacs-cvs/XEmacs/xemacs/lisp/packages/Attic/recent-files.el,v 1.3 1997/09/17 05:19:36 steve Exp $")) (if (interactive-p) (message version) version)))
--- a/lisp/packages/time.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/packages/time.el Mon Aug 13 09:57:07 2007 +0200 @@ -72,10 +72,6 @@ ;;; (suppress-keymap display-time-keymap) ;;; (define-key display-time-keymap 'button1 'balloon-help)) -;; We need the progn to kill off the defgroup-tracking mechanism. -;; This package changes the state of XEmacs by loading it, which is -;; why it's potentially dangerous. -(progn (defgroup display-time nil "Facilities to display the current time/date/load and a new-mail indicator in the XEmacs mode line or echo area." @@ -85,7 +81,7 @@ "Fancy add-ons to display-time for using the `balloon-help' feature. balloon-help must be loaded before these settings take effect." :group 'display-time) -) ;progn + (defcustom display-time-mail-file nil "*File name of mail inbox file, for indicating existence of new mail. @@ -143,6 +139,8 @@ If `display-time-echo-area' is non-nil, the time is displayed in the echo area instead of in the mode-line." (interactive) + (or display-time-insinuated + (display-time-insinuate)) ;; if the "display-time" itimer already exists, nuke it first. (let ((old (get-itimer "display-time"))) (if old (delete-itimer old))) @@ -496,47 +494,50 @@ (redisplay-frame)) )) -(if (featurep 'xpm) - (progn - (defvar display-time-mail-sign - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "letter.xpm")))) - (set-extent-property (car display-time-mail-sign) 'balloon-help - 'display-time-mail-balloon) +(defvar display-time-insinuated nil) + +;; This used to be at top-level! +(defun display-time-insinuate () + (when (featurep 'xpm) + (defvar display-time-mail-sign + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "letter.xpm")))) + (set-extent-property (car display-time-mail-sign) 'balloon-help + 'display-time-mail-balloon) ;;; (set-extent-keymap (car display-time-mail-sign) ;;; display-time-keymap) - (defvar display-time-no-mail-sign - (cons (make-extent nil nil) - (make-glyph (concat display-time-icons-dir "no-letter.xpm")))) - (set-extent-property (car display-time-no-mail-sign) 'balloon-help - display-time-no-mail-balloon) + (defvar display-time-no-mail-sign + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "no-letter.xpm")))) + (set-extent-property (car display-time-no-mail-sign) 'balloon-help + display-time-no-mail-balloon) ;;; (set-extent-keymap (car display-time-no-mail-sign) ;;; display-time-keymap) - (defvar display-time-1-glyph nil) - (defvar display-time-2-glyph nil) - (defvar display-time-3-glyph nil) - (defvar display-time-4-glyph nil) - (defvar display-time-5-glyph nil) - (defvar display-time-6-glyph nil) - (defvar display-time-7-glyph nil) - (defvar display-time-8-glyph nil) - (defvar display-time-9-glyph nil) - (defvar display-time-0-glyph nil) - (defvar display-time-:-glyph nil) - (defvar display-time-am-glyph nil) - (defvar display-time-pm-glyph nil) - (defvar display-time-load-0.0-glyph nil) - (defvar display-time-load-0.5-glyph nil) - (defvar display-time-load-1.0-glyph nil) - (defvar display-time-load-1.5-glyph nil) - (defvar display-time-load-2.0-glyph nil) - (defvar display-time-load-2.5-glyph nil) - (defvar display-time-load-3.0-glyph nil) - (display-time-generate-time-glyphs 'force) - (display-time-generate-load-glyphs 'force) - (display-time-init-glyphs) - (sit-for 0) - )) + (defvar display-time-1-glyph nil) + (defvar display-time-2-glyph nil) + (defvar display-time-3-glyph nil) + (defvar display-time-4-glyph nil) + (defvar display-time-5-glyph nil) + (defvar display-time-6-glyph nil) + (defvar display-time-7-glyph nil) + (defvar display-time-8-glyph nil) + (defvar display-time-9-glyph nil) + (defvar display-time-0-glyph nil) + (defvar display-time-:-glyph nil) + (defvar display-time-am-glyph nil) + (defvar display-time-pm-glyph nil) + (defvar display-time-load-0.0-glyph nil) + (defvar display-time-load-0.5-glyph nil) + (defvar display-time-load-1.0-glyph nil) + (defvar display-time-load-1.5-glyph nil) + (defvar display-time-load-2.0-glyph nil) + (defvar display-time-load-2.5-glyph nil) + (defvar display-time-load-3.0-glyph nil) + (display-time-generate-time-glyphs 'force) + (display-time-generate-load-glyphs 'force) + (display-time-init-glyphs) + (sit-for 0)) + (setq display-time-insinuated t)) (defun display-time-can-do-graphical-display (&optional textual)
--- a/lisp/prim/about.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/prim/about.el Mon Aug 13 09:57:07 2007 +0200 @@ -1024,6 +1024,13 @@ Otherwise, I'm, say, 35.82% professional Jazz guitar player, which means that's not the way I earn my crust, but things may very well reverse in the future ...\n") + (print-short "David hobley" "david.hobley@usa.net" "\ +I used to do real work, but now I am a Project Manager for one of the +Telco's in Australia. In my spare time I like to get back to basics and +muck around with things. As a result I started the NT port. Hopefully I +will get to finish it sometime sooner rather than later. I do vaguely +remember University where it seems like I had more spare time that I can +believe now. Oh well, such is life.\n") "\n\ In addition to those just mentioned, the following people have spent a great deal of effort providing feedback, testing beta versions of
--- a/lisp/prim/auto-autoloads.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/prim/auto-autoloads.el Mon Aug 13 09:57:07 2007 +0200 @@ -42,6 +42,18 @@ ;;;*** +;;;### (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" "\
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/prim/cus-dep.el Mon Aug 13 09:57:07 2007 +0200 @@ -0,0 +1,104 @@ +;;; cus-dep.el --- Find customization dependencies. +;; +;; Copyright (C) 1997 Free Software Foundation, Inc. +;; +;; Author: Per Abrahamsen <abraham@dina.kvl.dk>, then +;; Richar Stallman <rms@gnu.ai.mit.edu>, then +;; Hrvoje Niksic <hniksic@srce.hr> +;; Maintainer: Hrvoje Niksic <hniksic@srce.hr> +;; 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
--- a/lisp/prim/cus-load.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/prim/cus-load.el Mon Aug 13 09:57:07 2007 +0200 @@ -26,18 +26,23 @@ ;;; Commentary: -;; custom loads are no longer in a single file. So, collect the whole set! +;; 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: -(fset 'custom-put 'put) +(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))) -(let ((dir load-path)) - (while dir - (condition-case nil - (load (concat (car dir) "custom-load") nil nil) - (file-error nil)) - (pop dir))) +(mapc (lambda (dir) + (load (expand-file-name "custom-load" dir) t)) + load-path) (provide 'cus-load)
--- a/lisp/prim/custom-load.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/prim/custom-load.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,12 +1,26 @@ -(custom-put 'backup 'custom-loads '("files")) -(custom-put 'find-file 'custom-loads '("files")) -(custom-put 'frames 'custom-loads '("frame" "window-xemacs" "gui")) -(custom-put 'help-appearance 'custom-loads '("help")) -(custom-put 'isearch 'custom-loads '("isearch-mode")) +(custom-put 'mouse 'custom-loads '("mouse")) (custom-put 'minibuffer 'custom-loads '("minibuf")) -(custom-put 'modeline 'custom-loads '("modeline")) -(custom-put 'editing-basics 'custom-loads '("simple" "files" "lisp" "cmdloop")) +(custom-put 'environment 'custom-loads '("frame" "minibuf" "modeline" "sound")) +(custom-put 'sound 'custom-loads '("sound")) +(custom-put 'auto-save 'custom-loads '("files")) +(custom-put 'editing-basics 'custom-loads '("cmdloop" "simple" "files" "lisp")) +(custom-put 'help-appearance 'custom-loads '("help")) +(custom-put 'lisp 'custom-loads '("lisp")) +(custom-put 'help 'custom-loads '("help")) +(custom-put 'keyboard 'custom-loads '("cmdloop")) +(custom-put 'backup 'custom-loads '("files")) +(custom-put 'frames 'custom-loads '("frame" "window-xemacs" "gui")) +(custom-put 'abbrev 'custom-loads '("files")) +(custom-put 'dired 'custom-loads '("files")) (custom-put 'killing 'custom-loads '("simple")) +(custom-put 'paren-blinking 'custom-loads '("simple")) +(custom-put 'find-file 'custom-loads '("files")) +(custom-put 'files 'custom-loads '("files")) (custom-put 'fill-comments 'custom-loads '("simple")) -(custom-put 'paren-matching 'custom-loads '()) -(custom-put 'sound 'custom-loads '("sound")) +(custom-put 'windows 'custom-loads '("window" "window-xemacs")) +(custom-put 'fill 'custom-loads '("simple")) +(custom-put 'vc 'custom-loads '("files")) +(custom-put 'isearch 'custom-loads '("isearch-mode")) +(custom-put 'modeline 'custom-loads '("modeline")) +(custom-put 'editing 'custom-loads '("simple")) +(custom-put 'matching 'custom-loads '("simple" "isearch-mode"))
--- a/lisp/prim/dumped-lisp.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/prim/dumped-lisp.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,4 +1,4 @@ -(setq dumped-lisp-packages +(setq preloaded-file-list '("backquote" ; needed for defsubst etc. "bytecomp-runtime" ; define defsubst "packages" ; Bootstrap run-time lisp environment @@ -6,8 +6,8 @@ "replace" ; match-string used in version.el. "version.el" ; Ignore compiled-by-mistake version.elc "cl" - ;; "cl-extra" ; These cause lossage at dump - ;; "cl-seq" ; Fix it first, if you want these dumped + "cl-extra" + "cl-seq" ;;"featurep" "widget" "custom" ; Before the world so everything can be
--- a/lisp/prim/files.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/prim/files.el Mon Aug 13 09:57:07 2007 +0200 @@ -635,7 +635,8 @@ (frame (make-frame (if name (list (cons 'name (symbol-name name))))))) (pop-to-buffer buffer t frame) - (select-frame frame) + (unless focus-follows-mouse + (select-frame frame)) (make-frame-visible frame) buffer))
--- a/lisp/prim/loadup.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/prim/loadup.el Mon Aug 13 09:57:07 2007 +0200 @@ -39,7 +39,9 @@ (define-function 'defalias 'define-function) (defvar running-xemacs t - "non-nil when the current emacsen is XEmacs.") + "Non-nil when the current emacsen is XEmacs.") +(defvar preloaded-file-list nil + "List of files preloaded into the XEmacs binary image.") (call-with-condition-handler ;; This is awfully damn early to be getting an error, right? @@ -96,8 +98,9 @@ ;; (load-gc "version.el") ; Ignore compiled-by-mistake version.elc ;; (load-gc "cl") ;; (load-gc "featurep") ; OBSOLETE now - (let (dumped-lisp-packages file) - (load "dumped-lisp.el") + (load "dumped-lisp.el") + (let ((dumped-lisp-packages preloaded-file-list) + file) (while (setq file (car dumped-lisp-packages)) (load-gc file) (setq dumped-lisp-packages (cdr dumped-lisp-packages))) @@ -110,6 +113,10 @@ )) ;; end of call-with-condition-handler +;; Fix up the preloaded file list +(setq preloaded-file-list (mapcar #'file-name-sans-extension + preloaded-file-list)) + (setq load-warn-when-source-newer t ; set to t at top of file load-warn-when-source-only nil)
--- a/lisp/prim/make-docfile.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/prim/make-docfile.el Mon Aug 13 09:57:07 2007 +0200 @@ -100,12 +100,12 @@ ;; (load "featurep") -(let (dumped-lisp-packages) +(let (preloaded-file-list) (load (concat default-directory "../lisp/prim/dumped-lisp.el")) - (setq dumped-lisp-packages - (append dumped-lisp-packages packages-hardcoded-lisp)) - (while dumped-lisp-packages - (let ((arg0 (packages-add-suffix (car dumped-lisp-packages))) + (setq preloaded-file-list + (append preloaded-file-list packages-hardcoded-lisp)) + (while preloaded-file-list + (let ((arg0 (packages-add-suffix (car preloaded-file-list))) arg) (setq arg (locate-library arg0)) (if (null arg) @@ -116,7 +116,7 @@ (file-newer-than-file-p arg docfile)) (setq docfile-out-of-date t)) (setq processed (cons arg processed))))) - (setq dumped-lisp-packages (cdr dumped-lisp-packages))))) + (setq preloaded-file-list (cdr preloaded-file-list))))) ;; Finally process the list of site-loaded files. (if site-file-list
--- a/lisp/prim/obsolete.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/prim/obsolete.el Mon Aug 13 09:57:07 2007 +0200 @@ -624,4 +624,74 @@ (make-obsolete 'following-char 'char-after) (make-obsolete 'preceding-char 'char-before) + +;; The following several functions are useful in GNU Emacs 20 because +;; of the multibyte "characters" the internal representation of which +;; leaks into Lisp. In XEmacs/Mule they are trivial and unnecessary. +;; We provide them for compatibility reasons solely. + +(defun string-to-sequence (string type) + "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'")))) + +(defun string-to-list (string) + "Return a list of characters in STRING." + (mapcar #'identity string)) + +(defun string-to-vector (string) + "Return a vector of characters in STRING." + (mapvector #'identity string)) + +(defun store-substring (string idx obj) + "Embed OBJ (string or character) at index IDX of STRING." + (let* ((str (cond ((stringp obj) obj) + ((characterp obj) (char-to-string obj)) + (t (error + "Invalid argument (should be string or character): %s" + obj)))) + (string-len (length string)) + (len (length str)) + (i 0)) + (while (and (< i len) (< idx string-len)) + (aset string idx (aref str i)) + (setq idx (1+ idx) i (1+ i))) + string)) + +;; ### This function is not compatible with FSF in some cases. Hard +;; to fix, because it is hard to trace the logic of the FSF function. +;; In case we need the exact behaviour, we can always copy the FSF +;; version, which is very long and does lots of unnecessary stuff. +(defun truncate-string-to-width (str end-column &optional start-column padding) + "Truncate string STR to end at column END-COLUMN. +The optional 2nd arg START-COLUMN, if non-nil, specifies +the starting column; that means to return the characters occupying +columns START-COLUMN ... END-COLUMN of STR. + +The optional 3rd arg PADDING, if non-nil, specifies a padding character +to add at the end of the result if STR doesn't reach column END-COLUMN, +or if END-COLUMN comes in the middle of a character in STR. +PADDING is also added at the beginning of the result +if column START-COLUMN appears in the middle of a character in STR. + +If PADDING is nil, no padding is added in these cases, so +the resulting string may be narrower than END-COLUMN." + (or start-column + (setq start-column 0)) + (let ((len (length str))) + (concat (substring str (min start-column len) (min end-column len)) + (and padding (> end-column len) + (make-string (- end-column len) padding))))) + +(defalias 'truncate-string 'truncate-string-to-width) +(make-obsolete 'truncate-string 'truncate-string-to-width) + + + ;;; obsolete.el ends here
--- a/lisp/prim/packages.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/prim/packages.el Mon Aug 13 09:57:07 2007 +0200 @@ -78,8 +78,10 @@ ;; `(function (lambda ,@cdr))) (list 'function (cons 'lambda cdr))) + ;; Copied from help.el, could possibly move it to here permanently. -;; This is taken directly from Emacs 19.34.94. +;; Unlike the FSF version, our `locate-library' uses the `locate-file' +;; primitive, which should make it lightning-fast. (defun locate-library (library &optional nosuffix path interactive-call) "Show the precise file name of Emacs library LIBRARY. @@ -93,40 +95,33 @@ (interactive (list (read-string "Locate library: ") nil nil t)) - (let (result) - (catch 'answer - (mapcar - (lambda (dir) - (mapcar - (lambda (suf) - (let ((try (expand-file-name (concat library suf) dir))) - (and (file-readable-p try) - (null (file-directory-p try)) - (progn - (setq result try) - (throw 'answer try))))) - (if nosuffix - '("") - (let ((basic '(".elc" ".el" "")) - (compressed '(".Z" ".gz" ""))) - ;; If autocompression mode is on, - ;; consider all combinations of library suffixes - ;; and compression suffixes. - (if (or (rassq 'jka-compr-handler file-name-handler-alist) - (and (boundp 'find-file-hooks) - (member 'crypt-find-file-hook find-file-hooks))) - (apply 'nconc - (mapcar (lambda (compelt) - (mapcar (lambda (baselt) - (concat baselt compelt)) - basic)) - compressed)) - basic))))) - (or path load-path))) + (let ((result + (locate-file + library + (or path load-path) + (if nosuffix + "" + (if (or (rassq 'jka-compr-handler file-name-handler-alist) + (and (boundp 'find-file-hooks) + (member 'crypt-find-file-hook find-file-hooks))) + ".elc:.el:" + ;; The complex expression evaluates to a relatively + ;; short string, so we do it at compile-time. + ;; Nope. This is run out of temacs and `eval-when-compile' is + ;; a void function. --sb + (mapconcat #'identity + (apply 'nconc + (mapcar (lambda (compelt) + (mapcar (lambda (baselt) + (concat baselt compelt)) + '(".elc" ".el" ""))) + '(".Z" ".gz" ""))) + ":"))) + 4))) (and interactive-call - (if result - (message "Library is file %s" result) - (message "No library %s in search path" library))) + (if result + (message "Library is file %s" result) + (message "No library %s in search path" library))) result)) (defun packages-add-suffix (str) @@ -221,16 +216,18 @@ ;; Data-directory is really a list now. Provide something to search it for ;; directories. -(defun locate-data-directory (name &optional data-dir-list) - "Locate a directory in a search path." - (unless data-dir-list - (setq data-dir-list data-directory-list)) - (let (dir found found-dir (dirs data-dir-list)) - (while (and (null found-dir) dirs) - (setq dir (car dirs)) - (setq found (concat dir name "/")) - (setq found-dir (file-directory-p found)) - (setq dirs (cdr dirs))) +(defun locate-data-directory (name &optional dir-list) + "Locate a directory in a search path DIR-LIST (a list of directories). +If no DIR-LIST is supplied, it defaults to `data-directory-list'." + (unless dir-list + (setq dir-list data-directory-list)) + (let (found found-dir) + (while (and (null found-dir) dir-list) + (setq found (concat (car dir-list) name "/") + found-dir (file-directory-p found)) + (or found-dir + (setq found nil)) + (setq dir-list (cdr dir-list))) found)) ;; If we are being loaded as part of being dumped, bootstrap the rest of the
--- a/lisp/prim/simple.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/prim/simple.el Mon Aug 13 09:57:07 2007 +0200 @@ -3469,8 +3469,13 @@ (clear-message label frame stdout-p t) (append-message label message frame stdout-p)) +(defun current-message (&optional frame) + "Returns the current message in the echo area, or nil. +The FRAME argument is currently unused." + (cdr (car message-stack))) + ;;; may eventually be frame-dependent -(defun current-message-label (frame) +(defun current-message-label (&optional frame) (if message-stack (car (car message-stack)) nil))
--- a/lisp/prim/subr.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/prim/subr.el Mon Aug 13 09:57:07 2007 +0200 @@ -598,60 +598,6 @@ (eval-after-load file (read))) (make-compatible 'eval-next-after-load "") -(defun string-to-sequence (string type) - "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'")))) - -(defun string-to-list (string) - "Return a list of characters in STRING." - (mapcar #'identity string)) - -(defun string-to-vector (string) - "Return a vector of characters in STRING." - (mapvector #'identity string)) - -(defun store-substring (string idx obj) - "Embed OBJ (string or character) at index IDX of STRING." - (let* ((str (cond ((stringp obj) obj) - ((characterp obj) (char-to-string obj)) - (t (error - "Invalid argument (should be string or character): %s" - obj)))) - (string-len (length string)) - (len (length str)) - (i 0)) - (while (and (< i len) (< idx string-len)) - (aset string idx (aref str i)) - (setq idx (1+ idx) i (1+ i))) - string)) - -;;; ### Check compatibility with FSF -;; The FSF version of this function does complex things to make each -;; multibyte character behave as one "column". We don't need any of -;; it. -(defun truncate-string-to-width (str width &optional start-column padding) - "Truncate string STR to fit in WIDTH columns. -Optional 1st arg START-COLUMN if non-nil specifies the starting column. -Optional 2nd arg PADDING if non-nil is a padding character to be padded at -the head and tail of the resulting string to fit in WIDTH if necessary. -If PADDING is nil, the resulting string may be narrower than WIDTH." - (or start-column - (setq start-column 0)) - (if (< (+ start-column width) (length str)) - (substring str start-column (+ start-column width)) - (concat (substring str start-column) - (if padding - (make-string (- width (length str) start-column) padding))))) -(defalias 'truncate-string 'truncate-string-to-width) -(make-obsolete 'truncate-string 'truncate-string-to-width) - ; alternate names (not obsolete) (if (not (fboundp 'mod)) (define-function 'mod '%)) (define-function 'move-marker 'set-marker)
--- a/lisp/prim/update-elc.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/prim/update-elc.el Mon Aug 13 09:57:07 2007 +0200 @@ -91,17 +91,17 @@ ;; (print (prin1-to-string update-elc-files-to-compile)) -(let (dumped-lisp-packages site-load-packages) +(let (preloaded-file-list site-load-packages) (load (concat default-directory "../lisp/prim/dumped-lisp.el")) - ;; (print (prin1-to-string dumped-lisp-packages)) + ;; (print (prin1-to-string preloaded-file-list)) (load (concat default-directory "../site-packages") t t) - (setq dumped-lisp-packages + (setq preloaded-file-list (append packages-hardcoded-lisp - dumped-lisp-packages + preloaded-file-list packages-useful-lisp site-load-packages)) - (while dumped-lisp-packages - (let ((arg (car dumped-lisp-packages))) + (while preloaded-file-list + (let ((arg (car preloaded-file-list))) ;; (print (prin1-to-string arg)) (if (null (member arg packages-unbytecompiled-lisp)) (progn @@ -109,7 +109,7 @@ (if (null arg) (progn (print (format "Library file %s: not found" - (car dumped-lisp-packages))) + (car preloaded-file-list))) (kill-emacs))) (if (string-match "\\.elc?\\'" arg) (setq arg (substring arg 0 (match-beginning 0)))) @@ -118,7 +118,7 @@ (file-newer-than-file-p (concat arg ".el") (concat arg ".elc"))) (setq processed (cons (concat arg ".el") processed))))) - (setq dumped-lisp-packages (cdr dumped-lisp-packages))))) + (setq preloaded-file-list (cdr preloaded-file-list))))) (setq update-elc-files-to-compile (append update-elc-files-to-compile processed))
--- a/lisp/psgml/custom-load.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/psgml/custom-load.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,7 +1,8 @@ -(custom-put 'tempo 'custom-loads '("tempo")) +(custom-put 'extensions 'custom-loads '("tempo")) (custom-put 'psgml-dtd 'custom-loads '("psgml")) -(custom-put 'psgml-insert 'custom-loads '("psgml")) +(custom-put 'html 'custom-loads '("psgml-html")) (custom-put 'psgml 'custom-loads '("psgml-html" "psgml")) (custom-put 'sgml 'custom-loads '("psgml-html" "psgml")) -(custom-put 'psgml-html 'custom-loads '("psgml-html")) -(custom-put 'html 'custom-loads '("psgml-html")) +(custom-put 'tempo 'custom-loads '("tempo")) +(custom-put 'languages 'custom-loads '("psgml")) +(custom-put 'psgml-insert 'custom-loads '("psgml"))
--- a/lisp/sunpro/sunpro-init.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/sunpro/sunpro-init.el Mon Aug 13 09:57:07 2007 +0200 @@ -158,7 +158,14 @@ (file-exists-p (concat sunpro-dir "bin/sparcworks")) (setq exec-path (append exec-path (list (concat sunpro-dir "bin/")))))) - (and (fboundp 'eos::start)) (eos::start)) + (load "sun-eos-init") + (load "sun-eos-common") + (load "sun-eos-editor") + (load "sun-eos-browser") + (load "sun-eos-debugger") + (load "sun-eos-debugger-extra") + (load "sun-eos-menubar") + (eos::start)) (t ; Neither? Complain... (display-warning
--- a/lisp/utils/auto-autoloads.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/utils/auto-autoloads.el Mon Aug 13 09:57:07 2007 +0200 @@ -275,13 +275,11 @@ Read the region as a keyboard macro definition. The region is interpreted as spelled-out keystrokes, e.g., \"M-x abc RET\". See documentation for `edmacro-mode' for details. -Leading/trailing \"C-x (\" and \"C-x )\" in the text are allowed and ignored. The resulting macro is installed as the \"current\" keyboard macro. In Lisp, may also be called with a single STRING argument in which case the result is returned rather than being installed as the current macro. -The result will be a string if possible, otherwise an event vector. -Second argument NEED-VECTOR means to return an event vector always." t nil) +The result will be a vector of keystrokes." t nil) (autoload 'kbd "edmacro" "\ Convert KEYS to the internal Emacs key representation." nil 'macro) @@ -290,8 +288,7 @@ Return the keyboard macro MACRO as a human-readable string. This string is suitable for passing to `read-kbd-macro'. Second argument VERBOSE means to put one command per line with comments. -If VERBOSE is `1', put everything on one line. If VERBOSE is omitted -or nil, use a compact 80-column format." nil nil) +If VERBOSE is nil, put everything on one line." nil nil) ;;;*** @@ -801,6 +798,28 @@ ;;;*** +;;;### (autoloads (regexp-opt-depth regexp-opt) "regexp-opt" "utils/regexp-opt.el") + +(autoload 'regexp-opt "regexp-opt" "\ +Return a regexp to match a string in STRINGS. +Each string should be unique in STRINGS and should not contain any regexps, +quoted or not. If optional PAREN is non-nil, ensure that the returned regexp +is enclosed by at least one regexp grouping construct. +The returned regexp is typically more efficient than the equivalent regexp: + + (let ((open-paren (if PAREN \"\\\\(\" \"\")) (close-paren (if PAREN \"\\\\)\" \"\"))) + (concat open-paren (mapconcat 'regexp-quote STRINGS \"\\\\|\") close-paren)) + +but typically contains more regexp grouping constructs. +Use `regexp-opt-depth' to count them." nil nil) + +(autoload 'regexp-opt-depth "regexp-opt" "\ +Return the depth of REGEXP. +This means the number of regexp grouping constructs (parenthesised expressions) +in REGEXP." nil nil) + +;;;*** + ;;;### (autoloads (reporter-submit-bug-report) "reporter" "utils/reporter.el") (autoload 'reporter-submit-bug-report "reporter" nil nil nil)
--- a/lisp/utils/autoload.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/utils/autoload.el Mon Aug 13 09:57:07 2007 +0200 @@ -359,7 +359,7 @@ data-directory) "*File `update-file-autoloads' puts customization into.") -(defvar customized-symbols nil) +(defvar customized-symbols (make-hash-table :test 'eq)) ;; Written by Per Abrahamsen (defun autoload-snarf-defcustom (file) @@ -371,16 +371,16 @@ (string-match "\\`\\(.*\\)\\.el\\'" file) (not (buffer-modified-p))) (goto-char (point-min)) - (condition-case nil - (let ((name (file-name-nondirectory (match-string 1 file)))) - (while t + (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)))) - (when (and (listp expr) - (memq (car expr) '(defcustom defface defgroup))) - (eval expr) - (put (nth 1 expr) 'custom-where name) - (pushnew (nth 1 expr) customized-symbols))))) - (error nil))) + (eval expr) + (setf (gethash (nth 1 expr) customized-symbols) name))) + (error nil)))) (unless (buffer-modified-p) (kill-buffer (current-buffer)))))) @@ -527,38 +527,26 @@ (erase-buffer) (insert (with-output-to-string - (mapcar (lambda (symbol) - (let ((members (condition-case nil - (get symbol 'custom-group) - (t (progn - (message "Bad plist in %s" - (symbol-name symbol))) - nil))) - item where - (found (condition-case nil - (get symbol 'custom-loads) - (t nil))) - ) - (when (or members found) - (princ "(custom-put '") - (princ symbol) - (princ " 'custom-loads '(") - (when found - ;; (message "found = `%s'" found) - (insert (mapconcat 'prin1-to-string found " "))) - (while members - (setq item (car (car members)) - members (cdr members) - where (get item 'custom-where)) - (unless (or (null where) - (member where found)) - ;; (message "where = `%s', found = `%s'" where found) - (when found - (princ " ")) - (prin1 where) - (push where found))) - (princ "))\n")))) - customized-symbols))) + (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)))) @@ -579,7 +567,7 @@ (flet ((custom-put (symbol property value) (progn (put symbol property value) - (pushnew symbol customized-symbols)))) + (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) @@ -634,16 +622,17 @@ ;; (message "Loading %s = %s" ;; (symbol-name symbol) ;; (prin1-to-string value)) - (pushnew symbol customized-symbols)))) + (setf (gethash symbol customized-symbols) + value)))) (load generated-custom-file nil t))) (cond ((file-directory-p arg) - (message "Updating autoloads in directory %s..." arg) + (message "Updating autoloads/custom 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) - (setq customized-symbols nil)) + (clrhash customized-symbols)) (fixup-autoload-buffer (concat (if autoload-package-name autoload-package-name (file-name-nondirectory arg))
--- a/lisp/utils/custom-load.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/utils/custom-load.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,13 +1,26 @@ -(custom-put 'highlight-headers-faces 'custom-loads '("highlight-headers")) -(custom-put 'crontab 'custom-loads '("crontab")) -(custom-put 'browse-url 'custom-loads '("browse-url")) -(custom-put 'detached-minibuf 'custom-loads '("detached-minibuf")) -(custom-put 'edmacro 'custom-loads '("edmacro")) +(custom-put 'extensions 'custom-loads '("eldoc")) (custom-put 'eldoc 'custom-loads '("eldoc")) +(custom-put 'minibuffer 'custom-loads '("detached-minibuf" "savehist")) +(custom-put 'mail 'custom-loads '("highlight-headers" "ph" "smtpmail")) +(custom-put 'uniquify 'custom-loads '("uniquify")) +(custom-put 'hypermedia 'custom-loads '("browse-url")) +(custom-put 'lisp 'custom-loads '("elp")) (custom-put 'elp 'custom-loads '("elp")) +(custom-put 'applications 'custom-loads '("uniquify")) +(custom-put 'keyboard 'custom-loads '("edmacro")) +(custom-put 'crontab 'custom-loads '("crontab")) +(custom-put 'comm 'custom-loads '("ph")) +(custom-put 'id-select 'custom-loads '("id-select")) +(custom-put 'frames 'custom-loads '("detached-minibuf")) +(custom-put 'smtpmail 'custom-loads '("smtpmail")) +(custom-put 'detached-minibuf 'custom-loads '("detached-minibuf")) +(custom-put 'languages 'custom-loads '("crontab")) +(custom-put 'edmacro 'custom-loads '("edmacro")) +(custom-put 'faces 'custom-loads '("highlight-headers")) +(custom-put 'passwd 'custom-loads '("passwd")) +(custom-put 'browse-url 'custom-loads '("browse-url")) +(custom-put 'processes 'custom-loads '("passwd")) +(custom-put 'news 'custom-loads '("highlight-headers")) (custom-put 'highlight-headers 'custom-loads '("highlight-headers")) -(custom-put 'passwd 'custom-loads '("passwd")) +(custom-put 'savehist 'custom-loads '("savehist")) (custom-put 'ph 'custom-loads '("ph")) -(custom-put 'savehist 'custom-loads '("savehist")) -(custom-put 'smtpmail 'custom-loads '("smtpmail")) -(custom-put 'uniquify 'custom-loads '("uniquify"))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/utils/regexp-opt.el Mon Aug 13 09:57:07 2007 +0200 @@ -0,0 +1,242 @@ +;;; regexp-opt.el --- generate efficient regexps to match strings. + +;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. + +;; Author: Simon Marshall <simon@gnu.ai.mit.edu> +;; Keywords: strings, regexps + +;; 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: + +;; The "opt" in "regexp-opt" stands for "optim\\(al\\|i\\(se\\|ze\\)\\)". +;; +;; This package generates a regexp from a given list of strings (which matches +;; one of those strings) so that the regexp generated by: +;; +;; (regexp-opt strings) +;; +;; is equivalent to, but more efficient than, the regexp generated by: +;; +;; (mapconcat 'regexp-quote strings "\\|") +;; +;; For example: +;; +;; (let ((strings '("cond" "if" "when" "unless" "while" +;; "let" "let*" "progn" "prog1" "prog2" +;; "save-restriction" "save-excursion" "save-window-excursion" +;; "save-current-buffer" "save-match-data" +;; "catch" "throw" "unwind-protect" "condition-case"))) +;; (concat "(" (regexp-opt strings t) "\\>")) +;; => "(\\(c\\(atch\\|ond\\(ition-case\\)?\\)\\|if\\|let\\*?\\|prog[12n]\\|save-\\(current-buffer\\|excursion\\|match-data\\|restriction\\|window-excursion\\)\\|throw\\|un\\(less\\|wind-protect\\)\\|wh\\(en\\|ile\\)\\)\\>" +;; +;; Searching using the above example `regexp-opt' regexp takes approximately +;; two-thirds of the time taken using the equivalent `mapconcat' regexp. + +;; Since this package was written to produce efficient regexps, not regexps +;; efficiently, it is probably not a good idea to in-line too many calls in +;; your code, unless you use the following trick with `eval-when-compile': +;; +;; (defvar definition-regexp +;; (eval-when-compile +;; (concat "^(" +;; (regexp-opt '("defun" "defsubst" "defmacro" "defalias" +;; "defvar" "defconst") t) +;; "\\>"))) +;; +;; The `byte-compile' code will be as if you had defined the variable thus: +;; +;; (defvar definition-regexp +;; "^(\\(def\\(alias\\|const\\|macro\\|subst\\|un\\|var\\)\\)\\>") +;; +;; Note that if you use this trick for all instances of `regexp-opt' and +;; `regexp-opt-depth' in your code, regexp-opt.el would only have to be loaded +;; at compile time. But note also that using this trick means that should +;; regexp-opt.el be changed, perhaps to fix a bug or to add a feature to +;; improve the efficiency of `regexp-opt' regexps, you would have to recompile +;; your code for such changes to have effect in your code. + +;; Originally written for font-lock.el, from an idea from Stig's hl319.el, with +;; thanks for ideas also to Michael Ernst, Bob Glickstein and Dan Nicolaescu. +;; Please don't tell me that it doesn't produce optimal regexps; I know that +;; already. For example, the above explanation for the meaning of "opt" would +;; be more efficient as "optim\\(al\\|i[sz]e\\)", but this requires complex +;; forward looking. But (ideas or) code to improve things (are) is welcome. + +;;; Code: + +;;;###autoload +(defun regexp-opt (strings &optional paren) + "Return a regexp to match a string in STRINGS. +Each string should be unique in STRINGS and should not contain any regexps, +quoted or not. If optional PAREN is non-nil, ensure that the returned regexp +is enclosed by at least one regexp grouping construct. +The returned regexp is typically more efficient than the equivalent regexp: + + (let ((open-paren (if PAREN \"\\\\(\" \"\")) (close-paren (if PAREN \"\\\\)\" \"\"))) + (concat open-paren (mapconcat 'regexp-quote STRINGS \"\\\\|\") close-paren)) + +but typically contains more regexp grouping constructs. +Use `regexp-opt-depth' to count them." + (save-match-data + ;; Recurse on the sorted list. + (let ((max-lisp-eval-depth (* 1024 1024)) + (completion-ignore-case nil)) + (regexp-opt-group (sort (copy-sequence strings) 'string-lessp) paren)))) + +;;;###autoload +(defun regexp-opt-depth (regexp) + "Return the depth of REGEXP. +This means the number of regexp grouping constructs (parenthesised expressions) +in REGEXP." + (save-match-data + ;; Hack to signal an error if REGEXP does not have balanced parentheses. + (string-match regexp "") + ;; Count the number of open parentheses in REGEXP. + (let ((count 0) start) + (while (string-match "\\\\(" regexp start) + (setq count (1+ count) start (match-end 0))) + count))) + +;;; Workhorse functions. + +(eval-when-compile + (require 'cl)) + +(unless (fboundp 'make-bool-vector) + (defalias 'make-bool-vector 'make-vector)) + +(defun regexp-opt-group (strings &optional paren lax) + ;; + ;; Return a regexp to match a string in STRINGS. + ;; If PAREN non-nil, output regexp parentheses around returned regexp. + ;; If LAX non-nil, don't output parentheses if it doesn't require them. + ;; Merges keywords to avoid backtracking in Emacs' regexp matcher. + ;; + ;; The basic idea is to find the shortest common prefix, remove it and + ;; recurse. If there is no prefix, we divide the list into two so that (at + ;; least) one half will have at least a one-character common prefix. + ;; + ;; Also we delay the addition of grouping parenthesis as long as possible + ;; until we're sure we need them, and try to remove one-character sequences + ;; so we can use character sets rather than grouping parenthesis. + ;; + (let* ((open-group (if paren "\\(" "")) + (close-group (if paren "\\)" "")) + (open-charset (if lax "" open-group)) + (close-charset (if lax "" close-group))) + (cond + ;; + ;; If there is only one string, just return it. + ((= (length strings) 1) + (if (= (length (car strings)) 1) + (concat open-charset (regexp-quote (car strings)) close-charset) + (concat open-group (regexp-quote (car strings)) close-group))) + ;; + ;; If there is an empty string, remove it and recurse on the rest. + ((= (length (car strings)) 0) + (concat open-charset + (regexp-opt-group (cdr strings) t t) "?" + close-charset)) + ;; + ;; If all are one-character strings, just return a character set. + ((= (length strings) (apply '+ (mapcar 'length strings))) + (concat open-charset + (regexp-opt-charset strings) + close-charset)) + ;; + ;; We have a list of different length strings. + (t + (let ((prefix (try-completion "" (mapcar 'list strings))) + (letters (let ((completion-regexp-list '("^.$"))) + (all-completions "" (mapcar 'list strings))))) + (cond + ;; + ;; If there is a common prefix, remove it and recurse on the suffixes. + ((> (length prefix) 0) + (let* ((length (length prefix)) + (suffixes (mapcar (lambda (s) (substring s length)) strings))) + (concat open-group + (regexp-quote prefix) (regexp-opt-group suffixes t t) + close-group))) + ;; + ;; If there are several one-character strings, remove them and recurse + ;; on the rest (first so the final regexp finds the longest match). + ((> (length letters) 1) + (let ((rest (let ((completion-regexp-list '("^..+$"))) + (all-completions "" (mapcar 'list strings))))) + (concat open-group + (regexp-opt-group rest) "\\|" (regexp-opt-charset letters) + close-group))) + ;; + ;; Otherwise, divide the list into those that start with a particular + ;; letter and those that do not, and recurse on them. + (t + (let* ((char (substring (car strings) 0 1)) + (half1 (all-completions char (mapcar 'list strings))) + (half2 (nthcdr (length half1) strings))) + (concat open-group + (regexp-opt-group half1) "\\|" (regexp-opt-group half2) + close-group))))))))) + +(defun regexp-opt-charset (chars) + ;; + ;; Return a regexp to match a character in CHARS. + ;; + ;; The basic idea is to find character ranges. Also we take care in the + ;; position of character set meta characters in the character set regexp. + ;; + (let* ((charwidth 256) ; Yeah, right. + ;; XEmacs: use bit-vectors instead of bool-vectors + (charmap (make-bit-vector charwidth 0)) + (charset "") + (bracket "") (dash "") (caret "")) + ;; + ;; Make a character map but extract character set meta characters. + (dolist (char (mapcar 'string-to-char chars)) + (case char + (?\] + (setq bracket "]")) + (?^ + (setq caret "^")) + (?- + (setq dash "-")) + (otherwise + ;; XEmacs: 1 + (aset charmap char 1)))) + ;; + ;; Make a character set from the map using ranges where applicable. + (dotimes (char charwidth) + (let ((start char)) + (while (and (< char charwidth) + ;; XEmacs: (not (zerop ...)) + (not (zerop (aref charmap char)))) + (incf char)) + (cond ((> char (+ start 3)) + (setq charset (format "%s%c-%c" charset start (1- char)))) + ((> char start) + (setq charset (format "%s%c" charset (setq char start))))))) + ;; + ;; Make sure a caret is not first and a dash is first or last. + (if (and (string-equal charset "") (string-equal bracket "")) + (concat "[" dash caret "]") + (concat "[" bracket charset caret dash "]")))) + +(provide 'regexp-opt) + +;;; regexp-opt.el ends here
--- a/lisp/utils/uniquify.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/utils/uniquify.el Mon Aug 13 09:57:07 2007 +0200 @@ -83,14 +83,12 @@ ;;; User-visible variables -(progn - (defgroup uniquify nil - "Unique buffer names dependent on file name" - :group 'applications) - ) +(defgroup uniquify nil + "Unique buffer names dependent on file name" + :group 'applications) -(defcustom uniquify-buffer-name-style 'post-forward +(defcustom uniquify-buffer-name-style nil "*If non-nil, buffer names are uniquified with parts of directory name. The value determines the buffer name style and is one of `forward', `reverse', `post-forward' (the default), or `post-forward-angle-brackets'. @@ -106,6 +104,7 @@ (const post-forward) (const podt-forward-angle-brackets) (const nil)) + :require 'uniquify :group 'uniquify) (defcustom uniquify-after-kill-buffer-p nil @@ -360,149 +359,68 @@ ;;; Hooks from the rest of Emacs -(cond - ((string-match "^\\(19\\|20\\)" emacs-version) - ;; Emacs 19 (Emacs or XEmacs) - - ;; The logical place to put all this code is in generate-new-buffer-name. - ;; It's written in C, so we would add a generate-new-buffer-name-function - ;; which, if non-nil, would be called instead of the C. One problem with - ;; that is that generate-new-buffer-name takes a potential buffer name as - ;; its argument -- not other information, such as what file the buffer will - ;; visit. - - ;; The below solution works because generate-new-buffer-name is called - ;; only by rename-buffer (which, as of 19.29, is never called from C) and - ;; generate-new-buffer, which is called only by Lisp functions - ;; create-file-buffer and rename-uniquely. Rename-uniquely generally - ;; isn't used for buffers visiting files, so it's sufficient to hook - ;; rename-buffer and create-file-buffer. (Setting find-file-hooks isn't - ;; sufficient.) - - (defadvice rename-buffer (after rename-buffer-uniquify activate) - "Uniquify buffer names with parts of directory name." - (if (and uniquify-buffer-name-style - ;; UNIQUE argument - (ad-get-arg 1)) - (progn - (if uniquify-after-kill-buffer-p - ;; call with no argument; rationalize vs. old name as well as new - (uniquify-rationalize-file-buffer-names) - ;; call with argument: rationalize vs. new name only - (uniquify-rationalize-file-buffer-names - (uniquify-buffer-file-name (current-buffer)) (current-buffer))) - (setq ad-return-value (buffer-name (current-buffer)))))) +;; The logical place to put all this code is in generate-new-buffer-name. +;; It's written in C, so we would add a generate-new-buffer-name-function +;; which, if non-nil, would be called instead of the C. One problem with +;; that is that generate-new-buffer-name takes a potential buffer name as +;; its argument -- not other information, such as what file the buffer will +;; visit. - (defadvice create-file-buffer (after create-file-buffer-uniquify activate) - "Uniquify buffer names with parts of directory name." - (if uniquify-buffer-name-style - (uniquify-rationalize-file-buffer-names (ad-get-arg 0) ad-return-value))) - - ;; Buffer deletion - ;; Rerationalize after a buffer is killed, to reduce coinciding buffer names. - ;; This mechanism uses `kill-buffer-hook', which runs *before* deletion. - ;; That means that the kill-buffer-hook function cannot just delete the - ;; buffer -- it has to set something to do the rationalization *later*. - ;; It actually puts another function on `post-command-hook'. This other - ;; function runs the rationalization and then removes itself from the hook. - ;; Is there a better way to accomplish this? - ;; (This ought to set some global variables so the work is done only for - ;; buffers with names similar to the deleted buffer. -MDE) +;; The below solution works because generate-new-buffer-name is called +;; only by rename-buffer (which, as of 19.29, is never called from C) and +;; generate-new-buffer, which is called only by Lisp functions +;; create-file-buffer and rename-uniquely. Rename-uniquely generally +;; isn't used for buffers visiting files, so it's sufficient to hook +;; rename-buffer and create-file-buffer. (Setting find-file-hooks isn't +;; sufficient.) - (cond - ((or (not (string-lessp emacs-version "19.28")) - (and (string-match "XEmacs" emacs-version) - (not (string-lessp emacs-version "19.12")))) - ;; Emacs 19.28 or later, or XEmacs (19.12 or later; is that necessary?) - (defun delay-uniquify-rationalize-file-buffer-names () - "Add `delayed-uniquify-rationalize-file-buffer-names' to `post-command-hook'. -For use on, eg, `kill-buffer-hook', to rationalize *after* buffer deletion." - (if (and uniquify-buffer-name-style - uniquify-after-kill-buffer-p) - (add-hook 'post-command-hook - 'delayed-uniquify-rationalize-file-buffer-names))) - (defun delayed-uniquify-rationalize-file-buffer-names () - "Rerationalize buffer names and remove self from `post-command-hook'. -See also `delay-rationalize-file-buffer-names' for hook setter." - (uniquify-rationalize-file-buffer-names) - (remove-hook 'post-command-hook - 'delayed-uniquify-rationalize-file-buffer-names)) +(defadvice rename-buffer (after rename-buffer-uniquify activate) + "Uniquify buffer names with parts of directory name." + (if (and uniquify-buffer-name-style + ;; UNIQUE argument + (ad-get-arg 1)) + (progn + (if uniquify-after-kill-buffer-p + ;; call with no argument; rationalize vs. old name as well as new + (uniquify-rationalize-file-buffer-names) + ;; call with argument: rationalize vs. new name only + (uniquify-rationalize-file-buffer-names + (uniquify-buffer-file-name (current-buffer)) (current-buffer))) + (setq ad-return-value (buffer-name (current-buffer)))))) - (add-hook 'kill-buffer-hook 'delay-uniquify-rationalize-file-buffer-names)) - (t - ;; GNU Emacs 19.01 through 19.27 - ;; Before version 19.28, {pre,post}-command-hook was unable to set itself. - - (defvar uniquify-post-command-p nil - "Set to trigger re-rationalization of buffer names by function on -`post-command-hook'. Used by kill-buffer-rationalization mechanism.") - - (defun uniquify-post-command-rerationalization () - "Set variable so buffer names may be rationalized by `post-command-hook'. +(defadvice create-file-buffer (after create-file-buffer-uniquify activate) + "Uniquify buffer names with parts of directory name." + (if uniquify-buffer-name-style + (uniquify-rationalize-file-buffer-names (ad-get-arg 0) ad-return-value))) -See variables `uniquify-post-command-p', `uniquify-buffer-name-style', and -`uniquify-after-kill-buffer-p'." - (if (and uniquify-buffer-name-style - uniquify-after-kill-buffer-p) - (setq uniquify-post-command-p - ;; Set the buffer name, so, once the delimiter character - ;; is parameterized, we could selectively rationalize just - ;; related buffer names. - (cons (buffer-name) uniquify-post-command-p)))) - (defun uniquify-rationalize-after-buffer-kill () - "Via `post-command-hook', rerationalize buffer names after kill-buffer. - -Checks `uniquify-post-command-p', which should be set by -`uniquify-post-command-rerationalization' function on `kill-buffer-hook'." - (if uniquify-post-command-p - (progn (if (and uniquify-buffer-name-style - uniquify-after-kill-buffer-p) - (uniquify-rationalize-file-buffer-names)) - (setq uniquify-post-command-p nil)))) - - (add-hook 'kill-buffer-hook 'uniquify-post-command-rerationalization) - (add-hook 'post-command-hook 'uniquify-rationalize-after-buffer-kill)) - )) - (t - ;; Emacs 18: redefine create-file-buffer and dired-find-buffer. +;; Buffer deletion +;; Rerationalize after a buffer is killed, to reduce coinciding buffer names. +;; This mechanism uses `kill-buffer-hook', which runs *before* deletion. +;; That means that the kill-buffer-hook function cannot just delete the +;; buffer -- it has to set something to do the rationalization *later*. +;; It actually puts another function on `post-command-hook'. This other +;; function runs the rationalization and then removes itself from the hook. +;; Is there a better way to accomplish this? +;; (This ought to set some global variables so the work is done only for +;; buffers with names similar to the deleted buffer. -MDE) - ;; Since advice.el can run in Emacs 18 as well as Emacs 19, we could use - ;; advice here, too, if it is available; but it's not worth it, since - ;; Emacs 18 is obsolescent anyway. +;; Emacs 19.28 or later, or XEmacs (19.12 or later; is that necessary?) +(defun delay-uniquify-rationalize-file-buffer-names () + "Add `delayed-uniquify-rationalize-file-buffer-names' to `post-command-hook'. +For use on, eg, `kill-buffer-hook', to rationalize *after* buffer deletion." + (if (and uniquify-buffer-name-style + uniquify-after-kill-buffer-p) + (add-hook 'post-command-hook + 'delayed-uniquify-rationalize-file-buffer-names))) - (defun create-file-buffer (filename) ;from files.el - "Create a suitably named buffer for visiting FILENAME, and return it." - (let ((base (file-name-nondirectory filename))) - (if (string= base "") - (setq base filename)) - (if (and (get-buffer base) - uniquify-ask-about-buffer-names-p) - (get-buffer-create - (let ((tem (read-string (format - "Buffer name \"%s\" is in use; type a new name, or Return to clobber: " - base)))) - (if (equal tem "") base tem))) - (let ((buf (generate-new-buffer base))) - (if uniquify-buffer-name-style - (uniquify-rationalize-file-buffer-names filename buf)) - buf)))) +(defun delayed-uniquify-rationalize-file-buffer-names () + "Rerationalize buffer names and remove self from `post-command-hook'. +See also `delay-rationalize-file-buffer-names' for hook setter." + (uniquify-rationalize-file-buffer-names) + (remove-hook 'post-command-hook + 'delayed-uniquify-rationalize-file-buffer-names)) - (defun dired-find-buffer (dirname) ;from dired.el - (let ((blist (buffer-list)) - found) - (while blist - (save-excursion - (set-buffer (car blist)) - (if (and (eq major-mode 'dired-mode) - (equal dired-directory dirname)) - (setq found (car blist) - blist nil) - (setq blist (cdr blist))))) - (or found - (progn (if (string-match "/$" dirname) - (setq dirname (substring dirname 0 -1))) - (create-file-buffer (if uniquify-buffer-name-style - dirname - (file-name-nondirectory dirname))))))))) +(add-hook 'kill-buffer-hook 'delay-uniquify-rationalize-file-buffer-names) + ;;; uniquify.el ends here
--- a/lisp/viper/auto-autoloads.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/viper/auto-autoloads.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,8 +1,5 @@ ;;; DO NOT MODIFY THIS FILE (if (featurep 'viper-autoloads) (error "Already loaded")) - - -(provide 'viper-autoloads) ;;;### (autoloads (viper-mode toggle-viper-mode) "viper" "viper/viper.el") @@ -12,3 +9,5 @@ Turn on Viper emulation of Vi." t nil) ;;;*** + +(provide 'viper-autoloads)
--- a/lisp/viper/custom-load.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/viper/custom-load.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,3 +1,4 @@ -(custom-put 'viper 'custom-loads '("viper-cmd" "viper-ex" "viper-init" "viper-keym" "viper-macs" "viper-mous" "viper-util" "viper")) (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"))
--- a/lisp/vm/vm-misc.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/vm/vm-misc.el Mon Aug 13 09:57:07 2007 +0200 @@ -455,7 +455,8 @@ (cond (vm-xemacs-p (eq (device-type) 'x)) (vm-fsfemacs-19-p - (eq window-system 'x)))) + (or (eq window-system 'x) + (eq window-system 'win32))))) (defun vm-run-message-hook (message &optional hook-variable) (save-excursion
--- a/lisp/vm/vm-pop.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/vm/vm-pop.el Mon Aug 13 09:57:07 2007 +0200 @@ -196,6 +196,7 @@ ;; clear the trace buffer of old output (save-excursion (set-buffer process-buffer) + (buffer-disable-undo) (erase-buffer)) ;; open the connection to the server (setq process (open-network-stream "POP" process-buffer host port))
--- a/lisp/vm/vm-save.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/vm/vm-save.el Mon Aug 13 09:57:07 2007 +0200 @@ -132,11 +132,9 @@ (vm-number-of (car vm-message-pointer)) auto-folder))) (let ((vm-delete-after-saving vm-delete-after-archiving)) - (if (not (string-equal auto-folder "/dev/null")) - (vm-save-message auto-folder)) + (vm-save-message auto-folder) (vm-increment archived) - (message "%d archived, still working..." - archived))) + (message "%d archived, still working..." archived))) (setq done (eq vm-message-pointer stop-point) vm-message-pointer (cdr vm-message-pointer)))) ;; fix mode line
--- a/lisp/vm/vm-startup.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/vm/vm-startup.el Mon Aug 13 09:57:07 2007 +0200 @@ -158,11 +158,14 @@ ;; raise frame if requested and apply startup window ;; configuration. (if full-startup - (progn + (let ((buffer-to-display (or vm-summary-buffer + vm-presentation-buffer + (current-buffer)))) + (vm-display buffer-to-display buffer-to-display + (list this-command) + (list (or this-command 'vm) 'startup)) (if vm-raise-frame-at-startup - (vm-raise-frame)) - (vm-display nil nil (list this-command) - (list (or this-command 'vm) 'startup)))) + (vm-raise-frame)))) ;; say this NOW, before the non-previewers read a message, ;; alter the new message count and confuse themselves. @@ -277,7 +280,7 @@ (defun vm-mode (&optional read-only) "Major mode for reading mail. -This is VM 6.33. +This is VM 6.34. Commands: h - summarize folder contents
--- a/lisp/vm/vm-toolbar.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/vm/vm-toolbar.el Mon Aug 13 09:57:07 2007 +0200 @@ -367,6 +367,7 @@ (compose . vm-toolbar-compose-button) (delete/undelete . vm-toolbar-delete/undelete-button) (file . vm-toolbar-file-button) + (getmail . vm-toolbar-getmail-button) (help . vm-toolbar-help-button) (mime . vm-toolbar-decode-mime-button) (next . vm-toolbar-next-button)
--- a/lisp/vm/vm-version.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/vm/vm-version.el Mon Aug 13 09:57:07 2007 +0200 @@ -2,7 +2,7 @@ (provide 'vm-version) -(defconst vm-version "6.33" +(defconst vm-version "6.34" "Version number of VM.") (defun vm-version ()
--- a/lisp/w3/ChangeLog Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/w3/ChangeLog Mon Aug 13 09:57:07 2007 +0200 @@ -1,3 +1,37 @@ +1997-09-05 William M. Perry <wmperry@aventail.com> + +* Makefile.in: Now includes the 'contrib' directory in distributions. + +* aclocal.m4: Fixed custom detection - would sometimes set CUSTOM to the + directory, sometimes to the filename... ick. + +* Makefile.in (dotemacs): Tweaked the install of autoloads into .emacs file + +* lisp/font.el (font-normalize-color): Ditto + +* lisp/url.el (url-setup-privacy-info): Ditto + +* lisp/devices.el: Everything now recognizes 'w32' as an alias for the + 'win32' device type. This is for Emacs 20.x compatibility, which will + have this change. + +1997-09-04 William M. Perry <wmperry@aventail.com> + +* Updated to Widget/Custom 1.9956 + +1997-08-25 William M. Perry <wmperry@aventail.com> + +* lisp/w3.el (w3-document-information): Fixed bug with empty 'meta' links. + +1997-08-20 William M. Perry <wmperry@aventail.com> + +* lisp/w3-menu.el ((fboundp 'id-menubar-set)): Avoid fset'ing + id-menubar-set - it was confusing oobr + +1997-08-19 William M. Perry <wmperry@aventail.com> + +* New file w3-imenu.el from T.V. Raman <raman@adobe.com> + 1997-07-26 SL Baur <steve@altair.xemacs.org> * mm.el (mm-extension-to-mime): Use `eq' for character comparison.
--- a/lisp/w3/Makefile Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/w3/Makefile Mon Aug 13 09:57:07 2007 +0200 @@ -111,6 +111,6 @@ auto-autoloads.el: $(SOURCES) $(EMACS) -batch -q -no-site-file \ - -eval '(setq autoload-target-directory "'`pwd`'/")' \ + -eval '(setq autoload-package-name "w3")' \ -l autoload \ - -f batch-update-autoloads $? + -f batch-update-directory .
--- a/lisp/w3/custom-load.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/w3/custom-load.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,19 +1,24 @@ +(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")) +(custom-put 'hypermedia 'custom-loads '("url-vars" "w3-cus")) +(custom-put 'w3-advanced 'custom-loads '("w3-cus")) +(custom-put 'w3-menus 'custom-loads '("w3-cus" "w3-menu")) (custom-put 'url-gateway 'custom-loads '("url-gw")) -(custom-put 'url 'custom-loads '("url-gw" "url-irc" "url-vars" "url" "url-news")) -(custom-put 'url-file 'custom-loads '("url-cache" "url-vars")) +(custom-put 'w3-files 'custom-loads '("w3-cus")) +(custom-put 'comm 'custom-loads '("ssl")) (custom-put 'url-cache 'custom-loads '("url-cache" "url-vars")) +(custom-put 'w3-printing 'custom-loads '("w3-cus")) +(custom-put 'w3-images 'custom-loads '("w3-cus")) (custom-put 'url-history 'custom-loads '("url-vars")) -(custom-put 'url-cookie 'custom-loads '("url-cookie" "url-vars")) +(custom-put 'url-hairy 'custom-loads '("url-vars")) (custom-put 'url-mime 'custom-loads '("url-vars")) -(custom-put 'url-hairy 'custom-loads '("url-vars")) +(custom-put 'faces 'custom-loads '("font")) +(custom-put 'w3-hooks 'custom-loads '("w3-cus")) (custom-put 'w3 'custom-loads '("w3-cus" "w3-script")) -(custom-put 'w3-files 'custom-loads '("w3-cus")) -(custom-put 'w3-images 'custom-loads '("w3-cus")) -(custom-put 'w3-printing 'custom-loads '("w3-cus")) -(custom-put 'w3-menus 'custom-loads '("w3-cus" "w3-menu")) +(custom-put 'url-file 'custom-loads '("url-cache" "url-vars")) +(custom-put 'url-news 'custom-loads '("url-news")) +(custom-put 'w3-display 'custom-loads '("w3-cus")) (custom-put 'w3-parsing 'custom-loads '("w3-cus")) -(custom-put 'w3-display 'custom-loads '("w3-cus")) -(custom-put 'w3-hooks 'custom-loads '("w3-cus")) +(custom-put 'i18n 'custom-loads '("url-vars")) (custom-put 'w3-scripting 'custom-loads '("w3-script")) -(custom-put 'url-news 'custom-loads '("url-news"))
--- a/lisp/w3/devices.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/w3/devices.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,7 +1,7 @@ ;;; devices.el -- XEmacs device API emulation ;; Author: wmperry -;; Created: 1997/04/25 21:27:01 -;; Version: 1.4 +;; Created: 1997/09/05 15:41:55 +;; Version: 1.5 ;; Keywords: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -221,37 +221,37 @@ (defun device-color-cells (&optional device) (case window-system - ((x win32 pm) (x-display-color-cells device)) + ((x win32 w32 pm) (x-display-color-cells device)) (ns (ns-display-color-cells device)) (otherwise 1))) (defun device-pixel-width (&optional device) (case window-system - ((x win32 pm) (x-display-pixel-width device)) + ((x win32 w32 pm) (x-display-pixel-width device)) (ns (ns-display-pixel-width device)) (otherwise (frame-width device)))) (defun device-pixel-height (&optional device) (case window-system - ((x win32 pm) (x-display-pixel-height device)) + ((x win32 w32 pm) (x-display-pixel-height device)) (ns (ns-display-pixel-height device)) (otherwise (frame-height device)))) (defun device-mm-width (&optional device) (case window-system - ((x win32 pm) (x-display-mm-width device)) + ((x win32 w32 pm) (x-display-mm-width device)) (ns (ns-display-mm-width device)) (otherwise nil))) (defun device-mm-height (&optional device) (case window-system - ((x win32 pm) (x-display-mm-height device)) + ((x win32 w32 pm) (x-display-mm-height device)) (ns (ns-display-mm-height device)) (otherwise nil))) (defun device-bitplanes (&optional device) (case window-system - ((x win32 pm) (x-display-planes device)) + ((x win32 w32 pm) (x-display-planes device)) (ns (ns-display-planes device)) (otherwise 2))) @@ -318,7 +318,7 @@ Value is `tty' for a tty device (a character-only terminal), `x' for a device which is a connection to an X server, 'ns' for a device which is a connection to a NeXTStep dps server, -'win32' for a Windows-NT window, +'win32' or 'w32' for a Windows-NT window, 'pm' for an OS/2 Presentation Manager window, 'intuition' for an Amiga screen" (device-or-frame-type device))
--- a/lisp/w3/font.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/w3/font.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,7 +1,7 @@ ;;; font.el --- New font model ;; Author: wmperry -;; Created: 1997/04/24 13:55:44 -;; Version: 1.51 +;; Created: 1997/09/05 15:44:37 +;; Version: 1.52 ;; Keywords: faces ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -47,7 +47,7 @@ (if (not (fboundp 'try-font-name)) (defun try-font-name (fontname &rest args) (case window-system - ((x win32 pm) (car-safe (x-list-fonts fontname))) + ((x win32 w32 pm) (car-safe (x-list-fonts fontname))) (ns (car-safe (ns-list-fonts fontname))) (otherwise nil)))) @@ -101,6 +101,7 @@ '((x . (x-font-create-name x-font-create-object)) (ns . (ns-font-create-name ns-font-create-object)) (win32 . (x-font-create-name x-font-create-object)) + (w32 . (x-font-create-name x-font-create-object)) (pm . (x-font-create-name x-font-create-object)) ; Change? FIXME (tty . (tty-font-create-plist tty-font-create-object))) "An assoc list mapping device types to the function used to create @@ -1144,6 +1145,11 @@ (color (apply 'format "#%02x%02x%02x" rgb))) (win32-define-rgb-color (nth 0 rgb) (nth 1 rgb) (nth 2 rgb) color) color)) + (w32 + (let* ((rgb (font-color-rgb-components color)) + (color (apply 'format "#%02x%02x%02x" rgb))) + (w32-define-rgb-color (nth 0 rgb) (nth 1 rgb) (nth 2 rgb) color) + color)) (tty (apply 'font-tty-find-closest-color (font-color-rgb-components color))) (ns
--- a/lisp/w3/url-vars.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/w3/url-vars.el Mon Aug 13 09:57:07 2007 +0200 @@ -38,7 +38,7 @@ (defmacro defcustom (var value doc &rest args) (` (defvar (, var) (, value) (, doc)))))) -(defconst url-version (let ((x "p3.0.103")) +(defconst url-version (let ((x "p3.0.104")) (if (string-match "State: \\([^ \t\n]+\\)" x) (substring x (match-beginning 1) (match-end 1)) x))
--- a/lisp/w3/url.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/w3/url.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,13 +1,13 @@ ;;; url.el --- Uniform Resource Locator retrieval tool ;; Author: wmperry -;; Created: 1997/07/14 05:15:29 -;; Version: 1.80 +;; Created: 1997/09/05 15:43:50 +;; Version: 1.81 ;; Keywords: comm, data, processes, hypermedia ;;; LCD Archive Entry: ;;; url|William M. Perry|wmperry@cs.indiana.edu| ;;; Functions for retrieving/manipulating URLs| -;;; 1997/07/14 05:15:29|1.80|Location Undetermined +;;; 1997/09/05 15:43:50|1.81|Location Undetermined ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -804,7 +804,7 @@ ((eq system-type 'windows-nt) "Windows-NT; 32bit") ((eq system-type 'ms-windows) "Windows; 16bit") ((eq system-type 'ms-dos) "MS-DOS; 32bit") - ((eq (device-type) 'win32) "Windows; 32bit") + ((memq (device-type) '(win32 w32)) "Windows; 32bit") ((eq (device-type) 'pm) "OS/2; 32bit") (t (case (device-type)
--- a/lisp/w3/w3-menu.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/w3/w3-menu.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-menu.el --- Menu functions for emacs-w3 ;; Author: wmperry -;; Created: 1997/07/06 22:24:36 -;; Version: 1.41 +;; Created: 1997/08/20 13:57:38 +;; Version: 1.42 ;; Keywords: menu, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -35,10 +35,8 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; InfoDock stuff ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(if (not (fboundp 'id-menubar-set)) - (fset 'id-menubar-set 'ignore)) - -(id-menubar-set 'w3-mode 'w3-menu-make-xemacs-menubar) +(if (fboundp 'id-menubar-set) + (id-menubar-set 'w3-mode 'w3-menu-make-xemacs-menubar)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Spiffy new menus (for both Emacs and XEmacs)
--- a/lisp/w3/w3-vars.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/w3/w3-vars.el Mon Aug 13 09:57:07 2007 +0200 @@ -34,7 +34,7 @@ (require 'wid-edit) ; For `widget-keymap' (defconst w3-version-number - (let ((x "p3.0.103")) + (let ((x "p3.0.104")) (if (string-match "State:[ \t\n]+.\\([^ \t\n]+\\)" x) (setq x (substring x (match-beginning 1) (match-end 1))) (setq x (substring x 1)))
--- a/lisp/w3/w3.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/w3/w3.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3.el --- Main functions for emacs-w3 on all platforms/versions ;; Author: wmperry -;; Created: 1997/07/14 16:57:04 -;; Version: 1.140 +;; Created: 1997/08/25 14:55:29 +;; Version: 1.141 ;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -670,11 +670,12 @@ (fmtstring (format " <tr><td>%%%ds:</td><td>%%s</td></tr>" maxlength))) (insert " <tr><th colspan=2>Miscellaneous Variables</th></tr>\n") (while info - (insert (format fmtstring - (url-insert-entities-in-string - (capitalize (caar info))) - (url-insert-entities-in-string - (cdar info))) "\n") + (if (and (caar info) (cdar info)) + (insert (format fmtstring + (url-insert-entities-in-string + (capitalize (caar info))) + (url-insert-entities-in-string + (cdar info))) "\n")) (setq info (cdr info)) ) )
--- a/lisp/x11/custom-load.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/x11/custom-load.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,1 +1,1 @@ -(custom-put 'toolbar 'custom-loads '("x-toolbar")) +(custom-put 'environment 'custom-loads '(("x-toolbar")))
--- a/lisp/x11/x-menubar.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/x11/x-menubar.el Mon Aug 13 09:57:07 2007 +0200 @@ -137,7 +137,7 @@ ["Read Mail (VM)..." vm t] ["Read Mail (MH)..." (mh-rmail t) t] ["Send mail..." mail t] - ["Usenet News" gnus t] + ["Usenet News" gnus (fboundp 'gnus)] ["Browse the Web" w3 t] ["Gopher" gopher t] ["Hyperbole..." hyperbole t]
--- a/lisp/x11/x-toolbar.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/x11/x-toolbar.el Mon Aug 13 09:57:07 2007 +0200 @@ -1,8 +1,12 @@ -;; Toolbar support for X. +;;; x-toolbar.el -- Runtime initialization of XEmacs toolbar +;; Copyright (C) 1997 Free Software Foundation, Inc. ;; Copyright (C) 1994 Andy Piper <andyp@parallax.demon.co.uk> ;; Copyright (C) 1995 Board of Trustees, University of Illinois ;; Copyright (C) 1996 Ben Wing <wing@666.com> +;; Maintainer: XEmacs development team +;; Keywords: frames + ;; This file is part of XEmacs. ;; XEmacs is free software; you can redistribute it and/or modify it @@ -20,10 +24,14 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. -;; +;;; Synched up: Not synched + +;;; Commentary: + ;; Miscellaneous toolbar functions, useful for users to redefine, in ;; order to get different behaviour. -;; + +;;; Code: (eval-when-compile (require 'pending-del)) @@ -388,27 +396,28 @@ ;; sometimes when this is evaluated. Note that I even tried to ;; kludge-fix this by calls to `set-specifier-dirty-flag' in ;; pop-window-configuration and such. - + ;;[toolbar-next-win-icon unpop-window-configuration ;;(frame-property (selected-frame) ;; 'window-config-unpop-stack) t "Undo \"Most recent window config\""] ;; #### Illicit knowledge? - - [toolbar-file-icon toolbar-open t "Open a file" ] + + [toolbar-file-icon toolbar-open t "Open a file"] [toolbar-folder-icon toolbar-dired t "View directory"] - [toolbar-disk-icon toolbar-save t "Save buffer" ] - [toolbar-printer-icon toolbar-print t "Print buffer" ] + [toolbar-disk-icon toolbar-save t "Save buffer"] + [toolbar-printer-icon toolbar-print t "Print buffer"] [toolbar-cut-icon toolbar-cut t "Kill region"] [toolbar-copy-icon toolbar-copy t "Copy region"] [toolbar-paste-icon toolbar-paste t "Paste from clipboard"] - [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-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-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-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"] +) "The initial toolbar for a buffer.") (defun x-init-toolbar-from-resources (locale)
--- a/lisp/x11/x-win-sun.el Mon Aug 13 09:56:30 2007 +0200 +++ b/lisp/x11/x-win-sun.el Mon Aug 13 09:57:07 2007 +0200 @@ -156,7 +156,10 @@ ,@(cond ((x-keysym-on-keyboard-sans-modifiers-p "apRead") ; SunOS 4.1.1 '(("apRead" apRead f11) ("apEdit" apEdit f12))) ((x-keysym-on-keyboard-sans-modifiers-p "SunF36") ; SunOS 5 - '(("SunF36" SunF36 f11) ("SunF37" SunF37 f12)))) + '(("SunF36" SunF36 f11) + ("SunF37" SunF37 f12) + ("F11" f11 stop) + ("F12" f12 again)))) ) do (when (x-keysym-on-keyboard-sans-modifiers-p x-name) (x-remap-keysyms-using-function-key-map from-key to-key)))
--- a/man/cc-mode.texi Mon Aug 13 09:56:30 2007 +0200 +++ b/man/cc-mode.texi Mon Aug 13 09:57:07 2007 +0200 @@ -46,7 +46,7 @@ @comment The title is printed in a large font. @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -@center @titlefont{CC Mode 5.17} +@center @titlefont{CC Mode 5.18} @sp 2 @center @subtitlefont{A GNU Emacs mode for editing C and C-like languages} @sp 2
--- a/man/hm--html-mode.texi Mon Aug 13 09:56:30 2007 +0200 +++ b/man/hm--html-mode.texi Mon Aug 13 09:57:07 2007 +0200 @@ -4,7 +4,7 @@ @settitle HM HTML Mode @setchapternewpage odd @comment %**end of header (This is for running Texinfo on a region.) -@comment $Id: hm--html-mode.texi,v 1.4 1997/07/26 22:10:08 steve Exp $ +@comment $Id: hm--html-mode.texi,v 1.5 1997/09/17 05:19:51 steve Exp $ @ifinfo This file documents the Elisp package @code{hm--html-menus}. @@ -36,7 +36,7 @@ @end ifinfo @iftex -@input umlaute.texinfo +@input umlaute.texi @end iftex @titlepage @sp 10 @@ -135,7 +135,7 @@ This document describes the Elisp package @emph{hm---html-menus 5.8}. The version of the document is:@* -$Id: hm--html-mode.texi,v 1.4 1997/07/26 22:10:08 steve Exp $ +$Id: hm--html-mode.texi,v 1.5 1997/09/17 05:19:51 steve Exp $ The package provides commands and various popup and pulldown menus for an HTML mode called @dfn{hm---html-mode}, a mode for writing HTML pages
--- a/man/w3.texi Mon Aug 13 09:56:30 2007 +0200 +++ b/man/w3.texi Mon Aug 13 09:57:07 2007 +0200 @@ -12,7 +12,7 @@ @c site: http://www.cs.indiana.edu/elisp/w3/docs.html @c @setfilename w3.info -@settitle Emacs/W3 v3.0.103 User's Manual +@settitle Emacs/W3 v3.0.104 User's Manual @iftex @finalout @end iftex @@ -90,7 +90,7 @@ @t{w3-beta@@indiana.edu} mailing list with any suggestions. @xref{Reporting Bugs} -This manual corresponds to Emacs/W3 v3.0.103 +This manual corresponds to Emacs/W3 v3.0.104 @menu * Getting Started:: Getting up and running with Emacs/W3
--- a/man/widget.texi Mon Aug 13 09:56:30 2007 +0200 +++ b/man/widget.texi Mon Aug 13 09:57:07 2007 +0200 @@ -13,7 +13,7 @@ @comment node-name, next, previous, up @top The Emacs Widget Library -Version: 1.9956 +Version: 1.9958 @menu * Introduction::
--- a/src/ChangeLog Mon Aug 13 09:56:30 2007 +0200 +++ b/src/ChangeLog Mon Aug 13 09:57:07 2007 +0200 @@ -1,3 +1,22 @@ +1997-09-16 SL Baur <steve@altair.xemacs.org> + + * events.c (Fmake_event): Add default case, remove unused variables. + +1997-08-21 Jan Vroonhof <vroonhof@math.ethz.ch> + + * extents.c (extent_fragment_update): Trigger one_shot_function + + * extents.c (set-extent-one-shot-function): New function + + * extents.h (struct extent_auxiliary): Added one_shot_function + + * extens.c: Added one_shot_function to assesor functions. + +1997-09-14 Hrvoje Niksic <hniksic@srce.hr> + + * fileio.c (Fexpand_file_name): Don't treat "//" and "~/" in the + middle of path specially. + 1997-09-10 Hrvoje Niksic <hniksic@srce.hr> * event-stream.c (inhibit_input_event_recording): New boolean
--- a/src/cmdloop.c Mon Aug 13 09:56:30 2007 +0200 +++ b/src/cmdloop.c Mon Aug 13 09:57:07 2007 +0200 @@ -497,7 +497,7 @@ ()) { /* This function can GC */ - Lisp_Object event = Fmake_event (); + Lisp_Object event = Fmake_event (Qnil, Qnil); Lisp_Object old_loop = Qnil; struct gcpro gcpro1, gcpro2; int was_locked = in_single_console_state ();
--- a/src/doc.c Mon Aug 13 09:56:30 2007 +0200 +++ b/src/doc.c Mon Aug 13 09:57:07 2007 +0200 @@ -489,7 +489,7 @@ The type determines where the docstring is stored. */ else if (p[1] == 'F') { - fun = XSYMBOL (sym)->function;/*indirect_function (sym,0);*/ + fun = indirect_function (sym,0); if (CONSP (fun) && EQ (XCAR (fun), Qmacro)) fun = XCDR (fun);
--- a/src/emacsfns.h Mon Aug 13 09:56:30 2007 +0200 +++ b/src/emacsfns.h Mon Aug 13 09:57:07 2007 +0200 @@ -757,7 +757,7 @@ /* Defined in events.c */ void clear_event_resource (void); -Lisp_Object Fmake_event (void); +Lisp_Object Fmake_event (Lisp_Object, Lisp_Object); Lisp_Object Fdeallocate_event (Lisp_Object event); Lisp_Object Fcopy_event (Lisp_Object from, Lisp_Object to); Lisp_Object allocate_event (void);
--- a/src/event-Xt.c Mon Aug 13 09:56:30 2007 +0200 +++ b/src/event-Xt.c Mon Aug 13 09:57:07 2007 +0200 @@ -849,7 +849,7 @@ GCPRO2 (instream, fb_instream); while ((ch = Lstream_get_emchar (istr)) != EOF) { - Lisp_Object emacs_event = Fmake_event (); + Lisp_Object emacs_event = Fmake_event (Qnil, Qnil); struct Lisp_Event *ev = XEVENT (emacs_event); ev->channel = DEVICE_CONSOLE (d); ev->event_type = key_press_event; @@ -2149,7 +2149,7 @@ signal_special_Xt_user_event (Lisp_Object channel, Lisp_Object function, Lisp_Object object) { - Lisp_Object event = Fmake_event (); + Lisp_Object event = Fmake_event (Qnil, Qnil); XEVENT (event)->event_type = misc_user_event; XEVENT (event)->channel = channel; @@ -2242,7 +2242,7 @@ XEvent *event, Boolean *continue_to_dispatch /* unused */) { - Lisp_Object emacs_event = Fmake_event (); + Lisp_Object emacs_event = Fmake_event (Qnil, Qnil); #ifdef DEBUG_XEMACS if (x_debug_events > 0) @@ -2359,7 +2359,7 @@ if (!poll_fds_for_input (temp_mask)) return; - event = Fmake_event (); + event = Fmake_event (Qnil, Qnil); if (!read_event_from_tty_or_stream_desc (XEVENT (event), con, infd)) /* EOF, or something ... */ return;
--- a/src/event-stream.c Mon Aug 13 09:56:30 2007 +0200 +++ b/src/event-stream.c Mon Aug 13 09:57:07 2007 +0200 @@ -1547,7 +1547,7 @@ void enqueue_magic_eval_event (void (*fun) (Lisp_Object), Lisp_Object object) { - Lisp_Object event = Fmake_event (); + Lisp_Object event = Fmake_event (Qnil, Qnil); XEVENT (event)->event_type = magic_eval_event; /* channel for magic_eval events is nil */ @@ -1565,7 +1565,7 @@ */ (function, object)) { - Lisp_Object event = Fmake_event (); + Lisp_Object event = Fmake_event (Qnil, Qnil); XEVENT (event)->event_type = eval_event; /* channel for eval events is nil */ @@ -1580,7 +1580,7 @@ enqueue_misc_user_event (Lisp_Object channel, Lisp_Object function, Lisp_Object object) { - Lisp_Object event = Fmake_event (); + Lisp_Object event = Fmake_event (Qnil, Qnil); XEVENT (event)->event_type = misc_user_event; XEVENT (event)->channel = channel; @@ -2045,7 +2045,7 @@ #endif /* LWLIB_MENUBARS_LUCID */ if (NILP (event)) - event = Fmake_event (); + event = Fmake_event (Qnil, Qnil); else CHECK_LIVE_EVENT (event); @@ -2191,10 +2191,10 @@ key, click, or menu selection), never a motion or process event. */ if (!EVENTP (Vlast_input_event)) - Vlast_input_event = Fmake_event (); + Vlast_input_event = Fmake_event (Qnil, Qnil); if (XEVENT_TYPE (Vlast_input_event) == dead_event) { - Vlast_input_event = Fmake_event (); + Vlast_input_event = Fmake_event (Qnil, Qnil); error ("Someone deallocated last-input-event!"); } if (! EQ (event, Vlast_input_event)) @@ -2312,7 +2312,7 @@ /* This throws away user-input on the queue, but doesn't process any events. Calling dispatch_event() here leads to a race condition. */ - Lisp_Object event = Fmake_event (); + Lisp_Object event = Fmake_event (Qnil, Qnil); Lisp_Object head = Qnil, tail = Qnil; Lisp_Object oiq = Vinhibit_quit; struct gcpro gcpro1, gcpro2; @@ -2471,7 +2471,7 @@ } } - event = Fmake_event (); + event = Fmake_event (Qnil, Qnil); count = specpdl_depth (); record_unwind_protect (sit_for_unwind, @@ -2575,7 +2575,7 @@ GCPRO1 (event); id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0); - event = Fmake_event (); + event = Fmake_event (Qnil, Qnil); count = specpdl_depth (); record_unwind_protect (sit_for_unwind, make_int (id)); @@ -2681,7 +2681,7 @@ redisplay when no input pending. */ GCPRO1 (event); - event = Fmake_event (); + event = Fmake_event (Qnil, Qnil); /* Generate the wakeup even if MSECS is 0, so that existing timeout/etc. events get processed. The old (pre-19.12) code special-cased this @@ -2780,7 +2780,7 @@ wait_delaying_user_input (int (*predicate) (void *arg), void *predicate_arg) { /* This function can GC */ - Lisp_Object event = Fmake_event (); + Lisp_Object event = Fmake_event (Qnil, Qnil); struct gcpro gcpro1; GCPRO1 (event); @@ -3921,7 +3921,7 @@ static void push_this_command_keys (Lisp_Object event) { - Lisp_Object new = Fmake_event (); + Lisp_Object new = Fmake_event (Qnil, Qnil); Fcopy_event (event, new); enqueue_event (new, &Vthis_command_keys, &Vthis_command_keys_tail); @@ -3998,7 +3998,7 @@ if (NILP (e)) { - e = Fmake_event (); + e = Fmake_event (Qnil, Qnil); XVECTOR_DATA (Vrecent_keys_ring) [recent_keys_ring_index] = e; } Fcopy_event (event, e); @@ -4092,7 +4092,7 @@ } else { - event = Fcopy_event (event, Fmake_event ()); + event = Fcopy_event (event, Fmake_event (Qnil, Qnil)); command_builder_append_event (command_builder, event); } @@ -4127,7 +4127,7 @@ maybe_echo_keys (command_builder, 0); } else if (!NILP (Vquit_flag)) { - Lisp_Object quit_event = Fmake_event(); + Lisp_Object quit_event = Fmake_event(Qnil, Qnil); struct Lisp_Event *e = XEVENT (quit_event); /* if quit happened during menu acceleration, pretend we read it */ struct console *con = XCONSOLE (Fselected_console ()); @@ -4184,10 +4184,10 @@ /* Store the last-command-event. The semantics of this is that it is the last event most recently involved in command-lookup. */ if (!EVENTP (Vlast_command_event)) - Vlast_command_event = Fmake_event (); + Vlast_command_event = Fmake_event (Qnil, Qnil); if (XEVENT (Vlast_command_event)->event_type == dead_event) { - Vlast_command_event = Fmake_event (); + Vlast_command_event = Fmake_event (Qnil, Qnil); error ("Someone deallocated the last-command-event!"); } @@ -4623,7 +4623,7 @@ struct command_builder *command_builder = XCOMMAND_BUILDER (con->command_builder); Lisp_Object result; - Lisp_Object event = Fmake_event (); + Lisp_Object event = Fmake_event (Qnil, Qnil); int speccount = specpdl_depth (); struct gcpro gcpro1; GCPRO1 (event);
--- a/src/events.c Mon Aug 13 09:56:30 2007 +0200 +++ b/src/events.c Mon Aug 13 09:57:07 2007 +0200 @@ -353,20 +353,25 @@ } -/* #### This should accept a type and props (as returned by - event-properties) to allow creation of any type of event. - This is useful, for example, in Lisp code that might want - to determine if, for a given button-down event, what the - binding for the corresponding button-up event is. */ +DEFUN ("make-event", Fmake_event, 0, 2, 0, /* +Create a new event of type TYPE, with properties stored in PLIST. +TYPE is a symbol, either `empty', `key-press', `button-press', + `button-release', or `motion'. If TYPE is left out, it defaults to + `empty'. +PLIST is a list of properties, as returned by `event-properties'. Not + all properties are allowed for all kinds of events, and some are + required. -DEFUN ("make-event", Fmake_event, 0, 0, 0, /* -Create a new empty event. WARNING, the event object returned may be a reused one; see the function -`deallocate-event'. + `deallocate-event'. */ - ()) + (type, plist)) { - Lisp_Object event; + Lisp_Object event, prop, val; + struct Lisp_Event *e; + + if (NILP (type)) + type = Qempty; if (!NILP (Vevent_resource)) { @@ -377,7 +382,131 @@ { event = allocate_event (); } - zero_event (XEVENT (event)); + e = XEVENT (event); + zero_event (e); + + if (EQ (type, Qkey_press)) + e->event_type = key_press_event; + else if (EQ (type, Qbutton_press)) + e->event_type = button_press_event; + else if (EQ (type, Qbutton_release)) + e->event_type = button_release_event; + else if (EQ (type, Qmotion)) + e->event_type = pointer_motion_event; + else if (EQ (type, Qempty)) + e->event_type = empty_event; + else + /* not allowed: Qmisc_user, Qprocess, Qtimeout, Qmagic, Qmagic_eval */ + signal_simple_error ("Invalid event type", type); + + /* Process the plist. */ + while (!NILP (plist)) + { + prop = Fcar (plist); + plist = Fcdr (plist); + val = Fcar (plist); + plist = Fcdr (plist); + if (EQ (prop, Qchannel)) + { + if (!DEVICEP (val) && !CONSOLEP (val) && !FRAMEP (val) + && !NILP (val)) + signal_simple_error ("Invalid event channel", val); + EVENT_CHANNEL (e) = val; + } + else if (EQ (prop, Qkey)) + { + if (e->event_type != key_press_event) + wrong_type_argument (Qkey_press_event_p, event); + if (!SYMBOLP (val) && !CHARP (val)) + signal_simple_error ("Invalid event key", val); + e->event.key.keysym = val; + } + else if (EQ (prop, Qbutton)) + { + CHECK_NATNUM (val); + check_int_range (XINT(val), 1, 3); + if (e->event_type != button_press_event + && e->event_type != button_release_event) + signal_simple_error ("Invalid event type for `button' property", + type); + e->event.button.button = XINT (val); + } + else if (EQ (prop, Qmodifiers)) + { + Lisp_Object tail, sym; + int modifiers = 0; + + if (e->event_type != key_press_event + && e->event_type != button_press_event + && e->event_type != button_release_event + && e->event_type != pointer_motion_event) + signal_simple_error ("Invalid event type for modifiers", type); + + for (tail = val; !NILP (tail); tail = Fcdr (tail)) + { + sym = Fcar (tail); + if (EQ (sym, Qcontrol)) modifiers |= MOD_CONTROL; + else if (EQ (sym, Qmeta)) modifiers |= MOD_META; + else if (EQ (sym, Qsuper)) modifiers |= MOD_SUPER; + else if (EQ (sym, Qhyper)) modifiers |= MOD_HYPER; + else if (EQ (sym, Qalt)) modifiers |= MOD_ALT; + else if (EQ (sym, Qsymbol)) modifiers |= MOD_ALT; + else if (EQ (sym, Qshift)) modifiers |= MOD_SHIFT; + else + signal_simple_error ("Invalid key modifier", Fcar (tail)); + } + if (e->event_type == key_press_event) + e->event.key.modifiers = modifiers; + else if (e->event_type == button_press_event + || e->event_type == button_release_event) + e->event.button.modifiers = modifiers; + else /* pointer_motion_event */ + e->event.motion.modifiers = modifiers; + } + else if (EQ (prop, Qx)) + { + CHECK_NATNUM (val); + if (e->event_type == pointer_motion_event) + e->event.motion.x = XINT (val); + else if (e->event_type == button_press_event + || e->event_type == button_release_event) + e->event.button.x = XINT (val); + } + else if (EQ (prop, Qy)) + { + CHECK_NATNUM (val); + if (e->event_type == pointer_motion_event) + e->event.motion.y = XINT (val); + else if (e->event_type == button_press_event + || e->event_type == button_release_event) + e->event.button.y = XINT (val); + } + else if (EQ (prop, Qtimestamp)) + { + CHECK_NATNUM (val); + e->timestamp = XINT (val); + } + else + signal_simple_error ("Invalid property", prop); + } /* while */ + + /* Now, let's validate what we got. */ + switch (e->event_type) + { + case key_press_event: + if (!(SYMBOLP (e->event.key.keysym) || CHARP (e->event.key.keysym))) + error ("Undefined key for keypress event"); + break; + case button_press_event: + case button_release_event: + if (!e->event.button.button) + error ("Undefined button for button-press or button-release event"); + if (NILP (EVENT_CHANNEL (e))) + error ("Undefined channel for button-press or button-release event"); + break; + default: + break; + } return event; } @@ -444,7 +573,7 @@ { CHECK_LIVE_EVENT (event1); if (NILP (event2)) - event2 = Fmake_event (); + event2 = Fmake_event (Qnil, Qnil); else CHECK_LIVE_EVENT (event2); if (EQ (event1, event2)) return signal_simple_continuable_error_2 @@ -828,7 +957,7 @@ { struct console *con = decode_console (console); if (NILP (event)) - event = Fmake_event (); + event = Fmake_event (Qnil, Qnil); else CHECK_LIVE_EVENT (event); if (CONSP (ch) || SYMBOLP (ch)) @@ -872,7 +1001,7 @@ for (i = 0; i < len; i++) { - Lisp_Object event = Fmake_event (); + Lisp_Object event = Fmake_event (Qnil, Qnil); nth_of_key_sequence_as_event (seq, i, event); enqueue_event (event, &head, &tail); }
--- a/src/extents.c Mon Aug 13 09:56:30 2007 +0200 +++ b/src/extents.c Mon Aug 13 09:57:07 2007 +0200 @@ -446,6 +446,7 @@ Lisp_Object Qdetachable; Lisp_Object Qpriority; Lisp_Object Qmouse_face; +Lisp_Object Qone_shot_function; Lisp_Object Qglyph_layout; /* This exists only for backwards compatibility. */ Lisp_Object Qbegin_glyph_layout, Qend_glyph_layout; @@ -932,6 +933,7 @@ ((markobj) (data->children)); ((markobj) (data->read_only)); ((markobj) (data->mouse_face)); + ((markobj) (data->one_shot_function)); return data->parent; } @@ -1645,6 +1647,7 @@ !NILP (extent_end_glyph (anc)) || !NILP (extent_mouse_face (anc)) || !NILP (extent_invisible (anc)) || + !NILP (extent_one_shot_function (anc)) || invisibility_change) extent_changed_for_redisplay (extent, descendants_too, invisibility_change); @@ -2880,6 +2883,28 @@ extent_face (&dummy_lhe_extent) = extent_mouse_face (lhe); Dynarr_add (ef->extents, &dummy_lhe_extent); } + /* since we are looping anyway, we might as well do this here */ + if (!NILP(extent_one_shot_function (e))) + { + Lisp_Object function = extent_one_shot_function (e); + Lisp_Object obj; + + /* printf("One shot function called!\n "); */ + + /* print_extent_2(e); + printf("\n"); */ + + /* Do NOT use the set function here because that sets the + redisplay flag. + FIXME: One should probably inhibit the displaying of + this extent to reduce flicker */ + set_extent_one_shot_function (e,Qnil); /* one shot */ + + /* call the function */ + XSETEXTENT(obj,e); + if(!NILP(function)) + Fenqueue_eval_event(function,obj); + } } } @@ -4745,10 +4770,32 @@ return value; } +/* Do we need a lisp-level function ? */ +DEFUN ("set-extent-one-shot-function", Fset_extent_one_shot_function, + 2,2,0,/* +Set one-shot-function of EXTENT to the function +FUNCTION. This function will be called with EXTENT as its only +argument shortly after (part of) the extent has been under +consideration for display. The property is then cleared. +*/ + (extent, function)) +{ + EXTENT e = decode_extent(extent, DE_MUST_BE_ATTACHED); + + e = extent_ancestor (e); /* Is this needed? Macro also does chasing!*/ + set_extent_one_shot_function(e,function); + extent_changed_for_redisplay(e,1,0); /* Do we need to mark children too ?*/ + + return function; +} + + + + DEFUN ("extent-face", Fextent_face, 1, 1, 0, /* Return the name of the face in which EXTENT is displayed, or nil if the extent's face is unspecified. This might also return a list -of face names. +of face names. */ (extent)) { @@ -5042,6 +5089,10 @@ read-only Text within this extent will be unmodifiable. + one-shot-function function to be called the first time (part of) the extent + is redisplayed. It will be called with the extent as its + first argument. + detachable Whether the extent gets detached (as with `detach-extent') when all the text within the extent is deleted. This is true by default. If @@ -5173,6 +5224,8 @@ Fset_extent_priority (extent, value); else if (EQ (property, Qface)) Fset_extent_face (extent, value); + else if (EQ (property, Qone_shot_function)) + Fset_extent_one_shot_function (extent, value); else if (EQ (property, Qmouse_face)) Fset_extent_mouse_face (extent, value); /* Obsolete: */ @@ -5251,6 +5304,8 @@ return extent_invisible (e); else if (EQ (property, Qface)) return Fextent_face (extent); + else if (EQ (property, Qone_shot_function)) + return extent_one_shot_function (e); else if (EQ (property, Qmouse_face)) return Fextent_mouse_face (extent); /* Obsolete: */ @@ -5328,6 +5383,9 @@ result = Fcons (Qpriority, Fcons (make_int (extent_priority (anc)), result)); + if (!NILP (extent_one_shot_function (anc))) + result = Fcons (Qone_shot_function, Fcons (extent_one_shot_function (anc), result)); + if (!NILP (extent_invisible (anc))) result = Fcons (Qinvisible, Fcons (extent_invisible (anc), result)); @@ -6541,6 +6599,8 @@ defsymbol (&Qdetachable, "detachable"); defsymbol (&Qpriority, "priority"); defsymbol (&Qmouse_face, "mouse-face"); + defsymbol (&Qone_shot_function,"one-shot-function"); + defsymbol (&Qglyph_layout, "glyph-layout"); /* backwards compatibility */ defsymbol (&Qbegin_glyph_layout, "begin-glyph-layout"); @@ -6593,6 +6653,7 @@ DEFSUBR (Fmap_extent_children); DEFSUBR (Fextent_at); + DEFSUBR (Fset_extent_one_shot_function); DEFSUBR (Fextent_face); DEFSUBR (Fset_extent_face); DEFSUBR (Fextent_mouse_face); @@ -6666,6 +6727,7 @@ extent_auxiliary_defaults.invisible = Qnil; extent_auxiliary_defaults.read_only = Qnil; extent_auxiliary_defaults.mouse_face = Qnil; + extent_auxiliary_defaults.one_shot_function = Qnil; } void
--- a/src/extents.h Mon Aug 13 09:56:30 2007 +0200 +++ b/src/extents.h Mon Aug 13 09:57:07 2007 +0200 @@ -79,7 +79,7 @@ /* Not used any more */ unsigned int detachable : 1; /* 13 extent detaches if text deleted */ unsigned int internal : 1; /* 14 used by map-extents etc. */ - unsigned int unused15 : 1; /* 15 unused */ + unsigned int unused15 : 1; /* 15 unused */ unsigned int unused16 : 1; /* 16 unused */ /* --- Adding more flags will cause the extent struct grow by another word. It's not clear that this would make a difference, however, @@ -132,6 +132,7 @@ Lisp_Object invisible; Lisp_Object read_only; Lisp_Object mouse_face; + Lisp_Object one_shot_function; #ifdef ENERGIZE Energize_Extent_Data *energize_data; #endif @@ -254,6 +255,7 @@ #define extent_invisible(e) extent_aux_field (e, invisible) #define extent_read_only(e) extent_aux_field (e, read_only) #define extent_mouse_face(e) extent_aux_field (e, mouse_face) +#define extent_one_shot_function(e) extent_aux_field (e, one_shot_function) #ifdef ENERGIZE #define extent_energize_data(e) extent_aux_field (e, energize_data) #endif @@ -270,6 +272,9 @@ set_extent_aux_field (e, read_only, value) #define set_extent_mouse_face(e, value) \ set_extent_aux_field (e, mouse_face, value) +/* Use Fset_extent_one_shot_function unless you know what you are ding */ +#define set_extent_one_shot_function(e, value) \ + set_extent_aux_field (e, one_shot_function, value) #ifdef ENERGIZE #define set_extent_energize_data(e, value) \ set_extent_aux_field (e, energize_data, value)
--- a/src/fileio.c Mon Aug 13 09:56:30 2007 +0200 +++ b/src/fileio.c Mon Aug 13 09:57:07 2007 +0200 @@ -973,6 +973,8 @@ } #endif /* DOS_NT */ + /* We *don't* want to handle // and /~ that way. */ +#if 0 /* Handle // and /~ in middle of file name by discarding everything through the first / of that sequence. */ p = nm; @@ -998,6 +1000,7 @@ p++; } +#endif /* If nm is absolute, flush ...// and detect /./ and /../. If no /./ or /../ we can return right away. */
--- a/src/frame.c Mon Aug 13 09:56:30 2007 +0200 +++ b/src/frame.c Mon Aug 13 09:57:07 2007 +0200 @@ -1752,7 +1752,7 @@ if (mouse_pixel_position_1 (d, &frame, &intx, &inty)) { - Lisp_Object event = Fmake_event (); + Lisp_Object event = Fmake_event (Qnil, Qnil); XEVENT (event)->event_type = pointer_motion_event; XEVENT (event)->channel = frame; XEVENT (event)->event.motion.x = intx;
--- a/src/keymap.c Mon Aug 13 09:56:30 2007 +0200 +++ b/src/keymap.c Mon Aug 13 09:57:07 2007 +0200 @@ -1557,7 +1557,7 @@ to compare the ASCII values. */ GCPRO1 (event2); - event2 = Fmake_event (); + event2 = Fmake_event (Qnil, Qnil); Fcharacter_to_event (key_specifier, event2, Qnil, Qnil); if (XEVENT (event2)->event_type != key_press_event) retval = 0;