# HG changeset patch # User cvs # Date 1186990272 -7200 # Node ID b980b6286996a35474435f0c15f0d3c7594990ff # Parent 4636a6841cd6774f19aee074f5412fb758a7d76a Import from CVS: tag r20-2b2 diff -r 4636a6841cd6 -r b980b6286996 CHANGES-beta --- a/CHANGES-beta Mon Aug 13 09:30:13 2007 +0200 +++ b/CHANGES-beta Mon Aug 13 09:31:12 2007 +0200 @@ -1,4 +1,14 @@ -*- indented-text -*- +to 20.2 beta2 +-- sundry psgml fixes +-- VM-6.29 +-- Gnus-5.4.46 +-- W3-3.0.84 +-- miscellaneous bug fixes +-- edmacro.el-3.10 +-- Reverted to custom-1.84 +-- Make use of DECnet support a configure time option. + to 20.2 beta1 -- W3-3.0.83 courtesy of William Perry -- edmacro.el-3.09 courtesy of Hrvoje Niksic diff -r 4636a6841cd6 -r b980b6286996 ChangeLog --- a/ChangeLog Mon Aug 13 09:30:13 2007 +0200 +++ b/ChangeLog Mon Aug 13 09:31:12 2007 +0200 @@ -1,3 +1,14 @@ +Wed Apr 23 10:33:58 1997 Steven L Baur + + * XEmacs 20.2-b2 is released. + + * configure.in (beta): OPENWINHOME misspelled. + +Mon Apr 21 14:48:29 1997 Steven L Baur + + * etc/BETA (writing): Update with information about how to create + patches. + Sat Apr 19 16:13:16 1997 Steven L Baur * XEmacs 20.2-b1 is released. diff -r 4636a6841cd6 -r b980b6286996 PROBLEMS --- a/PROBLEMS Mon Aug 13 09:30:13 2007 +0200 +++ b/PROBLEMS Mon Aug 13 09:31:12 2007 +0200 @@ -480,6 +480,12 @@ Remember, you can't compile lwlib for r4 and emacs for r5, or vice versa. They must be in sync. +** Problems finding X11 libraries on Solaris with Openwindows + +Some users have reported problems in this area. The reported solution +is to define the environment variable OPENWINHOME, even if you must set +it to `/usr/openwin'. + * Problems with running XEmacs ** You type Control-H (Backspace) expecting to delete characters. diff -r 4636a6841cd6 -r b980b6286996 configure --- a/configure Mon Aug 13 09:30:13 2007 +0200 +++ b/configure Mon Aug 13 09:31:12 2007 +0200 @@ -120,6 +120,7 @@ with_toolbars='' with_tty='yes' use_union_type='no' +with_dnet='' # # gnu echo silently eats `--help', `--version', `-n', `-e', `-E', `-n'. # # other versions of echo eat any strings beginning with `-n'. @@ -263,6 +264,7 @@ --with-pop support POP for mail retrieval --with-kerberos support Kerberos-authenticated POP --with-hesiod support Hesiod to get the POP server host +--with-dnet (*) Compile with support for DECnet. Internationalization options: @@ -434,6 +436,7 @@ with_pop | \ with_kerberos | \ with_hesiod | \ + with_dnet | \ external_widget | \ verbose | \ extra_verbose | \ @@ -2967,7 +2970,8 @@ DEFS="${C_SWITCH_SITE} $c_switch_system $c_switch_machine $c_switch_x_system $DEFS" LIBS="${LD_SWITCH_SITE} $ld_switch_x_system $libsrc_libs $LIBS" -ac_save_LIBS="${LIBS}" +test "${with_dnet}" != "no" -a \ + "${with_dnet}" != "yes" && { ac_save_LIBS="${LIBS}" LIBS="${LIBS} -ldnet" ac_have_lib="" test -n "$silent" || echo "checking for -ldnet" @@ -2985,7 +2989,12 @@ rm -f conftest* LIBS="${ac_save_LIBS}" if test -n "${ac_have_lib}"; then - + :; with_dnet="yes" +else + :; +fi + } +test "${with_dnet}" = yes && { test -n "$verbose" && \ echo " defining HAVE_LIBDNET" @@ -2997,8 +3006,6 @@ " } - LIBS="${LIBS} -ldnet" -fi ac_save_LIBS="${LIBS}" @@ -5957,7 +5964,7 @@ C_SWITCH_X_SITE="${C_SWITCH_X_SITE} ${arg}" fi done - for arg in "-L/usr/lib" "-L${OPENWINHHOME-/usr/openwin}/lib" "-L/usr/dt/lib" + for arg in "-L/usr/lib" "-L${OPENWINHOME-/usr/openwin}/lib" "-L/usr/dt/lib" do case "${arg}" in -L*) if test -f `echo "${arg}/libtt.a" | sed 's/^\-L//'` ; then @@ -7107,7 +7114,12 @@ ( -echo "uname -a: `uname -a`" +if test -f /etc/osversion; then + # SONY NEWS-OS + echo "osversion: `cat /etc/osversion`" +eles + echo "uname -a: `uname -a`" +fi echo "" echo "$0 $quoted_arguments" ) >> Installation @@ -7139,6 +7151,7 @@ elif test -n "$site_runtime_libraries"; then echo " Additional libraries: ${site_runtime_libraries}" fi +test "$with_dnet" = yes && echo " Compiling in support for DNET." test "$with_socks" = yes && echo " Compiling in support for SOCKS." test "$with_term" = yes && echo " Compiling in support for TERM." test "$with_xauth" = yes && echo " Compiling in support for XAUTH." diff -r 4636a6841cd6 -r b980b6286996 configure.in --- a/configure.in Mon Aug 13 09:30:13 2007 +0200 +++ b/configure.in Mon Aug 13 09:31:12 2007 +0200 @@ -136,6 +136,7 @@ with_toolbars='' with_tty='yes' use_union_type='no' +with_dnet='' # # gnu echo silently eats `--help', `--version', `-n', `-e', `-E', `-n'. # # other versions of echo eat any strings beginning with `-n'. @@ -279,6 +280,7 @@ --with-pop support POP for mail retrieval --with-kerberos support Kerberos-authenticated POP --with-hesiod support Hesiod to get the POP server host +--with-dnet (*) Compile with support for DECnet. Internationalization options: @@ -453,6 +455,7 @@ with_pop | \ with_kerberos | \ with_hesiod | \ + with_dnet | \ external_widget | \ verbose | \ extra_verbose | \ @@ -2069,7 +2072,10 @@ dnl If found, this defines HAVE_LIBDNET, which m/pmax.h checks, dnl and also adds -ldnet to LIBS, which Autoconf uses for checks. dnl FSF 19.29 also checks for function dnet_ntoa. -AC_HAVE_LIBRARY(-ldnet) +test "${with_dnet}" != "no" -a \ + "${with_dnet}" != "yes" && { AC_HAVE_LIBRARY(-ldnet, with_dnet="yes") } +IF_YES_AC_DEFINE(with_dnet, HAVE_LIBDNET) + dnl This causes -lresolv to get used in subsequent tests, dnl which causes failures on some systems such as HPUX 9. dnl FSF 19.29 also checks for function gethostbyname. @@ -2944,7 +2950,7 @@ C_SWITCH_X_SITE="${C_SWITCH_X_SITE} ${arg}" fi done - for arg in "-L/usr/lib" "-L${OPENWINHHOME-/usr/openwin}/lib" "-L/usr/dt/lib" + for arg in "-L/usr/lib" "-L${OPENWINHOME-/usr/openwin}/lib" "-L/usr/dt/lib" do case "${arg}" in -L*) if test -f `echo "${arg}/libtt.a" | sed 's/^\-L//'` ; then @@ -3201,6 +3207,7 @@ elif test -n "$site_runtime_libraries"; then echo " Additional libraries: ${site_runtime_libraries}" fi +test "$with_dnet" = yes && echo " Compiling in support for DNET." test "$with_socks" = yes && echo " Compiling in support for SOCKS." test "$with_term" = yes && echo " Compiling in support for TERM." test "$with_xauth" = yes && echo " Compiling in support for XAUTH." diff -r 4636a6841cd6 -r b980b6286996 etc/BETA --- a/etc/BETA Mon Aug 13 09:30:13 2007 +0200 +++ b/etc/BETA Mon Aug 13 09:31:12 2007 +0200 @@ -181,3 +181,31 @@ 5. Any other unusual items you feel should be brought to the attention of the developers. + +** Creating patches for submission +================================== + +When making patches you should use the `-c', or preferably if your +diff supports it, `-u'. Using ordinary diffs like this are +notoriously prone to error (and this one won't in fact work, since +I've already applied a patch to this file so the line numbers probably +don't match up any more). + +$ diff -u old-file.c new-file.c + +-or- + +$ diff -c old-file.c new-file.c + +Also, it is helpful for me if you create the patch in the top level of +the XEmacs source directory: + +$ diff -u lwlib/xlwmenu.c~ lwlib/xlwmenu.c + +I prefer patches to be accompanied by an update (either a raw entry or +a patch) to the appropriate ChangeLog file, but it is not required. + +Also note that if you cut & paste from an xterm to an XEmacs mail buffer +you will probably lose due to tab expansion. The best thing to do is to +M-x cd to the appropriate directory, and issue the command `C-u M-!' from +within XEmacs. diff -r 4636a6841cd6 -r b980b6286996 etc/NEWS --- a/etc/NEWS Mon Aug 13 09:30:13 2007 +0200 +++ b/etc/NEWS Mon Aug 13 09:31:12 2007 +0200 @@ -109,7 +109,7 @@ *** More user-level documentation on using Mule. -* Changes in XEmacs 20.1 +* Changes in XEmacs 20.2 ======================== ** The logo has been changed, and the default background color is @@ -127,6 +127,11 @@ eval-expression (`M-:') and upcase-region (`C-x C-u')/downcase-region (`C-x C-l'). +** The `C-z' key now iconifies only the current X frame. You can use +`C-x C-z' to get the old behavior. + +On the tty frames `C-z' behaves as before. + ** Numerous causes of crashes have been fixed. XEmacs should now be even more stable than before. @@ -266,7 +271,7 @@ *** The nnml mail backend now understands compressed article files. -** Custom 1.84, courtesy of Per Abrahamsen +** Custom 1.86, courtesy of Per Abrahamsen The Customize library enables Emacs Lisp programmers to specify types of their variables, so that the users can customize them. @@ -342,7 +347,7 @@ the chain of buffer modification records shorter by one, to counteract the effect of the undo command making the record list longer by one. -** edmacro.el-3.09, courtesy of Dave Gillespie, ported to XEmacs by +** edmacro.el-3.10, courtesy of Dave Gillespie, ported to XEmacs by Hrvoje Niksic. Edmacro is a utility that provides easy editing of keyboard macros. @@ -392,7 +397,7 @@ ** overlay.el, courtesy of Joseph Nuspl -* Lisp and internal changes in XEmacs 20.1 +* Lisp and internal changes in XEmacs 20.2 ========================================== ** `defcustom' and `defgroup' can now be used to specify types and @@ -446,22 +451,24 @@ ** The `read-kbd-macro' function is now available. -The `read-kbd-macro' function (and its shorter-named equivalent `kbd') -from the edmacro package is now available in XEmacs. For example: +The `read-kbd-macro' function (as well as the read-time evaluated +`kbd' macro) from the edmacro package is now available in XEmacs. For +example: (define-key foo-mode-map (kbd "C-c ") 'foo-up) -is the equivalent of +is completely equivalent to (define-key foo-mode-map [(control ?c) up] 'foo-up) -Using `read-kbd-macro' and `kbd' is not necessary for GNU Emacs -compatibility (GNU Emacs supports the XEmacs-style keysyms), but adds -to clarity. - -For example, (kbd "C-?") is easier to read than [(control ??)]. The -full description of the syntax of keybindings accepted by -`read-kbd-macro' is documented in the docstring of `edmacro-mode'. +The `kbd' macro is preferred over `read-kbd-macro' function , as it +evaluates before compiling, thus having no loading overhead. + +Using `kbd' is not necessary for GNU Emacs compatibility (GNU Emacs +supports the XEmacs-style keysyms), but adds to clarity. For example, +(kbd "C-?") is usually easier to read than [(control ??)]. The full +description of the syntax of keybindings accepted by `read-kbd-macro' +is documented in the docstring of `edmacro-mode'. ** Overlay compatibility is implemented. @@ -471,9 +478,8 @@ Emacs-compatible way of changing display properties. ** You should use keysyms kp-* (kp-1, kp-2, ..., kp-enter etc.) -rather than the old form kp_*. The old form is retained for -backwards compatibility, but is obsolete. The new form is also -compatible with GNU Emacs. +rather than the old form kp_*. The new form is also compatible with +GNU Emacs. ** The keysyms mouse-1, mouse-2, mouse-3 and down-mouse-1, down-mouse-2, and down-mouse-3 have been added for GNU Emacs @@ -517,6 +523,13 @@ distribution. +* Changes in XEmacs 20.1 +======================== + +XEmacs 20.1 has not been released to the net. Please consult the 20.2 +entries instead. + + * Major Differences Between 19.14 and 20.0 =========================================== diff -r 4636a6841cd6 -r b980b6286996 etc/app-defaults/ja/Emacs --- a/etc/app-defaults/ja/Emacs Mon Aug 13 09:30:13 2007 +0200 +++ b/etc/app-defaults/ja/Emacs Mon Aug 13 09:31:12 2007 +0200 @@ -37,6 +37,8 @@ !! Fonts for the window frame and menus Emacs*fontList: \ -*-gothic-medium-r-normal--14-120-75-75-c-*-*-*: +!! FontSet for the window frame and menus when you use USE_XFONTSET +Emacs*fontSet: -*-fixed-medium-r-normal--14-* !!!! Default Menubar Top Level diff -r 4636a6841cd6 -r b980b6286996 etc/categories --- a/etc/categories Mon Aug 13 09:30:13 2007 +0200 +++ b/etc/categories Mon Aug 13 09:31:12 2007 +0200 @@ -34,6 +34,7 @@ performance:Performance Issues:dmoore: redisplay:Redisplay Issues:gnats-admin:cthomp@xemacs.org scrollbars:X11 scrollbars:gnats-amdin:mrb@eng.sun.com +subprocesses:All Subprocess stuff:dmoore: toolbars:X11 toolbars:gnats-admin: gnus:Gnus newsreader:larsi: vm:VM Mailreader:kyle: diff -r 4636a6841cd6 -r b980b6286996 etc/gnats/xemacs.org --- a/etc/gnats/xemacs.org Mon Aug 13 09:30:13 2007 +0200 +++ b/etc/gnats/xemacs.org Mon Aug 13 09:31:12 2007 +0200 @@ -11,7 +11,8 @@ performance redisplay scrollbars -tooblbars +subprocesses +toolbars gnus vm w3 diff -r 4636a6841cd6 -r b980b6286996 etc/sgml/iso88591.map --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/sgml/iso88591.map Mon Aug 13 09:31:12 2007 +0200 @@ -0,0 +1,156 @@ +160 [nbsp ] +161 [iexcl ] +162 [cent ] +163 [pound ] +164 [curren] +165 [yen ] +166 [brvbar] +167 [sect ] +168 [uml ] +169 [copy ] +170 [ordf ] +171 [laquo ] +172 [not ] +173 [shy ] +174 [reg ] +175 [macr ] +176 [deg ] +177 [plusmn] +178 [sup2 ] +179 [sup3 ] +180 [acute ] +181 [micro ] +182 [para ] +183 [middot] +184 [cedil ] +185 [sup1 ] +186 [ordm ] +187 [raquo ] +188 [frac14] +189 [frac12] +190 [frac34] +191 [iquest] +192 [Agrave] +193 [Aacute] +194 [Acirc ] +195 [Atilde] +196 [Auml ] +197 [Aring ] +198 [AElig ] +199 [Ccedil] +200 [Egrave] +201 [Eacute] +202 [Ecirc ] +203 [Euml ] +204 [Igrave] +205 [Iacute] +206 [Icirc ] +207 [Iuml ] +208 [ETH ] +209 [Ntilde] +210 [Ograve] +211 [Oacute] +212 [Ocirc ] +213 [Otilde] +214 [Ouml ] +216 [Oslash] +217 [Ugrave] +218 [Uacute] +219 [Ucirc ] +220 [Uuml ] +221 [Yacute] +222 [THORN ] +223 [szlig ] +224 [agrave] +225 [aacute] +226 [acirc ] +227 [atilde] +228 [auml ] +229 [aring ] +230 [aelig ] +231 [ccedil] +232 [egrave] +233 [eacute] +234 [ecirc ] +235 [euml ] +236 [igrave] +237 [iacute] +238 [icirc ] +239 [iuml ] +240 [eth ] +241 [ntilde] +242 [ograve] +243 [oacute] +244 [ocirc ] +245 [otilde] +246 [ouml ] +248 [oslash] +249 [ugrave] +250 [uacute] +251 [ucirc ] +252 [uuml ] +253 [yacute] +254 [thorn ] +255 [yuml ] +192 À +193 Á +194 Â +195 Ã +196 Ä +197 Å +198 Æ +199 Ç +200 È +201 É +202 Ê +203 Ë +204 Ì +205 Í +206 Î +207 Ï +208 Ð +209 Ñ +210 Ò +211 Ó +212 Ô +213 Õ +214 Ö +216 Ø +217 Ù +218 Ú +219 Û +220 Ü +221 Ý +222 Þ +223 ß +224 à +225 á +226 â +227 ã +228 ä +229 å +230 æ +231 ç +232 è +233 é +234 ê +235 ë +236 ì +237 í +238 î +239 ï +240 ð +241 ñ +242 ò +243 ó +244 ô +245 õ +246 ö +248 ø +249 ù +250 ú +251 û +252 ü +253 ý +254 þ +255 ÿ diff -r 4636a6841cd6 -r b980b6286996 etc/w3/stylesheet --- a/etc/w3/stylesheet Mon Aug 13 09:30:13 2007 +0200 +++ b/etc/w3/stylesheet Mon Aug 13 09:31:12 2007 +0200 @@ -8,7 +8,7 @@ ** ** This contains the top level fallback default styles for Emacs-w3 ** -****************************************************************************** +******************************************************************************* ** ** To specify device-dependent styles, you must mark a section with ** @media devicetype { ... } @@ -32,11 +32,23 @@ ** xemacs - only include this chunk if you are using XEmacs ** light - only include this chunk if you are using a light background ** dark - only include this chunk if you are using a dark background +** tty - only include this chunk if you are using a TTY +** ansi-tty - " include this chunk if you are using an ANSI-capable TTY +******************************************************************************* +** +** There are some things this stylesheet cannot really specify, that we +** must rely on the browser to explicitly handle correctly: +** +** o table formatting +** o actually creating a hyperlink from an tag and its attributes +** o specifying which tags open lists +** o inlined images +** o frames (perhaps with positioning) +** o applet/script/embed/object +** o horizontal rules ******************************************************************************/ -/* -** Headers -*/ +/* Headers */ h1,h2,h3, h4,h5,h6 { @@ -45,25 +57,16 @@ font-weight : bold; } -/* -** Since Emacs-19 doesn't handle mixed-sized fonts very well just yet, -** we only use them under XEmacs. Hopefully, this will change soon. -*/ -@media xemacs { h1 { font-size : +12pt } h2 { font-size : +6pt } h3 { font-size : +4pt } h5 { font-size : -2pt } h6 { font-size : -4pt } -/* -** Emacs-19 also doesn't handle how Emacs-W3 changes this type of font -** very well, so lets only do it under XEmacs for now. Emacs-19 can only -** do monospaced fonts anyway, so its redundant. -*/ + +/* Used to cause problems under Emacs 19, lets try once more, with feeling! */ pre,xmp, plaintext { font-family: monospace } key,code,tt { font-family: monospace } -} // @media xemacs /* ** Best we can do under Emacs-19 is use the default font and try to make @@ -100,7 +103,7 @@ ** the standard way to do this, perhaps in CSS level 2. */ input:text, -input:integer, +input:int, input:float, input:url, input:text { text-decoration: underline; } @@ -213,9 +216,11 @@ } input:text, -input:integer, +input:int, input:float, input:url, +input:file, +input:password, input:text { insert-before: "[{"; insert-after: "}]"; } select { insert-before: "[{"; insert-after: "}]"; } @@ -251,6 +256,10 @@ a:active { color : yellow } } // @media ansi-tty +/* +** Secial styles for the Emacspeak subsystem of emacs - an incredibly cool +** speech synthesizer. This was contributed by T.V. Raman (raman@adobe.com) +*/ @media speech { h1,h2,h3, h4,h5,h6 { voice-family: paul; stress: 2; richness: 9; } diff -r 4636a6841cd6 -r b980b6286996 lisp/ChangeLog --- a/lisp/ChangeLog Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/ChangeLog Mon Aug 13 09:31:12 2007 +0200 @@ -1,3 +1,40 @@ +Wed Apr 23 10:56:05 1997 Steven L Baur + + * prim/files.el (hack-local-variables-prop-line): Mistakenly + returned t when enable-local-variables was nil. + + * psgml/psgml-charent.el (sgml-display-char-list-filename): Move + iso88591.map to a proper location. + + * prim/sound.el (load-sound-file): Make sure sound files are read + as binary files. + +Tue Apr 22 02:05:38 1997 Steven L Baur + + * packages/vc.el (vc-directory): Set text properties. + + * psgml/psgml-xemacs.el (sgml-xemacs-get-popup-value): Allow for + interactive commands. + +Mon Apr 21 15:15:12 1997 Steven L Baur + + * prim/minibuf.el (input-error): New error type. + (read-from-minibuffer): Use it. + + * comint/comint.el (comint-exec-hook): Do not Customize due to + interactions with setting language environment in MULE. + +Sun Apr 20 09:36:19 1997 Steven L Baur + + * packages/info.el (Info-footnote-tag): Changing the footnote tag + from the default "Note" is broken. + +Tue Apr 22 07:01:20 1997 Hrvoje Niksic + + * prim/keydefs.el (global-map): Bind it to `C-z'. + + * prim/frame.el (suspend-emacs-or-iconify-frame): New function. + Fri Apr 18 16:45:07 1997 Steven L Baur * utils/skeleton.el (skeleton-pair-insert-maybe): Guard test with diff -r 4636a6841cd6 -r b980b6286996 lisp/comint/comint.el --- a/lisp/comint/comint.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/comint/comint.el Mon Aug 13 09:31:12 2007 +0200 @@ -371,14 +371,14 @@ :type 'hook :group 'comint) -(defcustom comint-exec-hook '() +;; This is initialized by the various language environments, do not +;; Custom-ize it. +(defvar comint-exec-hook '() "Called each time a process is exec'd by `comint-exec'. This is called after the process is cranked up. It is useful for things that must be done each time a process is executed in a comint mode buffer (e.g., `(process-kill-without-query)'). In contrast, the `comint-mode-hook' is only -executed once when the buffer is created." - :type 'hook - :group 'comint) +executed once when the buffer is created.") (defvar comint-mode-map nil) diff -r 4636a6841cd6 -r b980b6286996 lisp/comint/gdbsrc.el --- a/lisp/comint/gdbsrc.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/comint/gdbsrc.el Mon Aug 13 09:31:12 2007 +0200 @@ -294,8 +294,9 @@ (and (eq major-mode 'gdb-mode) ; doesn't work w/ energize yet (setq current-gdb-buffer (current-buffer)) ;; XEmacs change: - (make-local-hook 'kill-buffer-hook) - (add-hook 'kill-buffer-hook 'gdbsrc-reset nil t)) + (progn + (make-local-hook 'kill-buffer-hook) + (add-hook 'kill-buffer-hook 'gdbsrc-reset nil t))) (error "Cannot determine current-gdb-buffer")) ;;; (set-process-filter ;;; (get-buffer-process current-gdb-buffer) 'gdbsrc-mode-filter) @@ -502,7 +503,7 @@ epnt extent (eq (window-buffer ewin) - (extent-buffer extent)) + (extent-object extent)) (extent-start-position extent) (> epnt (extent-start-position extent)) (> (extent-end-position extent) epnt)))) @@ -513,7 +514,7 @@ ;; stig@hackvan.com (and extent ; FIXME - I'm such a sinner... (eq (current-buffer) - (extent-buffer extent)) + (extent-object extent)) (> (point) (extent-start-position extent)) (>= (extent-end-position extent) (point)))) @@ -563,8 +564,8 @@ (let ((gbuf (or gdbsrc-associated-buffer current-gdb-buffer))) (cond ((eq (current-buffer) gbuf) (and gdb-arrow-extent - (extent-buffer gdb-arrow-extent) - (progn (pop-to-buffer (extent-buffer gdb-arrow-extent)) + (extent-object gdb-arrow-extent) + (progn (pop-to-buffer (extent-object gdb-arrow-extent)) (goto-char (extent-start-position gdb-arrow-extent))))) ((buffer-name gbuf) (pop-to-buffer gbuf)) ((y-or-n-p "No debugger. Start a new one? ") @@ -843,7 +844,7 @@ (ad-set-arg 2 'source) ; tell it not to select the gdb window ad-do-it (save-excursion - (let* ((buf (extent-buffer gdb-arrow-extent)) + (let* ((buf (extent-object gdb-arrow-extent)) (win (get-buffer-window buf))) (setq gdbsrc-last-src-buffer buf) (select-window win) diff -r 4636a6841cd6 -r b980b6286996 lisp/custom/ChangeLog --- a/lisp/custom/ChangeLog Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/custom/ChangeLog Mon Aug 13 09:31:12 2007 +0200 @@ -1,135 +1,3 @@ -Thu Apr 17 18:55:15 1997 Per Abrahamsen - - * Version 1.89 released. - -Thu Apr 17 11:23:20 1997 Per Abrahamsen - - * cus-edit.el (custom-toggle-hide): New function. - (custom-level-action): Use it. - (custom-group-menu): Ditto. - (custom-face-menu): Ditto. - (custom-variable-menu): Ditto. - - * cus-edit.el (custom-redraw): Goto old line and column instead of - old character position. This is more tolerant for changes. - - * wid-edit.el (widget-choice-action): Only notify parent if - something was chosen. - - * widget.texi (Sexp Types): Documented `function-item' and - `variable-item'. - (group): New subsection. - (Widget Browser): New section. - (Widget Minor Mode): New sextion. - - * wid-edit.el: Moved widget minor mode support to - `wid-browse.el'. - - * custom.el (custom-declare-group): Make sure initial members - aren't duplicated even if the `defgroup' is evaluated twice. - - * custom.el (custom-declare-variable): Use `append' instead of - `copy-list'. - - * widget.texi (checklist): Documented `:greedy'. - -Wed Apr 16 19:24:47 1997 Per Abrahamsen - - * Version 1.88 released. - -Wed Apr 16 13:28:37 1997 Per Abrahamsen - - * wid-edit.el (widget-minor-mode): New variable and command. - (widget-minor-mode-map): New variable. - Add to `'minor-mode-alist' and `minor-mode-map-alist'. - * widget.el: Added autoload. - - * wid-edit.el (widget-specify-inactive): Set priority. - - * wid-edit.el (widget-move): Skip inactive widgets. - - * cus-edit.el (custom-display-unselected-match): Matched too many - displays. - - * Version 1.87 released. - -Wed Apr 16 00:15:26 1997 Per Abrahamsen - - * wid-edit.el (widget-field-face): Changed default background - color. - - * custom.el (custom-declare-variable): Set `custom-get' the right - place. - - * cus-edit.el (custom-magic): Don't notify the parent. - - * cus-edit.el (custom-variable-menu): Allow more actions on - `changed' and `rogue' states. - - * custom.el (custom-initialize-set): New function. - (custom-initialize-reset): New function. - (custom-initialize-changed): New function. - (custom-declare-variable): Use `custom-initialize-set' as - default for `:initialize'. - - * Version 1.86 released. - -Wed Apr 16 00:02:19 1997 Per Abrahamsen - - * cus-edit.el (custom-save-variables): Save :require symbols. - - * Version 1.85 released. - -Tue Apr 15 11:56:16 1997 Per Abrahamsen - - * custom.el (:initialize, :set, :get, :request): New keywords. - (custom-declare-variable): Support them. - (custom-set-variables): Ditto. - (defcustom): Document them. - (custom-initialize-default): New function. - * custom.texi (Declaring Variables): Documented them. - * cus-edit.el (custom-variable-value-create): Support them. - (custom-variable-set): Ditto. - (custom-variable-save): Ditto. - (custom-variable-reset-saved): Ditto. - (custom-variable-reset-factory): Ditto. - (custom-variable-state-set): Ditto. - - * cus-edit.el (custom-menu-filter): New function. - (custom-variable-menu): New format. - (custom-variable-action): Use it. - (custom-face-menu): New format. - (custom-face-action): Use it. - (custom-group-menu): New format. - (custom-group-action): Use it. - - * wid-edit.el (widget-choose): Accept unselectable items. - - * wid-edit.el (widget-default-create): Clear undo buffer. - (widget-default-delete): Ditto. - - * cus-edit.el (customize-other-window): New function. - - * cus-face.el (custom-frame-parameter): Replace - `frame-parameter'. - (custom-background-mode, custom-extract-frame-properties, - custom-get-frame-properties): Updated callers. - - * custom.el: Minor doc fixes from RMS. - - * cus-face.el (custom-declare-face): Protest when dumping defface - in Emacs. - - * wid-edit.el (widget-info-link-action): Steal mouse up event. - - * wid-edit.el (widget-specify-insert): Use old style backquote. - Patch by "William M. Perry" . - -Sun Apr 13 19:19:33 1997 Per Abrahamsen - - * custom.texi (Declaring Faces): Documentation property symbol is - `face-documentation'. - Sat Apr 12 18:31:22 1997 Per Abrahamsen * Version 1.84 released. diff -r 4636a6841cd6 -r b980b6286996 lisp/custom/cus-edit.el --- a/lisp/custom/cus-edit.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/custom/cus-edit.el Mon Aug 13 09:31:12 2007 +0200 @@ -4,13 +4,11 @@ ;; ;; Author: Per Abrahamsen ;; Keywords: help, faces -;; Version: 1.89 +;; Version: 1.84 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: ;; -;; This file implements the code to create and edit customize buffers. -;; ;; See `custom.el'. ;;; Code: @@ -19,10 +17,6 @@ (require 'wid-edit) (require 'easymenu) -(condition-case nil - (require 'cus-load) - (error nil)) - (define-widget-keywords :custom-prefixes :custom-menu :custom-show :custom-magic :custom-state :custom-level :custom-form :custom-set :custom-save :custom-reset-current :custom-reset-saved @@ -342,23 +336,6 @@ (list (if (equal val "") v (intern val))))) -(defun custom-menu-filter (menu widget) - "Convert MENU to the form used by `widget-choose'. -MENU should be in the same format as `custom-variable-menu'. -WIDGET is the widget to apply the filter entries of MENU on." - (let ((result nil) - current name action filter) - (while menu - (setq current (car menu) - name (nth 0 current) - action (nth 1 current) - filter (nth 2 current) - menu (cdr menu)) - (if (or (null filter) (funcall filter widget)) - (push (cons name action) result) - (push name result))) - (nreverse result))) - ;;; Unlispify. (defvar custom-prefix-list nil @@ -568,21 +545,6 @@ (custom-buffer-create (list (list symbol 'custom-group)))) ;;;###autoload -(defun customize-other-window (symbol) - "Customize SYMBOL, which must be a customization group." - (interactive (list (completing-read "Customize group: (default emacs) " - obarray - (lambda (symbol) - (get symbol 'custom-group)) - t))) - - (when (stringp symbol) - (if (string-equal "" symbol) - (setq symbol 'emacs) - (setq symbol (intern symbol)))) - (custom-buffer-create-other-window (list (list symbol 'custom-group)))) - -;;;###autoload (defun customize-variable (symbol) "Customize SYMBOL, which must be a variable." (interactive (custom-variable-prompt)) @@ -955,7 +917,6 @@ "Show and manipulate state for a customization option." :format "%v" :action 'widget-choice-item-action - :notify 'ignore :value-get 'ignore :value-create 'custom-magic-value-create :value-delete 'widget-children-value-delete) @@ -1015,7 +976,15 @@ (defun custom-level-action (widget &optional event) "Toggle visibility for parent to WIDGET." - (custom-toggle-hide (widget-get widget :parent))) + (let* ((parent (widget-get widget :parent)) + (state (widget-get parent :custom-state))) + (cond ((memq state '(invalid modified)) + (error "There are unset changes")) + ((eq state 'hidden) + (widget-put parent :custom-state 'unknown)) + (t + (widget-put parent :custom-state 'hidden))) + (custom-redraw parent))) ;;; The `custom' Widget. @@ -1103,20 +1072,14 @@ (defun custom-redraw (widget) "Redraw WIDGET with current settings." - (let ((line (count-lines (point-min) (point))) - (column (current-column)) - (pos (point)) + (let ((pos (point)) (from (marker-position (widget-get widget :from))) (to (marker-position (widget-get widget :to)))) (save-excursion (widget-value-set widget (widget-value widget)) (custom-redraw-magic widget)) (when (and (>= pos from) (<= pos to)) - (condition-case nil - (progn - (goto-line line) - (move-to-column column)) - (error nil))))) + (goto-char pos)))) (defun custom-redraw-magic (widget) "Redraw WIDGET state with current settings." @@ -1165,17 +1128,6 @@ "Load all dependencies for WIDGET." (custom-load-symbol (widget-value widget))) -(defun custom-toggle-hide (widget) - "Toggle visibility of WIDGET." - (let ((state (widget-get widget :custom-state))) - (cond ((memq state '(invalid modified)) - (error "There are unset changes")) - ((eq state 'hidden) - (widget-put widget :custom-state 'unknown)) - (t - (widget-put widget :custom-state 'hidden))) - (custom-redraw widget))) - ;;; The `custom-variable' Widget. (defface custom-variable-sample-face '((t (:underline t))) @@ -1229,10 +1181,8 @@ (tag (widget-get widget :tag)) (type (custom-variable-type symbol)) (conv (widget-convert type)) - (get (or (get symbol 'custom-get) 'default-value)) - (set (or (get symbol 'custom-set) 'set-default)) (value (if (default-boundp symbol) - (funcall get symbol) + (default-value symbol) (widget-get conv :value)))) ;; If the widget is new, the child determine whether it is hidden. (cond (state) @@ -1262,7 +1212,7 @@ ((get symbol 'factory-value) (car (get symbol 'factory-value))) ((default-boundp symbol) - (custom-quote (funcall get symbol))) + (custom-quote (default-value symbol))) (t (custom-quote (widget-get conv :value)))))) (push (widget-create-child-and-convert @@ -1294,9 +1244,8 @@ (defun custom-variable-state-set (widget) "Set the state of WIDGET." (let* ((symbol (widget-value widget)) - (get (or (get symbol 'custom-get) 'default-value)) (value (if (default-boundp symbol) - (funcall get symbol) + (default-value symbol) (widget-get widget :value))) tmp (state (cond ((setq tmp (get symbol 'customized-value)) @@ -1321,41 +1270,17 @@ (widget-put widget :custom-state state))) (defvar custom-variable-menu - '(("Hide" custom-toggle-hide - (lambda (widget) - (not (memq (widget-get widget :custom-state) '(modified invalid))))) - ("Edit" custom-variable-edit - (lambda (widget) - (not (eq (widget-get widget :custom-form) 'edit)))) - ("Edit Lisp" custom-variable-edit-lisp - (lambda (widget) - (not (eq (widget-get widget :custom-form) 'lisp)))) - ("Set" custom-variable-set - (lambda (widget) - (eq (widget-get widget :custom-state) 'modified))) - ("Save" custom-variable-save - (lambda (widget) - (memq (widget-get widget :custom-state) '(modified set changed rogue)))) - ("Reset to Current" custom-redraw - (lambda (widget) - (and (default-boundp (widget-value widget)) - (memq (widget-get widget :custom-state) '(modified))))) - ("Reset to Saved" custom-variable-reset-saved - (lambda (widget) - (and (get (widget-value widget) 'saved-value) - (memq (widget-get widget :custom-state) - '(modified set changed rogue))))) - ("Reset to Factory Settings" custom-variable-reset-factory - (lambda (widget) - (and (get (widget-value widget) 'factory-value) - (memq (widget-get widget :custom-state) - '(modified set changed saved rogue)))))) + '(("Edit" . custom-variable-edit) + ("Edit Lisp" . custom-variable-edit-lisp) + ("Set" . custom-variable-set) + ("Save" . custom-variable-save) + ("Reset to Current" . custom-redraw) + ("Reset to Saved" . custom-variable-reset-saved) + ("Reset to Factory Settings" . custom-variable-reset-factory)) "Alist of actions for the `custom-variable' widget. -Each entry has the form (NAME ACTION FILTER) where NAME is the name of -the menu entry, ACTION is the function to call on the widget when the -menu is selected, and FILTER is a predicate which takes a `custom-variable' -widget as an argument, and returns non-nil if ACTION is valid on that -widget. If FILTER is nil, ACTION is always valid.") +The key is a string containing the name of the action, the value is a +lisp function taking the widget as an element which will be called +when the action is chosen.") (defun custom-variable-action (widget &optional event) "Show the menu for `custom-variable' WIDGET. @@ -1367,8 +1292,7 @@ (let* ((completion-ignore-case t) (answer (widget-choose (custom-unlispify-tag-name (widget-get widget :value)) - (custom-menu-filter custom-variable-menu - widget) + custom-variable-menu event))) (if answer (funcall answer widget))))) @@ -1387,34 +1311,32 @@ (defun custom-variable-set (widget) "Set the current 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))) - (symbol (widget-value widget)) - (set (or (get symbol 'custom-set) 'set-default)) - val) + (let ((form (widget-get widget :custom-form)) + (state (widget-get widget :custom-state)) + (child (car (widget-get widget :children))) + (symbol (widget-value widget)) + val) (cond ((eq state 'hidden) (error "Cannot set hidden variable.")) ((setq val (widget-apply child :validate)) (goto-char (widget-get val :from)) (error "%s" (widget-get val :error))) ((eq form 'lisp) - (funcall set symbol (eval (setq val (widget-value child)))) + (set-default symbol (eval (setq val (widget-value child)))) (put symbol 'customized-value (list val))) (t - (funcall set symbol (setq val (widget-value child))) + (set-default symbol (setq val (widget-value child))) (put symbol 'customized-value (list (custom-quote val))))) (custom-variable-state-set widget) (custom-redraw-magic widget))) (defun custom-variable-save (widget) "Set the default 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))) - (symbol (widget-value widget)) - (set (or (get symbol 'custom-set) 'set-default)) - val) + (let ((form (widget-get widget :custom-form)) + (state (widget-get widget :custom-state)) + (child (car (widget-get widget :children))) + (symbol (widget-value widget)) + val) (cond ((eq state 'hidden) (error "Cannot set hidden variable.")) ((setq val (widget-apply child :validate)) @@ -1422,12 +1344,12 @@ (error "%s" (widget-get val :error))) ((eq form 'lisp) (put symbol 'saved-value (list (widget-value child))) - (funcall set symbol (eval (widget-value child)))) + (set-default symbol (eval (widget-value child)))) (t (put symbol 'saved-value (list (custom-quote (widget-value child)))) - (funcall set symbol (widget-value child)))) + (set-default symbol (widget-value child)))) (put symbol 'customized-value nil) (custom-save-all) (custom-variable-state-set widget) @@ -1435,11 +1357,10 @@ (defun custom-variable-reset-saved (widget) "Restore the saved value for the variable being edited by WIDGET." - (let* ((symbol (widget-value widget)) - (set (or (get symbol 'custom-set) 'set-default))) + (let ((symbol (widget-value widget))) (if (get symbol 'saved-value) (condition-case nil - (funcall set symbol (eval (car (get symbol 'saved-value)))) + (set-default symbol (eval (car (get symbol 'saved-value)))) (error nil)) (error "No saved value for %s" symbol)) (put symbol 'customized-value nil) @@ -1448,10 +1369,9 @@ (defun custom-variable-reset-factory (widget) "Restore the factory setting for the variable being edited by WIDGET." - (let* ((symbol (widget-value widget)) - (set (or (get symbol 'custom-set) 'set-default))) + (let ((symbol (widget-value widget))) (if (get symbol 'factory-value) - (funcall set symbol (eval (car (get symbol 'factory-value)))) + (set-default symbol (eval (car (get symbol 'factory-value)))) (error "No factory default for %S" symbol)) (put symbol 'customized-value nil) (when (get symbol 'saved-value) @@ -1608,7 +1528,9 @@ (defun custom-display-unselected-match (widget value) "Non-nil if VALUE is an unselected display specification." - (not (custom-display-match-frame value (selected-frame)))) + (and (listp value) + (eq (length value) 2) + (not (custom-display-match-frame value (selected-frame))))) (define-widget 'custom-face-selected 'group "Edit the attributes of the selected display in a face specification." @@ -1656,32 +1578,17 @@ (message "Creating face editor...done"))) (defvar custom-face-menu - '(("Hide" custom-toggle-hide - (lambda (widget) - (not (memq (widget-get widget :custom-state) '(modified invalid))))) - ("Edit Selected" custom-face-edit-selected - (lambda (widget) - (not (eq (widget-get widget :custom-form) 'selected)))) - ("Edit All" custom-face-edit-all - (lambda (widget) - (not (eq (widget-get widget :custom-form) 'all)))) - ("Edit Lisp" custom-face-edit-lisp - (lambda (widget) - (not (eq (widget-get widget :custom-form) 'lisp)))) - ("Set" custom-face-set) - ("Save" custom-face-save) - ("Reset to Saved" custom-face-reset-saved - (lambda (widget) - (get (widget-value widget) 'saved-face))) - ("Reset to Factory Setting" custom-face-reset-factory - (lambda (widget) - (get (widget-value widget) 'factory-face)))) + '(("Edit Selected" . custom-face-edit-selected) + ("Edit All" . custom-face-edit-all) + ("Edit Lisp" . custom-face-edit-lisp) + ("Set" . custom-face-set) + ("Save" . custom-face-save) + ("Reset to Saved" . custom-face-reset-saved) + ("Reset to Factory Setting" . custom-face-reset-factory)) "Alist of actions for the `custom-face' widget. -Each entry has the form (NAME ACTION FILTER) where NAME is the name of -the menu entry, ACTION is the function to call on the widget when the -menu is selected, and FILTER is a predicate which takes a `custom-face' -widget as an argument, and returns non-nil if ACTION is valid on that -widget. If FILTER is nil, ACTION is always valid.") +The key is a string containing the name of the action, the value is a +lisp function taking the widget as an element which will be called +when the action is chosen.") (defun custom-face-edit-selected (widget) "Edit selected attributes of the value of WIDGET." @@ -1723,9 +1630,7 @@ (let* ((completion-ignore-case t) (symbol (widget-get widget :value)) (answer (widget-choose (custom-unlispify-tag-name symbol) - (custom-menu-filter custom-face-menu - widget) - event))) + custom-face-menu event))) (if answer (funcall answer widget))))) @@ -1946,33 +1851,15 @@ (message "Creating group... done"))))) (defvar custom-group-menu - '(("Hide" custom-toggle-hide - (lambda (widget) - (not (memq (widget-get widget :custom-state) '(modified invalid))))) - ("Set" custom-group-set - (lambda (widget) - (eq (widget-get widget :custom-state) 'modified))) - ("Save" custom-group-save - (lambda (widget) - (memq (widget-get widget :custom-state) '(modified set)))) - ("Reset to Current" custom-group-reset-current - (lambda (widget) - (and (default-boundp (widget-value widget)) - (memq (widget-get widget :custom-state) '(modified))))) - ("Reset to Saved" custom-group-reset-saved - (lambda (widget) - (and (get (widget-value widget) 'saved-value) - (memq (widget-get widget :custom-state) '(modified set))))) - ("Reset to Factory" custom-group-reset-factory - (lambda (widget) - (and (get (widget-value widget) 'factory-value) - (memq (widget-get widget :custom-state) '(modified set saved)))))) + '(("Set" . custom-group-set) + ("Save" . custom-group-save) + ("Reset to Current" . custom-group-reset-current) + ("Reset to Saved" . custom-group-reset-saved) + ("Reset to Factory" . custom-group-reset-factory)) "Alist of actions for the `custom-group' widget. -Each entry has the form (NAME ACTION FILTER) where NAME is the name of -the menu entry, ACTION is the function to call on the widget when the -menu is selected, and FILTER is a predicate which takes a `custom-group' -widget as an argument, and returns non-nil if ACTION is valid on that -widget. If FILTER is nil, ACTION is always valid.") +The key is a string containing the name of the action, the value is a +lisp function taking the widget as an element which will be called +when the action is chosen.") (defun custom-group-action (widget &optional event) "Show the menu for `custom-group' WIDGET. @@ -1984,8 +1871,7 @@ (let* ((completion-ignore-case t) (answer (widget-choose (custom-unlispify-tag-name (widget-get widget :value)) - (custom-menu-filter custom-group-menu - widget) + custom-group-menu event))) (if answer (funcall answer widget))))) @@ -2086,26 +1972,17 @@ (princ "\n")) (princ "(custom-set-variables") (mapatoms (lambda (symbol) - (let ((value (get symbol 'saved-value)) - (requests (get symbol 'custom-requests)) - (now (not (or (get symbol 'factory-value) - (and (not (boundp symbol)) - (not (get symbol 'force-value))))))) + (let ((value (get symbol 'saved-value))) (when value (princ "\n '(") (princ symbol) (princ " ") (prin1 (car value)) - (cond (requests - (if now - (princ " t ") - (princ " nil ")) - (prin1 requests) - (princ ")")) - (now - (princ " t)")) - (t - (princ ")"))))))) + (if (or (get symbol 'factory-value) + (and (not (boundp symbol)) + (not (get symbol 'force-value)))) + (princ ")") + (princ " t)")))))) (princ ")") (unless (looking-at "\n") (princ "\n"))))) @@ -2287,7 +2164,7 @@ (easy-menu-define custom-mode-customize-menu custom-mode-map - "Menu used to customize customization buffers." + "Menu used in customization buffers." (customize-menu-create 'customize)) (easy-menu-define custom-mode-menu diff -r 4636a6841cd6 -r b980b6286996 lisp/custom/cus-face.el --- a/lisp/custom/cus-face.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/custom/cus-face.el Mon Aug 13 09:31:12 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen ;; Keywords: help, faces -;; Version: 1.89 +;; Version: 1.84 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -37,20 +37,13 @@ 'face-font-name 'face-font)) - (eval-and-compile - (cond ((fboundp 'frame-property) - ;; XEmacs. - (defalias 'custom-frame-parameter 'frame-property)) - ((fboundp 'frame-parameter) - ;; Emacs 19.35. - (defalias 'custom-frame-parameter 'frame-parameter)) - (t - ;; Old emacsen. - (defun custom-frame-parameter (frame property &optional default) - "Return FRAME's value for property PROPERTY." - (or (cdr (assq property (frame-parameters frame))) - default)))) + (unless (fboundp 'frame-property) + ;; XEmacs function missing in Emacs. + (defun frame-property (frame property &optional default) + "Return FRAME's value for property PROPERTY." + (or (cdr (assq property (frame-parameters frame))) + default))) (unless (fboundp 'face-doc-string) ;; XEmacs function missing in Emacs. @@ -153,12 +146,12 @@ ;; (interactive (list (read-face-name "Reverse face: "))) ;; (let ((fg (or (face-foreground face frame) ;; (face-foreground 'default frame) -;; (custom-frame-parameter (or frame (selected-frame)) +;; (frame-property (or frame (selected-frame)) ;; 'foreground-color) ;; "black")) ;; (bg (or (face-background face frame) ;; (face-background 'default frame) -;; (custom-frame-parameter (or frame (selected-frame)) +;; (frame-property (or frame (selected-frame)) ;; 'background-color) ;; "white"))) ;; (set-face-foreground face bg frame) @@ -184,7 +177,7 @@ (mode (cond (bg-resource (intern (downcase bg-resource))) ((and (setq color (condition-case () - (or (custom-frame-parameter + (or (frame-property frame 'background-color) (custom-face-background @@ -208,16 +201,16 @@ (list 'type (device-type (frame-device frame)) 'class (device-class (frame-device frame)) 'background (or custom-background-mode - (custom-frame-parameter frame + (frame-property frame 'background-mode) (custom-background-mode frame)))) ;; Emacs. (defun custom-extract-frame-properties (frame) "Return a plist with the frame properties of FRAME used by custom." (list 'type window-system - 'class (custom-frame-parameter frame 'display-type) + 'class (frame-property frame 'display-type) 'background (or custom-background-mode - (custom-frame-parameter frame 'background-mode) + (frame-property frame 'background-mode) (custom-background-mode frame)))))) ;;; Declaring a face. @@ -225,9 +218,7 @@ ;;;###autoload (defun custom-declare-face (face spec doc &rest args) "Like `defface', but FACE is evaluated as a normal argument." - (when (or (fboundp 'load-gc) ;XEmacs. - ;; Emacs. - (and (boundp purify-flag) purify-flag)) + (when (fboundp 'load-gc) ;; This should be allowed, somehow. (error "Attempt to declare a face during dump")) (unless (get face 'factory-face) @@ -452,7 +443,7 @@ If FRAME is nil, return the default frame properties." (cond (frame ;; Try to get from cache. - (let ((cache (custom-frame-parameter frame 'custom-properties))) + (let ((cache (frame-property frame 'custom-properties))) (unless cache ;; Oh well, get it then. (setq cache (custom-extract-frame-properties frame)) diff -r 4636a6841cd6 -r b980b6286996 lisp/custom/custom.el --- a/lisp/custom/custom.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/custom/custom.el Mon Aug 13 09:31:12 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen ;; Keywords: help, faces -;; Version: 1.89 +;; Version: 1.84 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -21,14 +21,12 @@ (require 'widget) -(define-widget-keywords :initialize :set :get :require :prefix :tag - :load :link :options :type :group) +(define-widget-keywords :prefix :tag :load :link :options :type :group) ;; These autoloads should be deleted eventually. (unless (fboundp 'load-gc) ;; From cus-edit.el (autoload 'customize "cus-edit" nil t) - (autoload 'customize-other-window "cus-edit" nil t) (autoload 'customize-variable "cus-edit" nil t) (autoload 'customize-variable-other-window "cus-edit" nil t) (autoload 'customize-face "cus-edit" nil t) @@ -50,62 +48,14 @@ ;;; The `defcustom' Macro. -(defun custom-initialize-default (symbol value) - "Initialize SYMBOL with VALUE. -This will do nothing if symbol already has a default binding. -Otherwise, if symbol has a `saved-value' property, it will evaluate -the car of that and used as the default binding for symbol. -Otherwise, VALUE will be evaluated and used as the default binding for -symbol." +(defun custom-declare-variable (symbol value doc &rest args) + "Like `defcustom', but SYMBOL and VALUE are evaluated as normal arguments." + ;; Bind this variable unless it already is bound. (unless (default-boundp symbol) ;; Use the saved value if it exists, otherwise the factory setting. (set-default symbol (if (get symbol 'saved-value) (eval (car (get symbol 'saved-value))) - (eval value))))) - -(defun custom-initialize-set (symbol value) - "Initialize SYMBOL with VALUE. -Like `custom-initialize-default', but use the function specified by -`:set' to initialize SYMBOL." - (unless (default-boundp symbol) - (funcall (or (get symbol 'custom-set) 'set-default) - symbol - (if (get symbol 'saved-value) - (eval (car (get symbol 'saved-value))) - (eval value))))) - -(defun custom-initialize-reset (symbol value) - "Initialize SYMBOL with VALUE. -Like `custom-initialize-set', but use the function specified by -`:get' to reinitialize SYMBOL if it is already bound." - (funcall (or (get symbol 'custom-set) 'set-default) - symbol - (cond ((default-boundp symbol) - (funcall (or (get symbol 'custom-get) 'default-value) - symbol)) - ((get symbol 'saved-value) - (eval (car (get symbol 'saved-value)))) - (t - (eval value))))) - -(defun custom-initialize-changed (symbol value) - "Initialize SYMBOL with VALUE. -Like `custom-initialize-reset', but only use the `:set' function if the -not using the factory setting. Otherwise, use the `set-default'." - (cond ((default-boundp symbol) - (funcall (or (get symbol 'custom-set) 'set-default) - symbol - (funcall (or (get symbol 'custom-get) 'default-value) - symbol))) - ((get symbol 'saved-value) - (funcall (or (get symbol 'custom-set) 'set-default) - symbol - (eval (car (get symbol 'saved-value))))) - (t - (set-default symbol (eval value))))) - -(defun custom-declare-variable (symbol value doc &rest args) - "Like `defcustom', but SYMBOL and VALUE are evaluated as normal arguments." + (eval value)))) ;; Remember the factory setting. (put symbol 'factory-value (list value)) ;; Maybe this option was rogue in an earlier version. It no longer is. @@ -114,42 +64,29 @@ (put symbol 'force-value nil)) (when doc (put symbol 'variable-documentation doc)) - (let ((initialize 'custom-initialize-set) - (requests nil)) - (while args - (let ((arg (car args))) + (while args + (let ((arg (car args))) + (setq args (cdr args)) + (unless (symbolp arg) + (error "Junk in args %S" args)) + (let ((keyword arg) + (value (car args))) + (unless args + (error "Keyword %s is missing an argument" keyword)) (setq args (cdr args)) - (unless (symbolp arg) - (error "Junk in args %S" args)) - (let ((keyword arg) - (value (car args))) - (unless args - (error "Keyword %s is missing an argument" keyword)) - (setq args (cdr args)) - (cond ((eq keyword :initialize) - (setq initialize value)) - ((eq keyword :set) - (put symbol 'custom-set value)) - ((eq keyword :get) - (put symbol 'custom-get value)) - ((eq keyword :require) - (push value requests)) - ((eq keyword :type) - (put symbol 'custom-type value)) - ((eq keyword :options) - (if (get symbol 'custom-options) - ;; Slow safe code to avoid duplicates. - (mapcar (lambda (option) - (custom-add-option symbol option)) - value) - ;; Fast code for the common case. - (put symbol 'custom-options (append value nil)))) - (t - (custom-handle-keyword symbol keyword value - 'custom-variable)))))) - (put symbol 'custom-requests requests) - ;; Do the actual initialization. - (funcall initialize symbol value)) + (cond ((eq keyword :type) + (put symbol 'custom-type value)) + ((eq keyword :options) + (if (get symbol 'custom-options) + ;; Slow safe code to avoid duplicates. + (mapcar (lambda (option) + (custom-add-option symbol option)) + value) + ;; Fast code for the common case. + (put symbol 'custom-options (copy-list value)))) + (t + (custom-handle-keyword symbol keyword value + 'custom-variable)))))) (run-hooks 'custom-define-hook) symbol) @@ -165,27 +102,12 @@ The following KEYWORD's are defined: -:type VALUE should be a widget type for editing the symbols value. - The default is `sexp'. +:type VALUE should be a widget type. :options VALUE should be a list of valid members of the widget type. :group VALUE should be a customization group. Add SYMBOL to that group. -:initialize VALUE should be a function used to initialize the - variable. It takes two arguments, the symbol and value - given in the `defcustom' call. The default is - `custom-initialize-default' -:set VALUE should be a function to set the value of the symbol. - It takes two arguments, the symbol to set and the value to - give it. The default is `set-default'. -:get VALUE should be a function to extract the value of symbol. - The function takes one argument, a symbol, and should return - the current value for that symbol. The default is - `default-value'. -:require VALUE should be a feature symbol. Each feature will be - required after initialization, of the the user have saved this - option. -Read the section about customization in the Emacs Lisp manual for more +Read the section about customization in the emacs lisp manual for more information." `(eval-and-compile (custom-declare-variable (quote ,symbol) (quote ,value) ,doc ,@args))) @@ -235,7 +157,7 @@ `background' (what color is used for the background text) Should be one of `light' or `dark'. -Read the section about customization in the Emacs Lisp manual for more +Read the section about customization in the emacs lisp manual for more information." `(custom-declare-face (quote ,face) ,spec ,doc ,@args)) @@ -243,9 +165,6 @@ (defun custom-declare-group (symbol members doc &rest args) "Like `defgroup', but SYMBOL is evaluated as a normal argument." - (while members - (apply 'custom-add-to-group symbol (car members)) - (setq members (cdr members))) (put symbol 'custom-group (nconc members (get symbol 'custom-group))) (when doc (put symbol 'group-documentation doc)) @@ -287,7 +206,7 @@ :group VALUE should be a customization group. Add SYMBOL to that group. -Read the section about customization in the Emacs Lisp manual for more +Read the section about customization in the emacs lisp manual for more information." `(custom-declare-group (quote ,symbol) ,members ,doc ,@args)) @@ -368,22 +287,17 @@ (while args (let ((entry (car args))) (if (listp entry) - (let* ((symbol (nth 0 entry)) - (value (nth 1 entry)) - (now (nth 2 entry)) - (requests (nth 3 entry)) - (set (or (get symbol 'custom-set) 'set-default))) + (let ((symbol (nth 0 entry)) + (value (nth 1 entry)) + (now (nth 2 entry))) (put symbol 'saved-value (list value)) (cond (now ;; Rogue variable, set it now. (put symbol 'force-value t) - (funcall set symbol (eval value))) + (set-default symbol (eval value))) ((default-boundp symbol) ;; Something already set this, overwrite it. - (funcall set symbol (eval value)))) - (when requests - (put symbol 'custom-requests requests) - (mapcar 'require requests)) + (set-default symbol (eval value)))) (setq args (cdr args))) ;; Old format, a plist of SYMBOL VALUE pairs. (message "Warning: old format `custom-set-variables'") diff -r 4636a6841cd6 -r b980b6286996 lisp/custom/wid-browse.el --- a/lisp/custom/wid-browse.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/custom/wid-browse.el Mon Aug 13 09:31:12 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen ;; Keywords: extensions -;; Version: 1.89 +;; Version: 1.84 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -245,37 +245,6 @@ (put :button 'widget-keyword-printer 'widget-browse-widget) (put :args 'widget-keyword-printer 'widget-browse-sexps) -;;; Widget Minor Mode. - -(defvar widget-minor-mode nil - "I non-nil, we are in Widget Minor Mode.") - (make-variable-buffer-local 'widget-minor-mode) - -(defvar widget-minor-mode-map nil - "Keymap used in Widget Minor Mode.") - -(unless widget-minor-mode-map - (setq widget-minor-mode-map (make-sparse-keymap)) - (set-keymap-parent widget-minor-mode-map widget-keymap)) - -;;;###autoload -(defun widget-minor-mode (&optional arg) - "Togle minor mode for traversing widgets. -With arg, turn widget mode on if and only if arg is positive." - (interactive "P") - (cond ((null arg) - (setq widget-minor-mode (not widget-minor-mode))) - ((<= 0 arg) - (setq widget-minor-mode nil)) - (t - (setq widget-minor-mode t))) - (force-mode-line-update)) - -(add-to-list 'minor-mode-alist '(widget-minor-mode " Widget")) - -(add-to-list 'minor-mode-map-alist - (cons 'widget-minor-mode widget-minor-mode-map)) - ;;; The End: (provide 'wid-browse) diff -r 4636a6841cd6 -r b980b6286996 lisp/custom/wid-edit.el --- a/lisp/custom/wid-edit.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/custom/wid-edit.el Mon Aug 13 09:31:12 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen ;; Keywords: extensions -;; Version: 1.89 +;; Version: 1.84 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -58,7 +58,7 @@ ;; We have the old custom-library, hack around it! (defmacro defgroup (&rest args) nil) (defmacro defcustom (var value doc &rest args) - (` (defvar (, var) (, value) (, doc)))) + `(defvar ,var ,value ,doc)) (defmacro defface (&rest args) nil) (define-widget-keywords :prefix :tag :load :link :options :type :group) (when (fboundp 'copy-face) @@ -117,7 +117,7 @@ (defface widget-field-face '((((class grayscale color) (background light)) - (:background "gray85")) + (:background "light gray")) (((class grayscale color) (background dark)) (:background "dark gray")) @@ -167,9 +167,7 @@ "Choose an item from a list. First argument TITLE is the name of the list. -Second argument ITEMS is an list whose members are either - (NAME . VALUE), to indicate selectable items, or just strings to - indicate unselectable items. +Second argument ITEMS is an alist (NAME . VALUE). Optional third argument EVENT is an input event. The user is asked to choose between each NAME from the items alist, @@ -190,9 +188,7 @@ (mapcar (function (lambda (x) - (if (stringp x) - (vector x nil nil) - (vector (car x) (list (car x)) t)))) + (vector (car x) (list (car x)) t))) items))))) (setq val (and val (listp (event-object val)) @@ -200,7 +196,6 @@ (car (event-object val)))) (cdr (assoc val items)))) (t - (setq items (remove-if 'stringp items)) (let ((val (completing-read (concat title ": ") items nil t))) (if (stringp val) (let ((try (try-completion val items))) @@ -376,8 +371,7 @@ (defmacro widget-specify-insert (&rest form) ;; Execute FORM without inheriting any text properties. - (` - (save-restriction + `(save-restriction (let ((inhibit-read-only t) result after-change-functions) @@ -385,11 +379,11 @@ (narrow-to-region (- (point) 2) (point)) (widget-specify-none (point-min) (point-max)) (goto-char (1+ (point-min))) - (setq result (progn (,@ form))) + (setq result (progn ,@form)) (delete-region (point-min) (1+ (point-min))) (delete-region (1- (point-max)) (point-max)) (goto-char (point-max)) - result)))) + result))) (defface widget-inactive-face '((((class grayscale color) (background dark)) @@ -407,8 +401,7 @@ (unless (widget-get widget :inactive) (let ((overlay (make-overlay from to nil t nil))) (overlay-put overlay 'face 'widget-inactive-face) - (overlay-put overlay 'evaporate t) - (overlay-put overlay 'priority 100) + (overlay-put overlay 'evaporate 't) (overlay-put overlay (if (string-match "XEmacs" emacs-version) 'read-only 'modification-hooks) '(widget-overlay-inactive)) @@ -790,9 +783,8 @@ (t (error "No buttons or fields found")))))) (setq button (widget-at (point))) - (if (or (and button (widget-get button :tab-order) - (< (widget-get button :tab-order) 0)) - (and button (not (widget-apply button :active)))) + (if (and button (widget-get button :tab-order) + (< (widget-get button :tab-order) 0)) (setq arg (1+ arg)))))) (while (< arg 0) (if (= (point-min) (point)) @@ -829,9 +821,8 @@ (button (goto-char button)) (field (goto-char field))) (setq button (widget-at (point))) - (if (or (and button (widget-get button :tab-order) - (< (widget-get button :tab-order) 0)) - (and button (not (widget-apply button :active)))) + (if (and button (widget-get button :tab-order) + (< (widget-get button :tab-order) 0)) (setq arg (1- arg))))) (widget-echo-help (point)) (run-hooks 'widget-move-hook)) @@ -1079,8 +1070,7 @@ (set-marker-insertion-type from t) (set-marker-insertion-type to nil) (widget-put widget :from from) - (widget-put widget :to to))) - (widget-clear-undo)) + (widget-put widget :to to)))) (defun widget-default-format-handler (widget escape) ;; We recognize the %h escape by default. @@ -1142,8 +1132,7 @@ ;; Kludge: this doesn't need to be true for empty formats. (delete-region from to)) (set-marker from nil) - (set-marker to nil)) - (widget-clear-undo)) + (set-marker to nil))) (defun widget-default-value-set (widget value) ;; Recreate widget with new value. @@ -1291,17 +1280,7 @@ (defun widget-info-link-action (widget &optional event) "Open the info node specified by WIDGET." - (Info-goto-node (widget-value widget)) - ;; Steal button release event. - (if (and (fboundp 'button-press-event-p) - (fboundp 'next-command-event)) - ;; XEmacs - (and event - (button-press-event-p event) - (next-command-event)) - ;; Emacs - (when (memq 'down (event-modifiers event)) - (read-event)))) + (Info-goto-node (widget-value widget))) ;;; The `url-link' Widget. @@ -1511,8 +1490,11 @@ (widget-value-set widget (widget-apply current :value-to-external (widget-get current :value))) - (widget-apply widget :notify widget event) - (widget-setup)))) + (widget-apply widget :notify widget event) + (widget-setup))) + ;; Notify parent. + (widget-apply widget :notify widget event) + (widget-clear-undo)) (defun widget-choice-validate (widget) ;; Valid if we have made a valid choice. @@ -1568,7 +1550,7 @@ ;; Toggle value. (widget-value-set widget (not (widget-value widget))) (widget-apply widget :notify widget event)) - + ;;; The `checkbox' Widget. (define-widget 'checkbox 'toggle diff -r 4636a6841cd6 -r b980b6286996 lisp/custom/widget-example.el --- a/lisp/custom/widget-example.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/custom/widget-example.el Mon Aug 13 09:31:12 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen ;; Keywords: help, extensions, faces, hypermedia -;; Version: 1.89 +;; Version: 1.84 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ (require 'widget) diff -r 4636a6841cd6 -r b980b6286996 lisp/custom/widget.el --- a/lisp/custom/widget.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/custom/widget.el Mon Aug 13 09:31:12 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen ;; Keywords: help, extensions, faces, hypermedia -;; Version: 1.89 +;; Version: 1.84 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -51,8 +51,7 @@ (autoload 'widget-insert "wid-edit") (autoload 'widget-browse "wid-browse" nil t) (autoload 'widget-browse-other-window "wid-browse" nil t) - (autoload 'widget-browse-at "wid-browse" nil t) - (autoload 'widget-minor-mode "wid-browse" nil t)) + (autoload 'widget-browse-at "wid-browse" nil t)) (defun define-widget (name class doc &rest args) "Define a new widget type named NAME from CLASS. diff -r 4636a6841cd6 -r b980b6286996 lisp/edebug/edebug.el --- a/lisp/edebug/edebug.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/edebug/edebug.el Mon Aug 13 09:31:12 2007 +0200 @@ -29,7 +29,7 @@ ;; LCD Archive Entry: ;; edebug|Daniel LaLiberte|liberte@cs.uiuc.edu ;; |A source level debugger for Emacs Lisp. -;; |$Date: 1997/04/13 03:13:54 $|$Revision: 1.4 $|~/modes/edebug.el| +;; |$Date: 1997/04/24 03:59:43 $|$Revision: 1.5 $|~/modes/edebug.el| ;; This minor mode allows programmers to step through Emacs Lisp ;; source code while executing functions. You can also set @@ -87,7 +87,7 @@ ;;; Code: (defconst edebug-version - (let ((raw-version "$Revision: 1.4 $")) + (let ((raw-version "$Revision: 1.5 $")) (substring raw-version (string-match "[0-9.]*" raw-version) (match-end 0)))) @@ -128,6 +128,11 @@ ;;; Options +(defgroup edebug nil + "A source-level debugger for Emacs Lisp" + :group 'lisp) + + (defvar edebug-setup-hook nil "*Functions to call before edebug is used. Each time it is set to a new value, Edebug will call those functions @@ -135,7 +140,7 @@ to load up Edebug specifications associated with a package you are using but only when you also use Edebug.") -(defvar edebug-all-defs nil +(defcustom edebug-all-defs nil "*If non-nil, evaluation of any defining forms will instrument for Edebug. This applies to `eval-defun', `eval-region', `eval-buffer', and `eval-current-buffer'. `eval-region' is also called by @@ -144,14 +149,18 @@ You can use the command `edebug-all-defs' to toggle the value of this variable. You may wish to make it local to each buffer with \(make-local-variable 'edebug-all-defs) in your -`emacs-lisp-mode-hook'.") - -(defvar edebug-all-forms nil +`emacs-lisp-mode-hook'." + :type 'boolean + :group 'edebug) + +(defcustom edebug-all-forms nil "*Non-nil evaluation of all forms will instrument for Edebug. This doesn't apply to loading or evaluations in the minibuffer. -Use the command `edebug-all-forms' to toggle the value of this option.") - -(defvar edebug-eval-macro-args nil +Use the command `edebug-all-forms' to toggle the value of this option." + :type 'boolean + :group 'edebug) + +(defcustom edebug-eval-macro-args nil "*Non-nil means all macro call arguments may be evaluated. If this variable is nil, the default, Edebug will *not* wrap macro call arguments as if they will be evaluated. @@ -159,15 +168,19 @@ So to specify exceptions for macros that have some arguments evaluated and some not, you should specify an `edebug-form-spec'. -This option is going away soon.") - -(defvar edebug-stop-before-symbols nil +This option is going away soon." + :type 'boolean + :group 'edebug) + +(defcustom edebug-stop-before-symbols nil "*Non-nil causes Edebug to stop before symbols as well as after. In any case, a breakpoint or interrupt may stop before a symbol. -This option is going away soon.") - -(defvar edebug-save-windows t +This option is going away soon." + :type 'boolean + :group 'edebug) + +(defcustom edebug-save-windows t "*If non-nil, Edebug saves and restores the window configuration. That takes some time, so if your program does not care what happens to the window configurations, it is better to set this variable to nil. @@ -175,9 +188,11 @@ If the value is a list, only the listed windows are saved and restored. -`edebug-toggle-save-windows' may be used to change this variable.") - -(defvar edebug-save-displayed-buffer-points nil +`edebug-toggle-save-windows' may be used to change this variable." + :type '(choice boolean (repeat string)) + :group 'edebug) + +(defcustom edebug-save-displayed-buffer-points nil "*If non-nil, save and restore point in all displayed buffers. Saving and restoring point in other buffers is necessary if you are @@ -187,50 +202,71 @@ Saving and restoring point in all buffers is expensive, since it requires selecting each window twice, so enable this only if you need -it.") - -(defvar edebug-initial-mode 'step +it." + :type 'boolean + :group 'edebug) + +(defcustom edebug-initial-mode 'step "*Initial execution mode for Edebug, if non-nil. If this variable is non-@code{nil}, it specifies the initial execution mode for Edebug when it is first activated. Possible values are step, next, go, -Go-nonstop, trace, Trace-fast, continue, and Continue-fast.") - -(defvar edebug-trace nil +Go-nonstop, trace, Trace-fast, continue, and Continue-fast." + :type '(choice (const step) (const next) (const go) + (const Go-nonstop) (const trace) + (const Trace-fast) (const continue) + (const continue-fast)) + :group 'edebug) + +(defcustom edebug-trace nil "*Non-nil means display a trace of function entry and exit. Tracing output is displayed in a buffer named `*edebug-trace*', one function entry or exit per line, indented by the recursion level. You can customize by replacing functions `edebug-print-trace-before' -and `edebug-print-trace-after'.") - -(defvar edebug-test-coverage nil +and `edebug-print-trace-after'." + :type 'boolean + :group 'edebug) + +(defcustom edebug-test-coverage nil "*If non-nil, Edebug tests coverage of all expressions debugged. This is done by comparing the result of each expression with the previous result. Coverage is considered OK if two different results are found. Use `edebug-display-freq-count' to display the frequency count and -coverage information for a definition.") - -(defvar edebug-continue-kbd-macro nil +coverage information for a definition." + :type 'boolean + :group 'edebug) + +(defcustom edebug-continue-kbd-macro nil "*If non-nil, continue defining or executing any keyboard macro. -Use this with caution since it is not debugged.") - - -(defvar edebug-print-length 50 - "*Default value of `print-length' to use while printing results in Edebug.") -(defvar edebug-print-level 50 - "*Default value of `print-level' to use while printing results in Edebug.") -(defvar edebug-print-circle t - "*Default value of `print-circle' to use while printing results in Edebug.") - -(defvar edebug-unwrap-results nil +Use this with caution since it is not debugged." + :type 'boolean + :group 'edebug) + + +(defcustom edebug-print-length 50 + "*Default value of `print-length' to use while printing results in Edebug." + :type 'integer + :group 'edebug) +(defcustom edebug-print-level 50 + "*Default value of `print-level' to use while printing results in Edebug." + :type 'integer + :group 'edebug) +(defcustom edebug-print-circle t + "*Default value of `print-circle' to use while printing results in Edebug." + :type 'boolean + :group 'edebug) + +(defcustom edebug-unwrap-results nil "*Non-nil if Edebug should unwrap results of expressions. This is useful when debugging macros where the results of expressions are instrumented expressions. But don't do this when results might be -circular or an infinite loop will result.") - -(defvar edebug-on-error t +circular or an infinite loop will result." + :type 'boolean + :group 'edebug) + +(defcustom edebug-on-error t "*Value bound to `debug-on-error' while Edebug is active. If `debug-on-error' is non-nil, that value is still used. @@ -239,14 +275,20 @@ these errors are signaled from Lisp code whether or not the signal is handled by a `condition-case'. This option is useful for debugging signals that *are* handled since they would otherwise be missed. -After execution is resumed, the error is signaled again.") - -(defvar edebug-on-quit t - "*Value bound to `debug-on-quit' while Edebug is active.") - -(defvar edebug-global-break-condition nil +After execution is resumed, the error is signaled again." + :type '(choice boolean (repeat string)) + :group 'edebug) + +(defcustom edebug-on-quit t + "*Value bound to `debug-on-quit' while Edebug is active." + :type 'boolean + :group 'edebug) + +(defcustom edebug-global-break-condition nil "*If non-nil, an expression to test for at every stop point. -If the result is non-nil, then break. Errors are ignored.") +If the result is non-nil, then break. Errors are ignored." + :type 'sexp + :group 'edebug) ;;; Form spec utilities. diff -r 4636a6841cd6 -r b980b6286996 lisp/gnats/gnats.el --- a/lisp/gnats/gnats.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/gnats/gnats.el Mon Aug 13 09:31:12 2007 +0200 @@ -1019,7 +1019,7 @@ "%s/gnats/npr-edit" "%s/gnats/pr-edit") gnats:libdir) -; (if gnats:network-server (list "--host" gnats:network-server)) + (if gnats:network-server (format "--host=%s" gnats:network-server)) args )) diff -r 4636a6841cd6 -r b980b6286996 lisp/gnus/ChangeLog --- a/lisp/gnus/ChangeLog Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/gnus/ChangeLog Mon Aug 13 09:31:12 2007 +0200 @@ -1,3 +1,90 @@ +Sat Apr 19 06:11:31 1997 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v5.4.46 is released. + +Sat Apr 19 05:40:40 1997 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-read-save-file-name): Expand file name i save + dir. + +Fri Apr 18 14:25:21 1997 Hrvoje Niksic + + * gnus-art.el (gnus-signature-face): New face; use it. + +Sat Apr 19 05:32:43 1997 Kim-Minh Kaplan + + * gnus-picon.el (gnus-picons-insert-face-if-exists): Add picons to + list. + +Tue Apr 15 14:08:32 1997 Hrvoje Niksic + + * message.el (message-font-lock-keywords): Be a little bit more + case-insensitive. + +Wed Apr 16 02:41:31 1997 Hrvoje Niksic + + * message.el (message-insert-to): New argument FORCE. + +Sat Apr 19 05:18:10 1997 Lars Magne Ingebrigtsen + + * message.el (message-setup): Nix out undo list. + +Sat Apr 19 05:00:06 1997 Katsumi Yamaoka + + * gnus-sum.el: Redefine. + +Sat Apr 19 04:53:29 1997 Lars Magne Ingebrigtsen + + * gnus-art.el (article-display-x-face): Display all XFace + headers. + + * gnus-ems.el: appt, not appt.el. + +Sat Apr 19 04:04:42 1997 Hrvoje Niksic + + * gnus-xmas.el (gnus-xmas-summary-set-display-table): Don't nix + out in Latin1. + +Sat Apr 19 02:55:45 1997 Lars Magne Ingebrigtsen + + * message.el (message-cancel-news): Only say we cancel if we + cancel. + + * gnus-msg.el (gnus-summary-mail-crosspost-complaint): Deactivate + mark. + +Thu Apr 17 21:37:22 1997 Lars Magne Ingebrigtsen + + * message.el (message-mail-alias-type): New variable. + (message-mode): Use it. + +Wed Apr 16 00:03:37 1997 Lars Magne Ingebrigtsen + + * gnus-demon.el (gnus-demon): Ignore errors. + +Tue Apr 15 23:50:02 1997 Brad Howes + + * gnus-demon.el (gnus-demon-time-to-step): New version. + +Tue Apr 15 23:32:58 1997 Lars Magne Ingebrigtsen + + * message.el (message-send-method-alist): New variable. + (message-send): Use it. + (message-send-via-news): New function. + (message-send-via-mail): New function. + +Sun Apr 13 18:22:02 1997 Jens Lautenbacher + + * gnus.el (gnus-article-display-hook): Fix. + +Sun Apr 13 02:07:33 1997 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-get-newsgroup-headers): Protect against bogus + Lines headers. + + * gnus-cache.el (gnus-cache-possibly-enter-article): Check number + not nil. + Sat Apr 12 23:28:30 1997 Lars Magne Ingebrigtsen * gnus.el: Gnus v5.4.45 is released. diff -r 4636a6841cd6 -r b980b6286996 lisp/gnus/gnus-art.el --- a/lisp/gnus/gnus-art.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/gnus/gnus-art.el Mon Aug 13 09:31:12 2007 +0200 @@ -411,9 +411,17 @@ :type 'face :group 'gnus-article-buttons) -(defcustom gnus-signature-face 'italic +(defcustom gnus-signature-face 'gnus-signature-face + "Face used for highlighting a signature in the article buffer. +Obsolete; use the face `gnus-signature-face' for customizations instead." + :type 'face + :group 'gnus-article-highlight + :group 'gnus-article-signature) + +(defface gnus-signature-face + '((((type x)) + (:italic t))) "Face used for highlighting a signature in the article buffer." - :type 'face :group 'gnus-article-highlight :group 'gnus-article-signature) @@ -826,33 +834,34 @@ (nnheader-narrow-to-headers) (setq from (message-fetch-field "from")) (goto-char (point-min)) - (when (and gnus-article-x-face-command - (or force - ;; Check whether this face is censored. - (not gnus-article-x-face-too-ugly) - (and gnus-article-x-face-too-ugly from - (not (string-match gnus-article-x-face-too-ugly - from)))) - ;; Has to be present. - (re-search-forward "^X-Face: " nil t)) + (while (and gnus-article-x-face-command + (or force + ;; Check whether this face is censored. + (not gnus-article-x-face-too-ugly) + (and gnus-article-x-face-too-ugly from + (not (string-match gnus-article-x-face-too-ugly + from)))) + ;; Has to be present. + (re-search-forward "^X-Face: " nil t)) ;; We now have the area of the buffer where the X-Face is stored. (let ((beg (point)) (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t)))) - ;; We display the face. - (if (symbolp gnus-article-x-face-command) - ;; The command is a lisp function, so we call it. - (if (gnus-functionp gnus-article-x-face-command) - (funcall gnus-article-x-face-command beg end) - (error "%s is not a function" gnus-article-x-face-command)) - ;; The command is a string, so we interpret the command - ;; as a, well, command, and fork it off. - (let ((process-connection-type nil)) - (process-kill-without-query - (start-process - "article-x-face" nil shell-file-name shell-command-switch - gnus-article-x-face-command)) - (process-send-region "article-x-face" beg end) - (process-send-eof "article-x-face"))))))))) + (save-excursion + ;; We display the face. + (if (symbolp gnus-article-x-face-command) + ;; The command is a lisp function, so we call it. + (if (gnus-functionp gnus-article-x-face-command) + (funcall gnus-article-x-face-command beg end) + (error "%s is not a function" gnus-article-x-face-command)) + ;; The command is a string, so we interpret the command + ;; as a, well, command, and fork it off. + (let ((process-connection-type nil)) + (process-kill-without-query + (start-process + "article-x-face" nil shell-file-name shell-command-switch + gnus-article-x-face-command)) + (process-send-region "article-x-face" beg end) + (process-send-eof "article-x-face")))))))))) (defalias 'gnus-decode-rfc1522 'article-decode-rfc1522) (defalias 'gnus-article-decode-rfc1522 'article-decode-rfc1522) @@ -1450,7 +1459,8 @@ default-name)) ;; A single split name was found ((= 1 (length split-name)) - (let* ((name (car split-name)) + (let* ((name (expand-file-name + (car split-name) gnus-article-save-directory)) (dir (cond ((file-directory-p name) (file-name-as-directory name)) ((file-exists-p name) name) diff -r 4636a6841cd6 -r b980b6286996 lisp/gnus/gnus-cache.el --- a/lisp/gnus/gnus-cache.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/gnus/gnus-cache.el Mon Aug 13 09:31:12 2007 +0200 @@ -144,7 +144,8 @@ (mail-header-set-number headers (cdr result)))) (let ((number (mail-header-number headers)) file dir) - (when (and (> number 0) ; Reffed article. + (when (and number + (> number 0) ; Reffed article. (or force (and (or (not gnus-uncacheable-groups) (not (string-match diff -r 4636a6841cd6 -r b980b6286996 lisp/gnus/gnus-demon.el --- a/lisp/gnus/gnus-demon.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/gnus/gnus-demon.el Mon Aug 13 09:31:12 2007 +0200 @@ -150,21 +150,35 @@ "Find out how many seconds to TIME, which is on the form \"17:43\"." (if (not (stringp time)) time - (let* ((date (current-time-string)) - (dv (timezone-parse-date date)) - (tdate (timezone-make-arpa-date - (string-to-number (aref dv 0)) - (string-to-number (aref dv 1)) - (string-to-number (aref dv 2)) time - (or (aref dv 4) "UT"))) - (nseconds (gnus-time-minus - (gnus-encode-date tdate) (gnus-encode-date date)))) - (round - (/ (+ (if (< (car nseconds) 0) - 86400 0) - (* 65536 (car nseconds)) - (nth 1 nseconds)) - gnus-demon-timestep))))) + (let* ((now (current-time)) + ;; obtain NOW as discrete components -- make a vector for speed + (nowParts (apply 'vector (decode-time now))) + ;; obtain THEN as discrete components + (thenParts (timezone-parse-time time)) + (thenHour (string-to-int (elt thenParts 0))) + (thenMin (string-to-int (elt thenParts 1))) + ;; convert time as elements into number of seconds since EPOCH. + (then (encode-time 0 + thenMin + thenHour + ;; If THEN is earlier than NOW, make it + ;; same time tomorrow. Doc for encode-time + ;; says that this is OK. + (+ (elt nowParts 3) + (if (or (< thenHour (elt nowParts 2)) + (and (= thenHour (elt nowParts 2)) + (<= thenMin (elt nowParts 1)))) + 1 0)) + (elt nowParts 4) + (elt nowParts 5) + (elt nowParts 6) + (elt nowParts 7) + (elt nowParts 8))) + ;; calculate number of seconds between NOW and THEN + (diff (+ (* 65536 (- (car then) (car now))) + (- (cadr then) (cadr now))))) + ;; return number of timesteps in the number of seconds + (round (/ diff gnus-demon-timestep))))) (defun gnus-demon () "The Gnus daemon that takes care of running all Gnus handlers." @@ -200,7 +214,7 @@ (t (< 0 gnus-demon-idle-time)))) ; Or just need to be idle. ;; So we call the handler. (progn - (funcall (car handler)) + (ignore-errors (funcall (car handler))) ;; And reset the timer. (setcar (nthcdr 1 handler) (gnus-demon-time-to-step @@ -212,14 +226,14 @@ ((not (numberp idle)) ;; We want to call this handler each and every time that ;; Emacs is idle. - (funcall (car handler))) + (ignore-errors (funcall (car handler)))) (t ;; We want to call this handler only if Emacs has been idle ;; for a specified number of timesteps. (and (not (memq (car handler) gnus-demon-idle-has-been-called)) (< idle gnus-demon-idle-time) (progn - (funcall (car handler)) + (ignore-errors (funcall (car handler))) ;; Make sure the handler won't be called once more in ;; this idle-cycle. (push (car handler) gnus-demon-idle-has-been-called))))))))) diff -r 4636a6841cd6 -r b980b6286996 lisp/gnus/gnus-ems.el --- a/lisp/gnus/gnus-ems.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/gnus/gnus-ems.el Mon Aug 13 09:31:12 2007 +0200 @@ -38,7 +38,7 @@ (eval-and-compile (autoload 'gnus-xmas-define "gnus-xmas") (autoload 'gnus-xmas-redefine "gnus-xmas") - (autoload 'appt-select-lowest-window "appt.el")) + (autoload 'appt-select-lowest-window "appt")) (or (fboundp 'mail-file-babyl-p) (fset 'mail-file-babyl-p 'rmail-file-p)) diff -r 4636a6841cd6 -r b980b6286996 lisp/gnus/gnus-group.el --- a/lisp/gnus/gnus-group.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/gnus/gnus-group.el Mon Aug 13 09:31:12 2007 +0200 @@ -602,8 +602,7 @@ (gnus-group-group-name)] ["Info" gnus-group-edit-group (gnus-group-group-name)] ["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)] - ["Global kill file" gnus-group-edit-global-kill t]) - )) + ["Global kill file" gnus-group-edit-global-kill t]))) (easy-menu-define gnus-group-group-menu gnus-group-mode-map "" @@ -693,8 +692,7 @@ ["Find new newsgroups" gnus-find-new-newsgroups t] ["Transpose" gnus-group-transpose-groups (gnus-group-group-name)] - ["Read a directory as a group..." gnus-group-enter-directory t] - )) + ["Read a directory as a group..." gnus-group-enter-directory t])) (easy-menu-define gnus-group-misc-menu gnus-group-mode-map "" @@ -725,8 +723,7 @@ ["Flush score cache" gnus-score-flush-cache t] ["Toggle topics" gnus-topic-mode t] ["Exit from Gnus" gnus-group-exit t] - ["Exit without saving" gnus-group-quit t] - )) + ["Exit without saving" gnus-group-quit t])) (run-hooks 'gnus-group-menu-hook))) diff -r 4636a6841cd6 -r b980b6286996 lisp/gnus/gnus-msg.el --- a/lisp/gnus/gnus-msg.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/gnus/gnus-msg.el Mon Aug 13 09:31:12 2007 +0200 @@ -691,6 +691,7 @@ (message-goto-subject) (re-search-forward " *$") (replace-match " (crosspost notification)" t t) + (deactivate-mark) (when (gnus-y-or-n-p "Send this complaint? ") (message-send-and-exit))))))) diff -r 4636a6841cd6 -r b980b6286996 lisp/gnus/gnus-picon.el --- a/lisp/gnus/gnus-picon.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/gnus/gnus-picon.el Mon Aug 13 09:31:12 2007 +0200 @@ -370,11 +370,12 @@ picons))) (when domainp (setq picons - (nconc (list (make-annotation - (if first (concat (if (not rightp) ".") cur - (if rightp ".")) cur) - (point) 'text nil nil nil rightp)) - picons)))) + (nconc + (list (make-annotation + (if first (concat (if (not rightp) ".") cur + (if rightp ".")) cur) + (point) 'text nil nil nil rightp)) + picons)))) (when (and bar (or domainp found)) (setq bar-ann (gnus-picons-try-to-find-face (concat gnus-xmas-glyph-directory "bar.xbm") @@ -385,9 +386,14 @@ (setq first t)) (when (and addrs domainp) (let ((it (mapconcat 'downcase (nreverse addrs) "."))) - (make-annotation - (if first (concat (if (not rightp) ".") it (if rightp ".")) it) - (point) 'text nil nil nil rightp))) + (setq picons + (nconc picons (list (make-annotation + (if first + (concat (if (not rightp) ".") + it (if rightp ".")) + it) + (point) 'text + nil nil nil rightp)))))) picons)) (defvar gnus-picons-glyph-alist nil) diff -r 4636a6841cd6 -r b980b6286996 lisp/gnus/gnus-sum.el --- a/lisp/gnus/gnus-sum.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/gnus/gnus-sum.el Mon Aug 13 09:31:12 2007 +0200 @@ -4195,7 +4195,7 @@ (progn (goto-char p) (if (search-forward "\nlines: " nil t) - (if (numberp (setq lines (read cur))) + (if (numberp (setq lines (ignore-errors (read cur)))) lines 0) 0)) ;; Xref. @@ -8679,6 +8679,8 @@ (lambda (buf) (switch-to-buffer buf) (gnus-summary-exit)) buffers))))) +(gnus-ems-redefine) + (provide 'gnus-sum) (run-hooks 'gnus-sum-load-hook) diff -r 4636a6841cd6 -r b980b6286996 lisp/gnus/gnus-xmas.el --- a/lisp/gnus/gnus-xmas.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/gnus/gnus-xmas.el Mon Aug 13 09:31:12 2007 +0200 @@ -200,7 +200,6 @@ ;; Setup the display table -- like `gnus-summary-setup-display-table', ;; but done in an XEmacsish way. (let ((table (make-display-table)) - (default-table (specifier-instance current-display-table)) (i 32)) ;; Nix out all the control chars... (while (>= (setq i (1- i)) 0) @@ -209,13 +208,10 @@ ;; selective display). (aset table ?\n nil) (aset table ?\r nil) - ;; We nix out any glyphs over 126 that are not set already. - (when default-table - (let ((i 256)) - (while (>= (setq i (1- i)) 127) - ;; Only modify if the default entry is nil. - (unless (aref default-table i) - (aset table i [??]))))) + ;; We nix out any glyphs over 126 below ctl-arrow. + (let ((i (if (integerp ctl-arrow) ctl-arrow 160))) + (while (>= (setq i (1- i)) 127) + (aset table i [??]))) ;; Can't use `set-specifier' because of a bug in 19.14 and earlier (add-spec-to-specifier current-display-table table (current-buffer) nil))) @@ -735,24 +731,22 @@ (defun gnus-xmas-article-display-xface (beg end) "Display any XFace headers in the current article." (save-excursion - (let (xface-glyph) - (if (featurep 'xface) - (setq xface-glyph - (make-glyph (vector 'xface :data - (concat "X-Face: " - (buffer-substring beg end))))) - (let ((cur (current-buffer))) - (save-excursion - (gnus-set-work-buffer) - (insert (format "%s" (buffer-substring beg end cur))) - (gnus-xmas-call-region "uncompface") - (goto-char (point-min)) - (insert "/* Width=48, Height=48 */\n") - (gnus-xmas-call-region "icontopbm") - (gnus-xmas-call-region "ppmtoxpm") - (setq xface-glyph - (make-glyph - (vector 'xpm :data (buffer-string ))))))) + (let ((xface-glyph + (if (featurep 'xface) + (make-glyph (vector 'xface :data + (concat "X-Face: " + (buffer-substring beg end)))) + (let ((cur (current-buffer))) + (save-excursion + (gnus-set-work-buffer) + (insert (format "%s" (buffer-substring beg end cur))) + (gnus-xmas-call-region "uncompface") + (goto-char (point-min)) + (insert "/* Width=48, Height=48 */\n") + (gnus-xmas-call-region "icontopbm") + (gnus-xmas-call-region "ppmtoxpm") + (make-glyph + (vector 'xpm :data (buffer-string)))))))) (set-glyph-face xface-glyph 'gnus-x-face) (goto-char (point-min)) (re-search-forward "^From:" nil t) diff -r 4636a6841cd6 -r b980b6286996 lisp/gnus/gnus.el --- a/lisp/gnus/gnus.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/gnus/gnus.el Mon Aug 13 09:31:12 2007 +0200 @@ -226,7 +226,7 @@ :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "5.4.45" +(defconst gnus-version-number "5.4.46" "Version number for this version of Gnus.") (defconst gnus-version (format "Gnus v%s" gnus-version-number) @@ -1342,7 +1342,6 @@ gnus-article-fill-cited-article gnus-article-remove-cr gnus-article-de-quoted-unreadable - gnus-article-display-x-face gnus-summary-stop-page-breaking ;; gnus-summary-caesar-message ;; gnus-summary-verbose-headers @@ -1366,7 +1365,9 @@ gnus-article-strip-leading-blank-lines gnus-article-strip-multiple-blank-lines gnus-article-strip-blank-lines - gnus-article-treat-overstrike)) + gnus-article-treat-overstrike + gnus-article-display-x-face + gnus-smiley-display)) (defcustom gnus-article-save-directory gnus-directory "*Name of the directory articles will be saved in (default \"~/News\")." diff -r 4636a6841cd6 -r b980b6286996 lisp/gnus/message.el --- a/lisp/gnus/message.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/gnus/message.el Mon Aug 13 09:31:12 2007 +0200 @@ -591,6 +591,25 @@ (defvar message-mh-deletable-headers '(Message-ID Date Lines Sender) "If non-nil, delete the deletable headers before feeding to mh.") +(defvar message-send-method-alist + '((news message-news-p message-send-via-news) + (mail message-mail-p message-send-via-mail)) + "Alist of ways to send outgoing messages. +Each element has the form + + \(TYPE PREDICATE FUNCTION) + +where TYPE is a symbol that names the method; PREDICATE is a function +called without any parameters to determine whether the message is +a message of type TYPE; and FUNCTION is a function to be called if +PREDICATE returns non-nil. FUNCTION is called with one parameter -- +the prefix.") + +(defvar message-mail-alias-type 'abbrev + "*What alias expansion type to use in Message buffers. +The default is `abbrev', which uses mailabbrev. nil switches +mail aliases off.") + ;;; Internal variables. ;;; Well, not really internal. @@ -720,16 +739,16 @@ (let* ((cite-prefix "A-Za-z") (cite-suffix (concat cite-prefix "0-9_.@-")) (content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)")) - `((,(concat "^\\(To:\\)" content) + `((,(concat "^\\([Tt]o:\\)" content) (1 'message-header-name-face) (2 'message-header-to-face nil t)) - (,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^Reply-To:\\)" content) + (,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content) (1 'message-header-name-face) (2 'message-header-cc-face nil t)) - (,(concat "^\\(Subject:\\)" content) + (,(concat "^\\([Ss]ubject:\\)" content) (1 'message-header-name-face) (2 'message-header-subject-face nil t)) - (,(concat "^\\(Newsgroups:\\|Followup-to:\\)" content) + (,(concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content) (1 'message-header-name-face) (2 'message-header-newsgroups-face nil t)) (,(concat "^\\([^: \n\t]+:\\)" content) @@ -1242,9 +1261,10 @@ (easy-menu-add message-mode-menu message-mode-map) (easy-menu-add message-mode-field-menu message-mode-map) ;; Allow mail alias things. - (if (fboundp 'mail-abbrevs-setup) - (mail-abbrevs-setup) - (funcall (intern "mail-aliases-setup"))) + (when (eq message-mail-alias-type 'abbrev) + (if (fboundp 'mail-abbrevs-setup) + (mail-abbrevs-setup) + (funcall (intern "mail-aliases-setup")))) (run-hooks 'text-mode-hook 'message-mode-hook)) @@ -1327,11 +1347,15 @@ -(defun message-insert-to () - "Insert a To header that points to the author of the article being replied to." - (interactive) +(defun message-insert-to (&optional force) + "Insert a To header that points to the author of the article being replied to. +If the original author requested not to be sent mail, the function signals +an error. +With the prefix argument FORCE, insert the header anyway." + (interactive "P") (let ((co (message-fetch-reply-field "mail-copies-to"))) - (when (and co + (when (and (null force) + co (equal (downcase co) "never")) (error "The user has requested not to have copies sent via mail"))) (when (and (message-position-on-field "To") @@ -1712,30 +1736,41 @@ (message-fix-before-sending) (run-hooks 'message-send-hook) (message "Sending...") - (when (and (or (not (message-news-p)) - (and (or (not (memq 'news message-sent-message-via)) - (y-or-n-p - "Already sent message via news; resend? ")) - (funcall message-send-news-function arg))) - (or (not (message-mail-p)) - (and (or (not (memq 'mail message-sent-message-via)) - (y-or-n-p - "Already sent message via mail; resend? ")) - (message-send-mail arg)))) - (message-do-fcc) - ;;(when (fboundp 'mail-hist-put-headers-into-history) - ;; (mail-hist-put-headers-into-history)) - (run-hooks 'message-sent-hook) - (message "Sending...done") - ;; If buffer has no file, mark it as unmodified and delete autosave. - (unless buffer-file-name - (set-buffer-modified-p nil) - (delete-auto-save-file-if-necessary t)) - ;; Delete other mail buffers and stuff. - (message-do-send-housekeeping) - (message-do-actions message-send-actions) - ;; Return success. - t))) + (let ((alist message-send-method-alist) + elem sent) + (while (setq elem (pop alist)) + (when (and (or (not (funcall (cadr elem))) + (and (or (not (memq (car elem) + message-sent-message-via)) + (y-or-n-p + (format + "Already sent message via %s; resend? " + (car elem)))) + (funcall (caddr elem) arg)))) + (setq sent t))) + (when sent + (message-do-fcc) + ;;(when (fboundp 'mail-hist-put-headers-into-history) + ;; (mail-hist-put-headers-into-history)) + (run-hooks 'message-sent-hook) + (message "Sending...done") + ;; If buffer has no file, mark it as unmodified and delete autosave. + (unless buffer-file-name + (set-buffer-modified-p nil) + (delete-auto-save-file-if-necessary t)) + ;; Delete other mail buffers and stuff. + (message-do-send-housekeeping) + (message-do-actions message-send-actions) + ;; Return success. + t)))) + +(defun message-send-via-mail (arg) + "Send the current message via mail." + (message-send-mail arg)) + +(defun message-send-via-news (arg) + "Send the current message via news." + (funcall message-send-news-function arg)) (defun message-fix-before-sending () "Do various things to make the message nice before sending it." @@ -2918,6 +2953,7 @@ (message-narrow-to-headers) (run-hooks 'message-header-setup-hook)) (set-buffer-modified-p nil) + (setq buffer-undo-list nil) (run-hooks 'message-setup-hook) (message-position-point) (undo-boundary)) @@ -3225,9 +3261,10 @@ mail-header-separator "\n" message-cancel-message) (message "Canceling your article...") - (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me)) - (funcall message-send-news-function)) - (message "Canceling your article...done") + (if (let ((message-syntax-checks + 'dont-check-for-anything-just-trust-me)) + (funcall message-send-news-function)) + (message "Canceling your article...done")) (kill-buffer buf))))) ;;;###autoload diff -r 4636a6841cd6 -r b980b6286996 lisp/gnus/nndb.el --- a/lisp/gnus/nndb.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/gnus/nndb.el Mon Aug 13 09:31:12 2007 +0200 @@ -1,10 +1,13 @@ ;;; nndb.el --- nndb access for Gnus -;; Copyright (C) 1996,97 Free Software Foundation, Inc. +;; Copyright (C) 1997 Free Software Foundation, Inc. -;; Author: Kai Grossjohann +;; Author: Masanobu UMEDA +;; Kai Grossjohann +;; Joe Hildebrand +;; David Blacka ;; Keywords: news -;; This file is part of GNU Emacs. +;; This file is NOT part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -23,23 +26,34 @@ ;;; Commentary: -;; I have shamelessly snarfed the code of nntp.el from sgnus. -;; Kai +;;; This was based upon Kai Grossjohan's shamessly snarfed code and +;;; further modified by Joe Hildebrand. It has been updated for Red +;;; Gnus. +;; TODO: +;; +;; * Fix bug where server connection can be lost and impossible to regain +;; This hasn't happened to me in a while; think it was fixed in Rgnus +;; +;; * make it handle different nndb servers seemlessly +;; +;; * Optimize expire if FORCE +;; +;; * Optimize move (only expire once) +;; +;; * Deal with add/deletion of groups +;; +;; * make the backend TOUCH an article when marked as expireable (will +;; make article expire 'expiry' days after that moment). ;;- ;; Register nndb with known select methods. -(require 'gnus) -(require 'nnmail) - -(setq gnus-valid-select-methods - (cons '("nndb" mail address respool prompt-address) - gnus-valid-select-methods)) - +(gnus-declare-backend "nndb" 'mail 'respool 'address 'prompt-address) ;;; Code: +(require 'nnmail) (require 'nnheader) (require 'nntp) (eval-when-compile (require 'cl)) @@ -68,20 +82,20 @@ (defvoo nndb-deliver-program "nndel" "*The program used to put a message in an NNDB group.") +(defvoo nndb-server-side-expiry nil + "If t, expiry calculation will occur on the server side") + +(defvoo nndb-set-expire-date-on-mark nil + "If t, the expiry date for a given article will be set to the time +it was marked as expireable; otherwise the date will be the time the +article was posted to nndb") + ;; Variables copied from nntp (defvoo nndb-server-opened-hook '(nntp-send-authinfo-from-file) "Like nntp-server-opened-hook." nntp-server-opened-hook) -;(defvoo nndb-rlogin-parameters '("telnet" "${NNDBSERVER:=localhost}" "9000") -; "*Parameters to nndb-open-login. Like nntp-rlogin-parameters." -; nntp-rlogin-parameters) - -;(defvoo nndb-rlogin-user-name nil -; "*User name for rlogin connect method." -; nntp-rlogin-user-name) - (defvoo nndb-address "localhost" "*The name of the NNDB server." nntp-address) @@ -90,15 +104,14 @@ "*Port number to connect to." nntp-port-number) -;(defvoo nndb-current-group "" -; "Like nntp-current-group." -; nntp-current-group) +;; change to 'news if you are actually using nndb for news +(defvoo nndb-article-type 'mail) (defvoo nndb-status-string nil "" nntp-status-string) -(defconst nndb-version "nndb 0.3" +(defconst nndb-version "nndb 0.7" "Version numbers of this version of NNDB.") @@ -106,114 +119,194 @@ (nnoo-define-basics nndb) -;; Import other stuff from nntp as is. +;;------------------------------------------------------------------ -(nnoo-import nndb - (nntp)) +;; this function turns the lisp list into a string list. There is +;; probably a more efficient way to do this. +(defun nndb-build-article-string (articles) + (let (art-string art) + (while articles + (setq art (pop articles)) + (setq art-string (concat art-string art " "))) + art-string)) -;;- maybe this should be mail?? -;;-(defun nndb-request-type (group &optional article) -;;- 'news) +(defun nndb-build-expire-rest-list (total expire) + (let (art rest) + (while total + (setq art (pop total)) + (if (memq art expire) + () + (push art rest))) + rest)) -;;------------------------------------------------------------------ -;;- only new stuff below - -; nndb-request-update-info does not exist and is not needed - -; nndb-request-update-mark does not exist and is not needed + +;; +(deffoo nndb-request-type (group &optional article) + nndb-article-type) -; nndb-request-scan does not exist -; get new mail from somewhere -- maybe this is not needed? -; --> todo +;; nndb-request-update-info does not exist and is not needed -(deffoo nndb-request-create-group (group &optional server args) - "Creates a group if it doesn't exist yet." - (nntp-send-command "^[23].*\n" "MKGROUP" group)) +;; nndb-request-update-mark does not exist; it should be used to TOUCH +;; articles as they are marked exipirable +(defun nndb-touch-article (group article) + (nntp-send-command nil "X-TOUCH" article)) -; todo -- use some other time than the creation time of the article -; best is time since article has been marked as expirable -(deffoo nndb-request-expire-articles +(deffoo nndb-request-update-mark + (group article mark) + "Sets the expiry date for ARTICLE in GROUP to now, if the mark is 'E'" + (if (and nndb-set-expire-date-on-mark (string-equal mark "E")) + (nndb-touch-article group article)) + mark) + +;; nndb-request-create-group -- currently this isn't necessary; nndb +;; creates groups on demand. + +;; todo -- use some other time than the creation time of the article +;; best is time since article has been marked as expirable + +(defun nndb-request-expire-articles-local (articles &optional group server force) - "Expires ARTICLES from GROUP on SERVER. -If FORCE, delete regardless of expiration date, otherwise use normal -expiry mechanism." - (let (msg art) - (nntp-possibly-change-group group server) ;;- + "Let gnus do the date check and issue the delete commands." + (let (msg art delete-list (num-delete 0) rest) + (nntp-possibly-change-group group server) (while articles (setq art (pop articles)) - (nntp-send-command "^\\([23]\\|^423\\).*\n" "DATE" art) + (nntp-send-command "^\\([23]\\|^423\\).*\n" "X-DATE" art) (setq msg (nndb-status-message)) - ;; CCC we shouldn't be using the variable nndb-status-string? - (if (string-match "^423" (nnheader-get-report 'nndb)) + (if (string-match "^423" msg) () - (unless (string-match "\\([0-9]+\\) \\([0-9]+\\)$" msg) - (error "Not a valid response for DATE command: %s" - msg)) - (if (nnmail-expired-article-p - group - (list (string-to-int - (substring msg (match-beginning 1) (match-end 1))) - (string-to-int - (substring msg (match-beginning 2) (match-end 2)))) - force) - (nnheader-message 5 "Deleting article %s in %s..." - art group) - (nntp-send-command "^[23].*\n" "DELETE" art)))))) + (or (string-match "'\\(.+\\)'" msg) + (error "Not a valid response for X-DATE command: %s" + msg)) + (if (nnmail-expired-article-p + group + (gnus-encode-date + (substring msg (match-beginning 1) (match-end 1))) + force) + (progn + (setq delete-list (concat delete-list " " (int-to-string art))) + (setq num-delete (1+ num-delete))) + (push art rest)))) + (if (> (length delete-list) 0) + (progn + (nnheader-message 5 "Deleting %s article(s) from %s" + (int-to-string num-delete) group) + (nntp-send-command "^[23].*\n" "X-DELETE" delete-list)) + ) + + (message "") + (nconc rest articles))) + +(defun nndb-get-remote-expire-response () + (let (list) + (set-buffer nntp-server-buffer) + (goto-char (point-min)) + (if (looking-at "^[34]") + ;; x-expire returned error--presume no articles were expirable) + (setq list nil) + ;; otherwise, pull all of the following numbers into the list + (re-search-forward "follows\r?\n?" nil t) + (while (re-search-forward "^[0-9]+$" nil t) + (push (string-to-int (match-string 0)) list))) + list)) + +(defun nndb-request-expire-articles-remote + (articles &optional group server force) + "Let the nndb backend expire articles" + (let (days art-string delete-list (num-delete 0)) + (nntp-possibly-change-group group server) + + ;; first calculate the wait period in days + (setq days (or (and nnmail-expiry-wait-function + (funcall nnmail-expiry-wait-function group)) + nnmail-expiry-wait)) + ;; now handle the special cases + (cond (force + (setq days 0)) + ((eq days 'never) + ;; This isn't an expirable group. + (setq days -1)) + ((eq days 'immediate) + (setq days 0))) + + + ;; build article string + (setq art-string (concat days " " (nndb-build-article-string articles))) + (nntp-send-command "^\.\r?\n\\|^[345].*\n" "X-EXPIRE" art-string) + + (setq delete-list (nndb-get-remote-expire-response)) + (setq num-delete (length delete-list)) + (if (> num-delete 0) + (nnheader-message 5 "Deleting %s article(s) from %s" + (int-to-string num-delete) group)) + + (nndb-build-expire-rest-list articles delete-list))) + +(deffoo nndb-request-expire-articles + (articles &optional group server force) + "Expires ARTICLES from GROUP on SERVER. +If FORCE, delete regardless of exiration date, otherwise use normal +expiry mechanism." + (if nndb-server-side-expiry + (nndb-request-expire-articles-remote articles group server force) + (nndb-request-expire-articles-local articles group server force))) (deffoo nndb-request-move-article - (article group server accept-form &optional last) + (article group server accept-form &optional last) "Move ARTICLE (a number) from GROUP on SERVER. Evals ACCEPT-FORM in current buffer, where the article is. Optional LAST is ignored." - (let ((artbuf (get-buffer-create " *nndb move*")) + ;; we guess that the second arg in accept-form is the new group, + ;; which it will be for nndb, which is all that matters anyway + (let ((new-group (nth 1 accept-form)) result) + (nntp-possibly-change-group group server) + + ;; use the move command for nndb-to-nndb moves + (if (string-match "^nndb" new-group) + (let ((new-group-name (gnus-group-real-name new-group))) + (nntp-send-command "^[23].*\n" "X-MOVE" article new-group-name) + (cons new-group article)) + ;; else move normally + (let ((artbuf (get-buffer-create " *nndb move*"))) + (and + (nndb-request-article article group server artbuf) + (save-excursion + (set-buffer artbuf) + (insert-buffer-substring nntp-server-buffer) + (setq result (eval accept-form)) + (kill-buffer (current-buffer)) + result) + (nndb-request-expire-articles (list article) + group + server + t)) result) - (and - (nndb-request-article article group server artbuf) - (save-excursion - (set-buffer artbuf) - (setq result (eval accept-form)) - (kill-buffer (current-buffer)) - result) - (nndb-request-expire-articles (list article) - group - server - t)) - result)) - + ))) + (deffoo nndb-request-accept-article (group server &optional last) "The article in the current buffer is put into GROUP." - (nntp-possibly-change-group group server) ;;- - (let (art statmsg) + (nntp-possibly-change-group group server) + (let (art msg) (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group) (nnheader-insert "") - (nntp-encode-text) - (nntp-send-buffer "^[23].*\n") - (setq statmsg (nntp-status-message)) - (unless (string-match "^\\([0-9]+\\)" statmsg) - (error "nndb: %s" statmsg)) - (setq art (substring statmsg - (match-beginning 1) - (match-end 1))) - (message "nndb: accepted %s" art) - (list art)))) + (nntp-send-buffer "^[23].*\n")) + + (set-buffer nntp-server-buffer) + (setq msg (buffer-string (point-min) (point-max))) + (or (string-match "^\\([0-9]+\\)" msg) + (error "nndb: %s" msg)) + (setq art (substring msg (match-beginning 1) (match-end 1))) + (message "nndb: accepted %s" art) + (list art))) (deffoo nndb-request-replace-article (article group buffer) - "ARTICLE is the number of the article in GROUP to be replaced + "ARTICLE is the number of the article in GROUP to be replaced with the contents of the BUFFER." (set-buffer buffer) - (let (art statmsg) - (when (nntp-send-command "^[23].*\r?\n" "REPLACE" (int-to-string article)) - (nnheader-insert "") - (nntp-encode-text) - (nntp-send-buffer "^[23].*\n") -; (setq statmsg (nntp-status-message)) -; (or (string-match "^\\([0-9]+\\)" statmsg) -; (error "nndb: %s" statmsg)) -; (setq art (substring statmsg -; (match-beginning 1) -; (match-end 1))) -; (message "nndb: replaced %s" art) - (list (int-to-string article))))) + (when (nntp-send-command "^[23].*\r?\n" "X-REPLACE" (int-to-string article)) + (nnheader-insert "") + (nntp-send-buffer "^[23.*\n") + (list (int-to-string article)))) ; nndb-request-delete-group does not exist ; todo -- maybe later @@ -221,6 +314,19 @@ ; nndb-request-rename-group does not exist ; todo -- maybe later +;; -- standard compatability functions + +(deffoo nndb-status-message (&optional server) + "Return server status as a string." + (set-buffer nntp-server-buffer) + (buffer-string (point-min) (point-max))) + +;; Import stuff from nntp + +(nnoo-import nndb + (nntp)) + (provide 'nndb) + diff -r 4636a6841cd6 -r b980b6286996 lisp/gnus/nnmail.el --- a/lisp/gnus/nnmail.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/gnus/nnmail.el Mon Aug 13 09:31:12 2007 +0200 @@ -395,7 +395,9 @@ '((any . "from\\|to\\|cc\\|sender\\|apparently-to\\|resent-from\\|resent-to\\|resent-cc") (mail . "mailer-daemon\\|postmaster\\|uucp") (to . "to\\|cc\\|apparently-to\\|resent-to\\|resent-cc") - (from . "from\\|sender\\|resent-from")) + (from . "from\\|sender\\|resent-from") + (nato . "to\\|cc\\|resent-to\\|resent-cc") + (naany . "from\\|to\\|cc\\|sender\\|resent-from\\|resent-to\\|resent-cc")) "Alist of abbreviations allowed in `nnmail-split-fancy'." :group 'nnmail-split :type '(repeat (cons :format "%v" symbol regexp))) diff -r 4636a6841cd6 -r b980b6286996 lisp/gnus/smiley.el --- a/lisp/gnus/smiley.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/gnus/smiley.el Mon Aug 13 09:31:12 2007 +0200 @@ -251,6 +251,7 @@ (defvar gnus-article-buffer) ;;;###autoload (defun gnus-smiley-display () + "Display \"smileys\" as small graphical icons." (interactive) (save-excursion (set-buffer gnus-article-buffer) diff -r 4636a6841cd6 -r b980b6286996 lisp/packages/gnuserv.el --- a/lisp/packages/gnuserv.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/packages/gnuserv.el Mon Aug 13 09:31:12 2007 +0200 @@ -481,7 +481,8 @@ nil ;yep (server-write-to-client (car client) nil) ;nope, tell client (setq server-clients (delq client server-clients)))) - (setq old-clients (cdr old-clients)))))))) + (setq old-clients (cdr old-clients))) + t))))) ;; Ask before killing a server buffer. diff -r 4636a6841cd6 -r b980b6286996 lisp/packages/info.el --- a/lisp/packages/info.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/packages/info.el Mon Aug 13 09:31:12 2007 +0200 @@ -387,7 +387,7 @@ changed to name of the file to decode, otherwise the file is given to the command as standard input. If STRING is nil, no decoding is done.") -(defvar Info-footnote-tag "See" +(defvar Info-footnote-tag "Note" "*Symbol that identifies a footnote or cross-reference. All \"*Note\" references will be changed to use this word instead.") diff -r 4636a6841cd6 -r b980b6286996 lisp/packages/vc.el --- a/lisp/packages/vc.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/packages/vc.el Mon Aug 13 09:31:12 2007 +0200 @@ -1179,6 +1179,7 @@ (vc-dired-reformat-line x) (forward-line 1))) ; go to next line (nreverse userlist)) + (dired-insert-set-properties (point-min) (point-max)) (setq buffer-read-only t) (goto-char (point-min)) ) @@ -1196,7 +1197,8 @@ (setq tlist (cdr tlist)) (while (not (null tlist)) (setq s (car tlist)) - (insert s " ") + (insert s) + (if (cdr tlist) (insert " ")) (setq tlist (cdr tlist))) (setq string (buffer-string)) (kill-this-buffer) diff -r 4636a6841cd6 -r b980b6286996 lisp/prim/auto-autoloads.el --- a/lisp/prim/auto-autoloads.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/prim/auto-autoloads.el Mon Aug 13 09:31:12 2007 +0200 @@ -711,14 +711,11 @@ ;;;*** -;;;### (autoloads (customize-menu-create custom-menu-create custom-save-all custom-buffer-create customize-apropos customize-customized customize-face-other-window customize-face customize-variable-other-window customize-variable customize-other-window customize) "cus-edit" "custom/cus-edit.el") +;;;### (autoloads (customize-menu-create custom-menu-create custom-save-all custom-buffer-create customize-apropos customize-customized customize-face-other-window customize-face customize-variable-other-window customize-variable customize) "cus-edit" "custom/cus-edit.el") (autoload 'customize "cus-edit" "\ Customize SYMBOL, which must be a customization group." t nil) -(autoload 'customize-other-window "cus-edit" "\ -Customize SYMBOL, which must be a customization group." t nil) - (autoload 'customize-variable "cus-edit" "\ Customize SYMBOL, which must be a variable." t nil) @@ -784,7 +781,7 @@ ;;;*** -;;;### (autoloads (widget-minor-mode widget-browse-other-window widget-browse widget-browse-at) "wid-browse" "custom/wid-browse.el") +;;;### (autoloads (widget-browse-other-window widget-browse widget-browse-at) "wid-browse" "custom/wid-browse.el") (autoload 'widget-browse-at "wid-browse" "\ Browse the widget under point." t nil) @@ -795,10 +792,6 @@ (autoload 'widget-browse-other-window "wid-browse" "\ Show widget browser for WIDGET in other window." t nil) -(autoload 'widget-minor-mode "wid-browse" "\ -Togle minor mode for traversing widgets. -With arg, turn widget mode on if and only if arg is positive." t nil) - ;;;*** ;;;### (autoloads (widget-delete widget-create widget-apply) "wid-edit" "custom/wid-edit.el") @@ -2209,7 +2202,8 @@ (autoload 'smiley-buffer "smiley" nil t nil) -(autoload 'gnus-smiley-display "smiley" nil t nil) +(autoload 'gnus-smiley-display "smiley" "\ +Display \"smileys\" as small graphical icons." t nil) ;;;*** @@ -3637,7 +3631,7 @@ ;;;### (autoloads (ksh-mode) "ksh-mode" "modes/ksh-mode.el") (autoload 'ksh-mode "ksh-mode" "\ -ksh-mode $Revision: 1.23 $ - Major mode for editing (Bourne, Korn or Bourne again) +ksh-mode $Revision: 1.24 $ - Major mode for editing (Bourne, Korn or Bourne again) shell scripts. Special key bindings and commands: \\{ksh-mode-map} @@ -4997,7 +4991,7 @@ (autoload 'vhdl-mode "vhdl-mode" "\ Major mode for editing VHDL code. -vhdl-mode $Revision: 1.23 $ +vhdl-mode $Revision: 1.24 $ 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 @@ -8800,7 +8794,7 @@ Second argument NEED-VECTOR means to return an event vector always." t nil) (autoload 'kbd "edmacro" "\ -Convert KEYS to the internal Emacs key representation." nil nil) +Convert KEYS to the internal Emacs key representation." nil 'macro) (autoload 'format-kbd-macro "edmacro" "\ Return the keyboard macro MACRO as a human-readable string. diff -r 4636a6841cd6 -r b980b6286996 lisp/prim/custom-load.el --- a/lisp/prim/custom-load.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/prim/custom-load.el Mon Aug 13 09:31:12 2007 +0200 @@ -86,7 +86,7 @@ (put 'hypermedia 'custom-loads '("wid-edit" "gopher" "browse-url" "url-vars" "w3-cus")) (put 'save-place 'custom-loads '("saveplace")) (put 'w3-advanced 'custom-loads '("w3-cus")) -(put 'lisp 'custom-loads '("cl-indent" "elp")) +(put 'lisp 'custom-loads '("edebug" "cl-indent" "elp")) (put 'jka-compr 'custom-loads '("jka-compr")) (put 'rlogin 'custom-loads '("rlogin")) (put 'proces-basics 'custom-loads '()) @@ -129,11 +129,11 @@ (put 'widget-browse 'custom-loads '("wid-browse")) (put 'data 'custom-loads '("auto-save" "crypt" "jka-compr" "recent-files" "saveplace" "time-stamp")) (put 'gnus-article 'custom-loads '("gnus-art" "gnus-cite")) +(put 'edebug 'custom-loads '("edebug")) (put 'ps-print 'custom-loads '("ps-print")) (put 'cc-indent 'custom-loads '("cc-mode")) (put 'compression 'custom-loads '("jka-compr")) (put 'comm 'custom-loads '("ssl")) -(put 'ediff-window 'custom-loads '()) (put 'gnus 'custom-loads '("gnus-art" "gnus-async" "gnus-cache" "gnus-demon" "gnus-dup" "gnus-eform" "gnus-uu" "gnus-win" "gnus-xmas" "gnus" "nnmail")) (put 'ps-print-font 'custom-loads '("ps-print")) (put 'id-select 'custom-loads '("id-select")) @@ -146,7 +146,7 @@ (put 'psgml-html 'custom-loads '("psgml-html")) (put 'nnmail 'custom-loads '("nnmail")) (put 'gnus-article-hiding 'custom-loads '("gnus-art" "gnus-sum")) -(put 'customize 'custom-loads '("cus-face" "wid-edit" "cus-edit")) +(put 'customize 'custom-loads '("wid-edit" "cus-face" "cus-edit")) (put 'w3-printing 'custom-loads '("w3-cus")) (put 'nnmail-duplicate 'custom-loads '("nnmail")) (put 'supercite-attr 'custom-loads '("supercite")) @@ -158,7 +158,6 @@ (put 'abbrev 'custom-loads '("cus-edit" "dabbrev")) (put 'f90-indent 'custom-loads '("f90")) (put 'nnmail-retrieve 'custom-loads '("nnmail")) -(put 'ediff-ptch 'custom-loads '()) (put 'url-history 'custom-loads '("url-vars")) (put 'message-interface 'custom-loads '("message")) (put 'gnus-group 'custom-loads '("gnus-topic" "gnus")) @@ -229,7 +228,6 @@ (put 'diary 'custom-loads '("calendar")) (put 'gnus-various 'custom-loads '("gnus-sum")) (put 'cc-syntax 'custom-loads '("cc-mode")) -(put 'smiley 'custom-loads '()) (put 'mh-compose 'custom-loads '("mh-comp")) (put 'xmine 'custom-loads '("xmine")) (put 'supercite-frames 'custom-loads '("supercite")) @@ -244,7 +242,6 @@ (put 'w3-hooks 'custom-loads '("w3-cus")) (put 'executable 'custom-loads '("executable")) (put 'highlight-headers 'custom-loads '("highlight-headers")) -(put 'gnus-cache 'custom-loads '()) (put 'message-insertion 'custom-loads '("message")) (put 'hyper-apropos 'custom-loads '("hyper-apropos")) (put 'psgml-insert 'custom-loads '("psgml")) diff -r 4636a6841cd6 -r b980b6286996 lisp/prim/files.el --- a/lisp/prim/files.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/prim/files.el Mon Aug 13 09:31:12 2007 +0200 @@ -1473,8 +1473,8 @@ (let ((key (car (car result))) (val (cdr (car result)))) (cond ((eq key 'mode) - (setq mode-p t) (and enable-local-variables + (setq mode-p t) (funcall (intern (concat (downcase (symbol-name val)) "-mode"))))) (set-any-p diff -r 4636a6841cd6 -r b980b6286996 lisp/prim/frame.el --- a/lisp/prim/frame.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/prim/frame.el Mon Aug 13 09:31:12 2007 +0200 @@ -721,6 +721,7 @@ map-frame-hook 'deiconify-emacs) (iconify-frame me))) + (defun deiconify-emacs (&optional ignore) (or iconification-data (error "not iconified?")) (setq frame-icon-title-format (car iconification-data) @@ -728,9 +729,9 @@ iconification-data (car (cdr (cdr iconification-data)))) (while iconification-data (let ((visibility (cdr (car iconification-data)))) - (cond ((eq visibility 't) + (cond (visibility ;; JV (Note non-nil means visible in XEmacs) (make-frame-visible (car (car iconification-data)))) -; (t ;; (eq visibility 'icon) +; (t ;; (eq visibility 'icon) ;; JV Not in XEmacs!!! ; (make-frame-visible (car (car iconification-data))) ; (sleep-for 500 t) ; process X events; I really want to XSync() here ; (iconify-frame (car (car iconification-data)))) @@ -742,13 +743,27 @@ "Calls iconify-emacs if frame is an X frame, otherwise calls suspend-emacs" (interactive) (cond - ((eq (frame-type (selected-frame)) 'x) (iconify-emacs)) - ((and (eq (frame-type (selected-frame)) 'tty) + ((eq (frame-type) 'x) + (iconify-emacs)) + ((and (eq (frame-type) 'tty) (console-tty-controlling-process (selected-console))) (suspend-console (selected-console))) (t (suspend-emacs)))) +;; This is quite a mouthful, but it should be descriptive, as it's +;; bound to C-z +(defun suspend-emacs-or-iconify-frame () + "Iconify current frame if it is an X frame, otherwise suspend Emacs." + (interactive) + (cond ((eq (frame-type) 'x) + (iconify-frame)) + ((and (eq (frame-type) 'tty) + (console-tty-controlling-process (selected-console))) + (suspend-console (selected-console))) + (t + (suspend-emacs)))) + ;;; auto-raise and auto-lower diff -r 4636a6841cd6 -r b980b6286996 lisp/prim/keydefs.el --- a/lisp/prim/keydefs.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/prim/keydefs.el Mon Aug 13 09:31:12 2007 +0200 @@ -167,7 +167,7 @@ ;; FSFmacs keyboard.c -(define-key global-map "\C-z" 'suspend-or-iconify-emacs) +(define-key global-map "\C-z" 'suspend-emacs-or-iconify-frame) (define-key global-map "\C-x\C-z" 'suspend-or-iconify-emacs) ;; FSFmacs loaddefs.el diff -r 4636a6841cd6 -r b980b6286996 lisp/prim/minibuf.el --- a/lisp/prim/minibuf.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/prim/minibuf.el Mon Aug 13 09:31:12 2007 +0200 @@ -284,6 +284,8 @@ integer) :group 'minibuffer) +(define-error 'input-error "Keyboard input error") + (defun read-from-minibuffer (prompt &optional initial-contents keymap readp @@ -436,7 +438,10 @@ ;; total total kludge (if (stringp v) (setq v (list 'quote v))) (setq val v)) - (error (setq err e)))) + (end-of-file + (setq err + '(input-error "End of input before end of expression"))) + (error (setq err e)))) ;; Add the value to the appropriate history list unless ;; it's already the most recent element, or it's only ;; two characters long. diff -r 4636a6841cd6 -r b980b6286996 lisp/prim/sound.el --- a/lisp/prim/sound.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/prim/sound.el Mon Aug 13 09:31:12 2007 +0200 @@ -76,13 +76,13 @@ (integer :tag "Duration")))))) (defcustom sound-load-alist - '((load-sound-file "sounds/drum-beep.au" 'drum) - (load-sound-file "sounds/quiet-beep.au" 'quiet) - (load-sound-file "sounds/bass-snap.au" 'bass 80) - (load-sound-file "sounds/whip.au" 'whip 70) - (load-sound-file "sounds/cuckoo.au" 'cuckoo) - (load-sound-file "sounds/yeep.au" 'yeep) - (load-sound-file "sounds/hype.au" 'hype 100) + '((load-sound-file "drum-beep.au" 'drum) + (load-sound-file "quiet-beep.au" 'quiet) + (load-sound-file "bass-snap.au" 'bass 80) + (load-sound-file "whip.au" 'whip 70) + (load-sound-file "cuckoo.au" 'cuckoo) + (load-sound-file "yeep.au" 'yeep) + (load-sound-file "hype.au" 'hype 100) ) "A list of calls to load-sound-file to be processed by load-default-sounds. @@ -92,14 +92,14 @@ :type '(repeat (sexp :tag "Sound") )) -(defcustom default-sound-directory data-directory +(defcustom default-sound-directory (concat data-directory "sounds/") "Default directory to load a sound file from." :group 'sound :type 'directory ) (defcustom sound-ext "" - "Filename extensions to complet sound file name with. If more than one + "Filename extensions to complete sound file name with. If more than one extension is used, they should be separated by \":\". " :group 'sound :type 'string) @@ -130,14 +130,16 @@ nVolume (0 for default): ") (or (symbolp sound-name) (error "sound-name not a symbol")) (or (null volume) (integerp volume) (error "volume not an integer or nil")) - (let (buf data) + (let (buf + data + (file (locate-file filename default-sound-directory-list sound-ext))) (unwind-protect (save-excursion (set-buffer (setq buf (get-buffer-create " *sound-tmp*"))) (buffer-disable-undo (current-buffer)) (erase-buffer) - (insert-file-contents - (locate-file filename default-sound-directory-list sound-ext )) + (let ((coding-system-for-read 'binary)) + (insert-file-contents file)) (setq data (buffer-string)) (erase-buffer)) (and buf (kill-buffer buf))) diff -r 4636a6841cd6 -r b980b6286996 lisp/psgml/ChangeLog --- a/lisp/psgml/ChangeLog Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/psgml/ChangeLog Mon Aug 13 09:31:12 2007 +0200 @@ -1,3 +1,13 @@ +Wed Apr 23 11:28:10 1997 Steven L Baur + + * psgml-charent.el (sgml-display-char-list-filename): Move + iso88591.map to a proper location. + +Tue Apr 22 02:05:09 1997 Steven L Baur + + * psgml-xemacs.el (sgml-xemacs-get-popup-value): Allow for + interactive function. + Sat Mar 22 19:58:27 1997 Steven L Baur * psgml-html.el (html-mode): Too many backslashes in DOCSTRING. diff -r 4636a6841cd6 -r b980b6286996 lisp/psgml/iso88591.map --- a/lisp/psgml/iso88591.map Mon Aug 13 09:30:13 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,156 +0,0 @@ -160 [nbsp ] -161 [iexcl ] -162 [cent ] -163 [pound ] -164 [curren] -165 [yen ] -166 [brvbar] -167 [sect ] -168 [uml ] -169 [copy ] -170 [ordf ] -171 [laquo ] -172 [not ] -173 [shy ] -174 [reg ] -175 [macr ] -176 [deg ] -177 [plusmn] -178 [sup2 ] -179 [sup3 ] -180 [acute ] -181 [micro ] -182 [para ] -183 [middot] -184 [cedil ] -185 [sup1 ] -186 [ordm ] -187 [raquo ] -188 [frac14] -189 [frac12] -190 [frac34] -191 [iquest] -192 [Agrave] -193 [Aacute] -194 [Acirc ] -195 [Atilde] -196 [Auml ] -197 [Aring ] -198 [AElig ] -199 [Ccedil] -200 [Egrave] -201 [Eacute] -202 [Ecirc ] -203 [Euml ] -204 [Igrave] -205 [Iacute] -206 [Icirc ] -207 [Iuml ] -208 [ETH ] -209 [Ntilde] -210 [Ograve] -211 [Oacute] -212 [Ocirc ] -213 [Otilde] -214 [Ouml ] -216 [Oslash] -217 [Ugrave] -218 [Uacute] -219 [Ucirc ] -220 [Uuml ] -221 [Yacute] -222 [THORN ] -223 [szlig ] -224 [agrave] -225 [aacute] -226 [acirc ] -227 [atilde] -228 [auml ] -229 [aring ] -230 [aelig ] -231 [ccedil] -232 [egrave] -233 [eacute] -234 [ecirc ] -235 [euml ] -236 [igrave] -237 [iacute] -238 [icirc ] -239 [iuml ] -240 [eth ] -241 [ntilde] -242 [ograve] -243 [oacute] -244 [ocirc ] -245 [otilde] -246 [ouml ] -248 [oslash] -249 [ugrave] -250 [uacute] -251 [ucirc ] -252 [uuml ] -253 [yacute] -254 [thorn ] -255 [yuml ] -192 À -193 Á -194 Â -195 Ã -196 Ä -197 Å -198 Æ -199 Ç -200 È -201 É -202 Ê -203 Ë -204 Ì -205 Í -206 Î -207 Ï -208 Ð -209 Ñ -210 Ò -211 Ó -212 Ô -213 Õ -214 Ö -216 Ø -217 Ù -218 Ú -219 Û -220 Ü -221 Ý -222 Þ -223 ß -224 à -225 á -226 â -227 ã -228 ä -229 å -230 æ -231 ç -232 è -233 é -234 ê -235 ë -236 ì -237 í -238 î -239 ï -240 ð -241 ñ -242 ò -243 ó -244 ô -245 õ -246 ö -248 ø -249 ù -250 ú -251 û -252 ü -253 ý -254 þ -255 ÿ diff -r 4636a6841cd6 -r b980b6286996 lisp/psgml/psgml-charent.el --- a/lisp/psgml/psgml-charent.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/psgml/psgml-charent.el Mon Aug 13 09:31:12 2007 +0200 @@ -1,6 +1,6 @@ ;;;; psgml-charent.el ;;; Last edited: Mon Nov 28 22:18:09 1994 by lenst@lysistrate (Lennart Staflin) -;;; $Id: psgml-charent.el,v 1.1.1.1 1996/12/18 22:43:36 steve Exp $ +;;; $Id: psgml-charent.el,v 1.2 1997/04/24 04:00:12 steve Exp $ ;; Copyright (C) 1994 Lennart Staflin @@ -37,7 +37,7 @@ ;;;; Variable declarations (defvar sgml-display-char-list-filename - "iso88591.map" + (expand-file-name "sgml/iso88591.map" data-directory) "*Name of file holding relations between character codes and character names of displayable characters") diff -r 4636a6841cd6 -r b980b6286996 lisp/psgml/psgml-html.el --- a/lisp/psgml/psgml-html.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/psgml/psgml-html.el Mon Aug 13 09:31:12 2007 +0200 @@ -28,11 +28,9 @@ ; Parts were taken from html-helper-mode and from code by Alastair Burt. -; Feb 18 1997, Heiko Muenkel: Added the hook variable html-mode-hook. -; With that you can now use the hm--html-minor-mode together -; with this mode. For that you've to add the following line -; to your ~/.emacs: -; (add-hook 'html-mode-hook 'hm--html-minor-mode) +; If you'd like to use the hm--html-minor-mode together with this +; mode, you have to put the following line to your ~/.emacs: +; (add-hook 'html-mode-hook 'hm--html-minor-mode) ;;; Code: @@ -140,11 +138,6 @@ :type '(repeat symbol) :group 'psgml-html) -(defcustom html-mode-hook nil - "*Hook called by `html-mode'." - :type 'hook - :group 'psgml-html) - ;;}}} end of user variables ;;{{{ type based keymap and menu variable and function setup @@ -253,8 +246,7 @@ ; sigh ... need to call this now to get things working. (sgml-build-custom-menus) (add-submenu nil sgml-html-menu "SGML") - (delete-menu-item '("SGML")) - (run-hooks 'html-mode-hook)) + (delete-menu-item '("SGML"))) (defun html-helper-add-type-to-alist (type) "Add a type specification to the alist. diff -r 4636a6841cd6 -r b980b6286996 lisp/psgml/psgml-xemacs.el --- a/lisp/psgml/psgml-xemacs.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/psgml/psgml-xemacs.el Mon Aug 13 09:31:12 2007 +0200 @@ -1,5 +1,5 @@ ;;;; psgml-xemacs.el --- Part of SGML-editing mode with parsing support -;; $Id: psgml-xemacs.el,v 1.1.1.1 1996/12/18 22:43:37 steve Exp $ +;; $Id: psgml-xemacs.el,v 1.2 1997/04/24 04:00:12 steve Exp $ ;; Copyright (C) 1994 Lennart Staflin @@ -80,7 +80,7 @@ (let ((value nil) (event nil)) (popup-menu menudesc) - (while (popup-menu-up-p) + (while (popup-up-p) (setq event (next-command-event event)) (cond ((menu-event-p event) (cond @@ -88,6 +88,9 @@ (signal 'quit nil)) ((eq (event-object event) 'menu-no-selection-hook) nil) + ((commandp (event-object event)) + (call-interactively (event-object event)) + (signal 'quit nil)) (t (eval (event-object event))))) ((button-release-event-p event) ; don't beep twice diff -r 4636a6841cd6 -r b980b6286996 lisp/tm/tm-view.el --- a/lisp/tm/tm-view.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/tm/tm-view.el Mon Aug 13 09:31:12 2007 +0200 @@ -4,7 +4,7 @@ ;; Author: MORIOKA Tomohiko ;; Created: 1994/7/13 (1994/8/31 obsolete tm-body.el) -;; Version: $Revision: 1.3 $ +;; Version: $Revision: 1.4 $ ;; Keywords: mail, news, MIME, multimedia ;; This file is part of tm (Tools for MIME). @@ -42,7 +42,7 @@ ;;; (defconst mime-viewer/RCS-ID - "$Id: tm-view.el,v 1.3 1997/03/08 23:26:58 steve Exp $") + "$Id: tm-view.el,v 1.4 1997/04/24 04:00:14 steve Exp $") (defconst mime-viewer/version (get-version-string mime-viewer/RCS-ID)) (defconst mime/viewer-version mime-viewer/version) @@ -178,17 +178,30 @@ (defvar mime-viewer/redisplay nil) -(defvar mime-viewer/announcement-for-message/partial - (if (and (>= emacs-major-version 19) window-system) - "\ +(defun mime-viewer/get-key-for-fun (symb) + (let ((key (where-is-internal symb)) + ) + (if key + (key-description (car key)) + "v"))) + +(defun mime-viewer/announcement-for-message/partial () + (let ((key (mime-viewer/get-key-for-fun 'mime-viewer/play-content))) + (if (and (>= emacs-major-version 19) window-system) + (concat + "\ \[[ This is message/partial style split message. ]] -\[[ Please press `v' key in this buffer ]] -\[[ or click here by mouse button-2. ]]" - "\ +\[[ Please press `" + key + "' in this buffer ]] +\[[ or click here by mouse button-2. ]]") + (concat + "\ \[[ This is message/partial style split message. ]] -\[[ Please press `v' key in this buffer. ]]" - )) - +\[[ Please press `" + key + "' in this buffer. ]]") + ))) ;;; @@ predicate functions ;;; @@ -579,7 +592,7 @@ ) (let ((be (point-max))) (narrow-to-region be be) - (insert mime-viewer/announcement-for-message/partial) + (insert (mime-viewer/announcement-for-message/partial)) (tm:add-button (point-min)(point-max) (function mime-viewer/play-content)) ))) diff -r 4636a6841cd6 -r b980b6286996 lisp/utils/edmacro.el --- a/lisp/utils/edmacro.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/utils/edmacro.el Mon Aug 13 09:31:12 2007 +0200 @@ -5,7 +5,7 @@ ;; Author: Dave Gillespie ;; Hrvoje Niksic -- XEmacs port ;; Maintainer: Hrvoje Niksic -;; Version: 3.09 +;; Version: 3.10 ;; Keywords: abbrev ;; This file is part of XEmacs. @@ -26,6 +26,10 @@ ;; 02111-1307, USA. ;;; Synched up with: FSF 19.34. +;;; The important parts of this file have been rewritten for XEmacs, +;;; so it's completely different from the FSF version. The original +;;; could not be used because it worked with the Emacs key +;;; representation, and it mixed characters and integers too freely. ;;; Commentary: @@ -54,13 +58,15 @@ ;; This and `format-kbd-macro' can also be called directly as ;; Lisp functions. -;; The `kbd' function is a shorter name for `read-kbd-macro'. It is -;; good to use in your programs and initializations, as you needn't -;; know the internal keysym representation. For example: +;; The `kbd' macro is a shorter-named and more efficient form of +;; `read-kbd-macro'. Unlike `read-kbd-macro', it is evaluated at +;; read-time, and doesn't bring any overhead to compiled programs. It +;; is recommended to use in your programs and initializations, as you +;; needn't know the internal keysym representation. For example: ;; ;; (define-key foo-mode-map (kbd "C-c ") 'foo-up) ;; -;; is the equivalent of +;; is the exact equivalent of ;; ;; (define-key foo-mode-map [(control ?c) up] 'foo-up) ;; @@ -226,7 +232,7 @@ (setq last-kbd-macro (edmacro-parse-keys (buffer-substring start end))))) ;;;###autoload -(defun kbd (keys) +(defmacro kbd (keys) "Convert KEYS to the internal Emacs key representation." (read-kbd-macro keys)) @@ -370,7 +376,7 @@ is ignored. Whitespace in the macro must be written explicitly, as in \"foo SPC bar RET\". - * The special words RET, SPC, TAB, DEL, LFD, ESC, and NUL represent + * The special words RET, SPC, TAB, DEL, BS, LFD, ESC, and NUL represent special control characters. The words must be written in uppercase. * A word in angle brackets, e.g., , , or , represents @@ -422,7 +428,8 @@ (char-to-int int) int)) -;;; Formatting a keyboard macro as human-readable text. + +;;; Parsing a human-readable keyboard macro. ;; Changes for XEmacs -- these two functions re-written from scratch. ;; edmacro-parse-keys always returns a vector. edmacro-format-keys @@ -431,7 +438,7 @@ (defun edmacro-parse-keys (string &optional ignored) (let* ((pos 0) (case-fold-search nil) - (word-to-sym '(("NUL" . (control space)) + (word-to-sym '(("NUL" . ?\0) ("RET" . return) ("LFD" . linefeed) ("TAB" . tab) @@ -675,6 +682,8 @@ (setq new (nconc new k))) new)) +;;; Formatting a keyboard macro as human-readable text. + (defun edmacro-format-keys (macro &optional verbose) ;; XEmacs: ;; If we're dealing with events, convert them to symbols first. @@ -778,9 +787,6 @@ "supported by this command")))) (incf i)))) macro) - -;;; Parsing a human-readable keyboard macro. - ;;; The following probably ought to go in macros.el: diff -r 4636a6841cd6 -r b980b6286996 lisp/version.el --- a/lisp/version.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/version.el Mon Aug 13 09:31:12 2007 +0200 @@ -25,7 +25,7 @@ (defconst emacs-version "20.2" "Version numbers of this version of Emacs.") -(setq emacs-version (purecopy (concat emacs-version " XEmacs Lucid (beta1)"))) +(setq emacs-version (purecopy (concat emacs-version " XEmacs Lucid (beta2)"))) (defconst emacs-major-version (progn (or (string-match "^[0-9]+" emacs-version) diff -r 4636a6841cd6 -r b980b6286996 lisp/vm/Makefile --- a/lisp/vm/Makefile Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/vm/Makefile Mon Aug 13 09:31:12 2007 +0200 @@ -2,17 +2,9 @@ # Allowed values are 18 and 19. # Version 18 of Emacs is UNSUPPORTED. # In fact all versions of Emacs prior to 19.34 for Emacs and -# prior to 19.14 for XEmacs are unsupported. +# prior to 19.14 for XEmacs are unsupported. For v20 XEmacs +# EMACS_VERSION should remain 19. # -# Currently only vm-isearch-forward depends on the EMACS_VERSION -# setting being correct. You can use the same VM .elc files -# under v18 and v19 Emacs if you don't care about -# vm-isearch-forward. -# -# Note that .elc files compiled with the v19 byte compiler won't -# work under v18 Emacs, but v18 .elcs will work under v19. So -# point this at your v18 Emacs binary if you want compatible .elc -# files. EMACS_VERSION = 19 # what emacs is called on your system @@ -26,6 +18,7 @@ # where the toolbar pixmaps should go. # vm-toolbar-pixmap-directory must point to the same place. +# vm-image-directory must point to the same place. PIXMAPDIR = /usr/local/lib/emacs/etc/vm ############## no user servicable parts beyond this point ################### diff -r 4636a6841cd6 -r b980b6286996 lisp/vm/vm-autoload.el --- a/lisp/vm/vm-autoload.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/vm/vm-autoload.el Mon Aug 13 09:31:12 2007 +0200 @@ -74,8 +74,14 @@ to be forwarded. See the docs for vm-reorder-message-headers to find out how KEEP-LIST and DISCARD-REGEXP are used. -Returns the multipart boundary parameter (string) that should be used -in the Content-Type header." nil nil) +If ALWAYS-USE-DIGEST is non-nil, always encapsulate for a multipart/digest. +Otherwise if there are fewer than two messages to be encapsulated +leave off the multipart boundary strings. The caller is assumed to +be using message/rfc822 or message/news encoding instead. + +If multipart/digest encapsulation is done, the function returns +the multipart boundary parameter (string) that should be used in +the Content-Type header. Otherwise nil is returned." nil nil) (autoload (quote vm-mime-burst-message) "vm-digest" "Burst messages from the digest message M. M should be a message struct for a real message. @@ -1420,8 +1426,6 @@ (autoload (quote vm-mime-composite-type-p) "vm-mime" nil nil nil) -(autoload (quote vm-mime-map-atomic-layouts) "vm-mime" nil nil nil) - (autoload (quote vm-minibuffer-complete-word) "vm-minibuf" nil t nil) (autoload (quote vm-minibuffer-complete-word-and-exit) "vm-minibuf" nil t nil) @@ -1941,10 +1945,10 @@ The current message will be copied to a Mail mode buffer and you can edit the message and send it as usual. -NOTE: since you are doing a resend, a Resent-To header is -provided for you to fill in. If you don't fill it in, when you -send the message it will go to the original recipients listed in -the To and Cc headers. You may also create a Resent-Cc header." t nil) +NOTE: since you are doing a resend, a Resent-To header is provided +for you to fill in the new recipient list. If you don't fill in +this header, what happens when you send the message is undefined. +You may also create a Resent-Cc header." t nil) (autoload (quote vm-send-digest) "vm-reply" "Send a digest of all messages in the current folder to recipients. The type of the digest is specified by the variable vm-digest-send-type. @@ -2042,8 +2046,9 @@ This command should NOT be used to save message to mail folders; use vm-save-message instead (normally bound to `s')." t nil) -(autoload (quote vm-pipe-message-to-command) "vm-save" "Run shell command with the some or all of the current message as input. -By default the entire message is used. +(autoload (quote vm-pipe-message-to-command) "vm-save" "Runs a shell command with some or all of the contents of the +current message as input. +By default, the entire message is used. With one \\[universal-argument] the text portion of the message is used. With two \\[universal-argument]'s the header portion of the message is used. With three \\[universal-argument]'s the visible header portion of the message @@ -2204,7 +2209,7 @@ (autoload (quote vm-mode) "vm-startup" "Major mode for reading mail. -This is VM 6.27. +This is VM 6.29. Commands: h - summarize folder contents diff -r 4636a6841cd6 -r b980b6286996 lisp/vm/vm-digest.el --- a/lisp/vm/vm-digest.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/vm/vm-digest.el Mon Aug 13 09:31:12 2007 +0200 @@ -54,7 +54,8 @@ (goto-char (point-max)) (insert "------- end of forwarded message -------\n")))) -(defun vm-mime-encapsulate-messages (message-list keep-list discard-regexp) +(defun vm-mime-encapsulate-messages (message-list keep-list discard-regexp + always-use-digest) "Encapsulate the messages in MESSAGE-LIST as per the MIME spec. The resulting digest is inserted at point in the current buffer. Point is not moved. @@ -67,14 +68,21 @@ to be forwarded. See the docs for vm-reorder-message-headers to find out how KEEP-LIST and DISCARD-REGEXP are used. -Returns the multipart boundary parameter (string) that should be used -in the Content-Type header." +If ALWAYS-USE-DIGEST is non-nil, always encapsulate for a multipart/digest. +Otherwise if there are fewer than two messages to be encapsulated +leave off the multipart boundary strings. The caller is assumed to +be using message/rfc822 or message/news encoding instead. + +If multipart/digest encapsulation is done, the function returns +the multipart boundary parameter (string) that should be used in +the Content-Type header. Otherwise nil is returned." (if message-list (let ((target-buffer (current-buffer)) (boundary-positions nil) (mlist message-list) (mime-keep-list (append keep-list vm-mime-header-list)) - boundary source-buffer m start n beg) + (boundary nil) + source-buffer m start n beg) (save-restriction ;; narrow to a zero length region to avoid interacting ;; with anything that might have already been inserted @@ -97,29 +105,27 @@ discard-regexp) (goto-char (point-max)) (setq mlist (cdr mlist))) - (goto-char start) - (setq boundary (vm-mime-make-multipart-boundary)) - (while (re-search-forward (concat "^--" - (regexp-quote boundary) - "\\(--\\)?$") - nil t) + (if (and (< (length message-list) 2) (not always-use-digest)) + nil + (goto-char start) (setq boundary (vm-mime-make-multipart-boundary)) - (goto-char start)) - (goto-char (point-max)) - (insert "\n--" boundary "--\n") - (while boundary-positions - (goto-char (car boundary-positions)) - (insert "\n--" boundary "\n\n") - (setq boundary-positions (cdr boundary-positions))) - (goto-char start) - (setq n (length message-list)) - (insert (format "This is a %s%sMIME encapsulation.\n" - (if (cdr message-list) - "digest, " - "forwarded message, ") - (if (cdr message-list) - (format "%d messages, " n) - ""))) + (while (re-search-forward (concat "^--" + (regexp-quote boundary) + "\\(--\\)?$") + nil t) + (setq boundary (vm-mime-make-multipart-boundary)) + (goto-char start)) + (goto-char (point-max)) + (insert "\n--" boundary "--\n") + (while boundary-positions + (goto-char (car boundary-positions)) + (insert "\n--" boundary "\n\n") + (setq boundary-positions (cdr boundary-positions))) + (goto-char start) + (setq n (length message-list)) + (insert + (format "This is a digest, %d messages, MIME encapsulation.\n" + n))) (goto-char start)) boundary ))) diff -r 4636a6841cd6 -r b980b6286996 lisp/vm/vm-folder.el --- a/lisp/vm/vm-folder.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/vm/vm-folder.el Mon Aug 13 09:31:12 2007 +0200 @@ -508,7 +508,7 @@ (set-buffer temp-buffer) (if (file-readable-p file) (condition-case nil - (let ((coding-system-for-read 'binary)) + (let ((overriding-file-coding-system 'binary)) (insert-file-contents file nil 0 4096)) (wrong-number-of-arguments (call-process "sed" file temp-buffer nil @@ -2618,7 +2618,7 @@ ;; enable-local-variables == nil disables them for newer Emacses (let ((inhibit-local-variables t) (enable-local-variables nil) - (coding-system-for-read 'no-conversion)) + (overriding-file-coding-system 'no-conversion)) (find-file-noselect crash-box))) (save-excursion (set-buffer crash-buf) @@ -2949,7 +2949,7 @@ (vm-save-restriction (widen) (goto-char (point-max)) - (let ((coding-system-for-read 'binary)) + (let ((overriding-file-coding-system 'binary)) (insert-file-contents folder)))) (setq mcount (length vm-message-list)) (if (vm-assimilate-new-messages) diff -r 4636a6841cd6 -r b980b6286996 lisp/vm/vm-mark.el --- a/lisp/vm/vm-mark.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/vm/vm-mark.el Mon Aug 13 09:31:12 2007 +0200 @@ -23,6 +23,7 @@ (vm-select-folder-buffer) (vm-check-for-killed-summary) (vm-error-if-folder-empty) + (message "Clearing all marks...") (let ((mp vm-message-list)) (while mp (if (vm-mark-of (car mp)) @@ -32,7 +33,8 @@ (setq mp (cdr mp)))) (vm-display nil nil '(vm-clear-all-marks) '(vm-clear-all-marks marking-message)) - (vm-update-summary-and-mode-line)) + (vm-update-summary-and-mode-line) + (message "Clearing all marks... done")) (defun vm-mark-all-messages () "Mark all messages in the current folder." @@ -40,6 +42,7 @@ (vm-select-folder-buffer) (vm-check-for-killed-summary) (vm-error-if-folder-empty) + (message "Marking all messages...") (let ((mp vm-message-list)) (while mp (vm-set-mark-of (car mp) t) @@ -47,7 +50,8 @@ (setq mp (cdr mp)))) (vm-display nil nil '(vm-mark-all-messages) '(vm-mark-all-messages marking-message)) - (vm-update-summary-and-mode-line)) + (vm-update-summary-and-mode-line) + (message "Marking all messages... done")) (defun vm-mark-message (count) "Mark the current message. diff -r 4636a6841cd6 -r b980b6286996 lisp/vm/vm-mime.el --- a/lisp/vm/vm-mime.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/vm/vm-mime.el Mon Aug 13 09:31:12 2007 +0200 @@ -624,7 +624,7 @@ (vm-headers-of m) (vm-text-of m) (vm-text-end-of m) - nil nil nil ))) + nil nil ))) ((null type) (goto-char (point-min)) (or (re-search-forward "^\n\\|\n\\'" nil t) @@ -635,7 +635,7 @@ (vm-marker (point-min)) (vm-marker (point)) (vm-marker (point-max)) - nil nil nil )) + nil nil )) ((null (string-match "[^/ ]+/[^/ ]+" (car type))) (vm-mime-error "Malformed MIME content type: %s" (car type))) ((and (string-match "^multipart/\\|^message/" (car type)) @@ -757,7 +757,8 @@ '("attachment") '("attachment") header text - text-end))))) + text-end + nil nil))))) (defun vm-mime-get-xxx-parameter (layout name param-list) (let ((match-end (1+ (length name))) @@ -824,7 +825,7 @@ (make-local-variable 'scroll-in-place) (setq scroll-in-place nil) (and vm-xemacs-mule-p - (set-buffer-file-coding-system 'no-conversion t)) + (set-file-coding-system 'binary t)) (cond (vm-fsfemacs-19-p ;; need to do this outside the let because ;; loading disp-table initializes @@ -889,7 +890,7 @@ (fset 'vm-presentation-mode 'vm-mode) (put 'vm-presentation-mode 'mode-class 'special) -(defvar buffer-file-coding-system) +(defvar file-coding-system) (defun vm-determine-proper-charset (beg end) (save-excursion @@ -903,9 +904,8 @@ "us-ascii") ((cdr charsets) (or (car (cdr - (assq (coding-system-name - buffer-file-coding-system) - vm-mime-mule-coding-to-charset-alist))) + (assoc (coding-system-name file-coding-system) + vm-mime-mule-coding-to-charset-alist))) "iso-2022-jp")) (t (or (car (cdr @@ -1341,15 +1341,15 @@ (vm-mime-transfer-decode-region layout start end) (setq tempfile (vm-make-tempfile-name)) (let ((buffer-file-type buffer-file-type) - buffer-file-coding-system) + file-coding-system) ;; Tell DOS/Windows NT whether the file is binary (setq buffer-file-type (not (vm-mime-text-type-p layout))) ;; Tell XEmacs/MULE not to mess with the bits unless ;; this is a text type. (if vm-xemacs-mule-p (if (vm-mime-text-type-p layout) - (set-buffer-file-coding-system 'no-conversion nil) - (set-buffer-file-coding-system 'binary t))) + (set-file-coding-system 'no-conversion nil) + (set-file-coding-system 'binary t))) (write-region start end tempfile nil 0)) (delete-region start end) (save-excursion @@ -1831,10 +1831,11 @@ file (and file (if colorful (nth 2 file) (nth 1 file))) sym (and file (intern file vm-image-obarray)) glyph (and sym (boundp sym) (symbol-value sym)) - glyph (or glyph (not file) - (make-glyph - (vector 'autodetect - ':data (expand-file-name file dir))))) + glyph (or glyph + (and file + (make-glyph + (vector 'autodetect + ':data (expand-file-name file dir)))))) (and sym (not (boundp sym)) (set sym glyph)) (and glyph (set-extent-begin-glyph e glyph))))) @@ -1930,8 +1931,8 @@ ;; this is a text type. (if vm-xemacs-mule-p (if (vm-mime-text-type-p layout) - (set-buffer-file-coding-system 'no-conversion nil) - (set-buffer-file-coding-system 'binary t))) + (set-file-coding-system 'no-conversion nil) + (set-file-coding-system 'binary t))) (vm-mime-insert-mime-body layout) (vm-mime-transfer-decode-region layout (point-min) (point-max)) (or (not (file-exists-p file)) @@ -2394,17 +2395,53 @@ encoding )) (defun vm-mime-transfer-encode-layout (layout) - (let ((encoding - (vm-mime-transfer-encode-region (vm-mm-layout-encoding layout) - (vm-mm-layout-body-start layout) - (vm-mm-layout-body-end layout) - (vm-mime-text-type-p layout)))) - (save-excursion - (save-restriction - (goto-char (vm-mm-layout-header-start layout)) - (narrow-to-region (point) (vm-mm-layout-body-start layout)) - (vm-reorder-message-headers nil nil "Content-Transfer-Encoding:") - (insert "Content-Transfer-Encoding: " encoding "\n"))))) + (let ((list (vm-mm-layout-parts layout)) + (type (car (vm-mm-layout-type layout))) + (encoding "7bit") + (vm-mime-8bit-text-transfer-encoding + vm-mime-8bit-text-transfer-encoding)) + (cond ((vm-mime-composite-type-p type) + ;; MIME messages of type "message" and + ;; "multipart" are required to have a non-opaque + ;; content transfer encoding. This means that + ;; if the user only wants to send out 7bit data, + ;; then any subpart that contains 8bit data must + ;; have an opaque (qp or base64) 8->7bit + ;; conversion performed on it so that the + ;; enclosing entity can use a non-opaque + ;; encoding. + ;; + ;; message/partial requires a "7bit" encoding so + ;; force 8->7 conversion in that case. + (cond ((memq vm-mime-8bit-text-transfer-encoding + '(quoted-printable base64)) + t) + ((vm-mime-types-match "message/partial" type) + (setq vm-mime-8bit-text-transfer-encoding + 'quoted-printable))) + (while list + (if (equal (vm-mime-transfer-encode-layout (car list)) "8bit") + (setq encoding "8bit")) + (setq list (cdr list)))) + (t + (if (and (vm-mime-types-match "message/partial" type) + (not (memq vm-mime-8bit-text-transfer-encoding + '(quoted-printable base64)))) + (setq vm-mime-8bit-text-transfer-encoding + 'quoted-printable)) + (setq encoding + (vm-mime-transfer-encode-region (vm-mm-layout-encoding layout) + (vm-mm-layout-body-start layout) + (vm-mm-layout-body-end layout) + (vm-mime-text-type-p layout))))) + (save-excursion + (save-restriction + (goto-char (vm-mm-layout-header-start layout)) + (narrow-to-region (point) (vm-mm-layout-body-start layout)) + (vm-reorder-message-headers nil nil "Content-Transfer-Encoding:") + (if (not (equal encoding "7bit")) + (insert "CONTENT-TRANSFER-ENCODING: " encoding "\n")) + encoding )))) (defun vm-mime-encode-composition () "MIME encode the current mail composition buffer. @@ -2501,11 +2538,11 @@ (cond ((bufferp object) (insert-buffer-substring object)) ((stringp object) - (let ((coding-system-for-read 'no-conversion) + (let ((overriding-file-coding-system 'no-conversion) ;; don't let file-coding-system be changed ;; by insert-file-contents-literally. The ;; value we bind to it to here isn't important. - (buffer-file-coding-system 'no-conversion)) + (file-coding-system 'no-conversion)) (insert-file-contents-literally object)))) ;; gather information about the object from the extent. (if (setq already-mimed (extent-property e 'vm-mime-encoded)) @@ -2548,41 +2585,13 @@ (point-max) t)) (setq 8bit (or 8bit (equal encoding "8bit")))) - ((or (vm-mime-types-match "message/rfc822" type) - (vm-mime-types-match "message/news" type) - (vm-mime-types-match "multipart" type)) + ((vm-mime-composite-type-p type) (setq opoint-min (point-min)) (if (not already-mimed) (setq layout (vm-mime-parse-entity nil (list "text/plain" "charset=us-ascii") "7bit"))) - ;; MIME messages of type "message" and - ;; "multipart" are required to have a non-opaque - ;; content transfer encoding. This means that - ;; if the user only wants to send out 7bit data, - ;; then any subpart that contains 8bit data must - ;; have an opaque (qp or base64) 8->7bit - ;; conversion performed on it so that the - ;; enclosing entity can use a non-opaque - ;; encoding. - ;; - ;; message/partial requires a "7bit" encoding so - ;; force 8->7 conversion in that case. - (let ((vm-mime-8bit-text-transfer-encoding - (if (vm-mime-types-match "message/partial" type) - 'quoted-printable - vm-mime-8bit-text-transfer-encoding))) - (vm-mime-map-atomic-layouts 'vm-mime-transfer-encode-layout - (vm-mm-layout-parts layout))) - ;; now figure out a proper content transfer - ;; encoding value for the enclosing entity. - (re-search-forward "^\n" nil t) - (save-restriction - (narrow-to-region (point) (point-max)) - (setq encoding - (vm-determine-proper-content-transfer-encoding - (point-min) - (point-max)))) + (setq encoding (vm-mime-transfer-encode-layout layout)) (setq 8bit (or 8bit (equal encoding "8bit"))) (goto-char (point-max)) (widen) @@ -2859,41 +2868,13 @@ (point-max) t)) (setq 8bit (or 8bit (equal encoding "8bit")))) - ((or (vm-mime-types-match "message/rfc822" type) - (vm-mime-types-match "message/news" type) - (vm-mime-types-match "multipart" type)) + ((vm-mime-composite-type-p type) (setq opoint-min (point-min)) (if (not already-mimed) (setq layout (vm-mime-parse-entity nil (list "text/plain" "charset=us-ascii") "7bit"))) - ;; MIME messages of type "message" and - ;; "multipart" are required to have a non-opaque - ;; content transfer encoding. This means that - ;; if the user only wants to send out 7bit data, - ;; then any subpart that contains 8bit data must - ;; have an opaque (qp or base64) 8->7bit - ;; conversion performed on it so that the - ;; enclosing entity can use a non-opaque - ;; encoding. - ;; - ;; message/partial requires a "7bit" encoding so - ;; force 8->7 conversion in that case. - (let ((vm-mime-8bit-text-transfer-encoding - (if (vm-mime-types-match "message/partial" type) - 'quoted-printable - vm-mime-8bit-text-transfer-encoding))) - (vm-mime-map-atomic-layouts 'vm-mime-transfer-encode-layout - (vm-mm-layout-parts layout))) - ;; now figure out a proper content transfer - ;; encoding value for the enclosing entity. - (re-search-forward "^\n" nil t) - (save-restriction - (narrow-to-region (point) (point-max)) - (setq encoding - (vm-determine-proper-content-transfer-encoding - (point-min) - (point-max)))) + (setq encoding (vm-mime-transfer-encode-layout layout)) (setq 8bit (or 8bit (equal encoding "8bit"))) (goto-char (point-max)) (widen) @@ -3045,16 +3026,15 @@ b header-start header-end master-buffer start end) (vm-remove-mail-mode-header-separator) ;; message/partial must have "7bit" content transfer - ;; encoding, so verify that everything has been encoded for + ;; encoding, so force everything to be encoded for ;; 7bit transmission. (let ((vm-mime-8bit-text-transfer-encoding (if (eq vm-mime-8bit-text-transfer-encoding '8bit) 'quoted-printable vm-mime-8bit-text-transfer-encoding))) - (vm-mime-map-atomic-layouts - 'vm-mime-transfer-encode-layout - (list (vm-mime-parse-entity nil (list "text/plain" "charset=us-ascii") - "7bit")))) + (vm-mime-transfer-encode-layout + (vm-mime-parse-entity nil (list "text/plain" "charset=us-ascii") + "7bit"))) (goto-char (point-min)) (setq header-start (point)) (search-forward "\n\n") @@ -3156,12 +3136,16 @@ (and temp-buffer (kill-buffer temp-buffer))))) (defun vm-mime-composite-type-p (type) - (or (vm-mime-types-match "message" type) + (or (and (vm-mime-types-match "message" type) + (not (vm-mime-types-match "message/partial" type)) + (not (vm-mime-types-match "message/external-body" type))) (vm-mime-types-match "multipart" type))) -(defun vm-mime-map-atomic-layouts (function list) - (while list - (if (vm-mime-composite-type-p (car (vm-mm-layout-type (car list)))) - (vm-mime-map-atomic-layouts function (vm-mm-layout-parts (car list))) - (funcall function (car list))) - (setq list (cdr list)))) +;; Unused currrently. +;; +;;(defun vm-mime-map-atomic-layouts (function list) +;; (while list +;; (if (vm-mime-composite-type-p (car (vm-mm-layout-type (car list)))) +;; (vm-mime-map-atomic-layouts function (vm-mm-layout-parts (car list))) +;; (funcall function (car list))) +;; (setq list (cdr list)))) diff -r 4636a6841cd6 -r b980b6286996 lisp/vm/vm-mouse.el --- a/lisp/vm/vm-mouse.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/vm/vm-mouse.el Mon Aug 13 09:31:12 2007 +0200 @@ -222,7 +222,7 @@ ;; one, whatever that is. (setq buffer-file-type nil) (and vm-xemacs-mule-p - (set-buffer-file-coding-system 'no-conversion nil)) + (set-file-coding-system 'no-conversion nil)) (write-region (point-min) (point-max) (concat "/tmp/Mosaic." pid) nil 0) diff -r 4636a6841cd6 -r b980b6286996 lisp/vm/vm-pop.el --- a/lisp/vm/vm-pop.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/vm/vm-pop.el Mon Aug 13 09:31:12 2007 +0200 @@ -192,7 +192,7 @@ (get-buffer-create (format "trace of POP session to %s" host))) ;; Tell XEmacs/MULE not to mess with the text. (and vm-xemacs-mule-p - (set-buffer-file-coding-system 'no-conversion t)) + (set-file-coding-system 'binary t)) ;; clear the trace buffer of old output (save-excursion (set-buffer process-buffer) diff -r 4636a6841cd6 -r b980b6286996 lisp/vm/vm-reply.el --- a/lisp/vm/vm-reply.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/vm/vm-reply.el Mon Aug 13 09:31:12 2007 +0200 @@ -344,6 +344,10 @@ (let ((b (current-buffer))) (vm-mail-send) (cond ((null (buffer-name b)) ;; dead buffer + ;; This improves window configuration behavior in + ;; XEmacs. It avoids taking the folder buffer from + ;; one frame and attaching it to the selected frame. + (set-buffer (window-buffer (selected-window))) (vm-display nil nil '(vm-mail-send-and-exit) '(vm-mail-send-and-exit reading-message @@ -440,13 +444,13 @@ (vm-mail-mark-forwarded)) ((eq vm-system-state 'redistributing) (vm-mail-mark-redistributed))) + (vm-display nil nil '(vm-mail-send) '(vm-mail-send)) ;; be careful, something could have killed the composition ;; buffer inside mail-send. (if (eq (current-buffer) composition-buffer) (progn (vm-rename-current-mail-buffer) - (vm-keep-mail-buffer (current-buffer)))) - (vm-display nil nil '(vm-mail-send) '(vm-mail-send)))) + (vm-keep-mail-buffer (current-buffer)))))) (defun vm-mail-mode-get-header-contents (header-name-regexp) (let ((contents nil) @@ -612,7 +616,8 @@ (vm-select-folder-buffer) (vm-check-for-killed-summary) (vm-error-if-folder-empty) - (if (eq last-command 'vm-next-command-uses-marks) + (if (and (eq last-command 'vm-next-command-uses-marks) + (cdr (vm-select-marked-or-prefixed-messages 0))) (let ((vm-digest-send-type vm-forwarding-digest-type)) (setq this-command 'vm-next-command-uses-marks) (command-execute 'vm-send-digest)) @@ -620,8 +625,8 @@ (miming (and vm-send-using-mime (equal vm-forwarding-digest-type "mime"))) mail-buffer - header-end boundary - (mp vm-message-pointer)) + header-end + (mp (vm-select-marked-or-prefixed-messages 1))) (save-restriction (widen) (vm-mail-internal @@ -648,15 +653,13 @@ (goto-char (match-end 0)) (setq header-end (match-beginning 0))) (cond ((equal vm-forwarding-digest-type "mime") - (setq boundary (vm-mime-encapsulate-messages - (list (car mp)) vm-forwarded-headers - vm-unforwarded-header-regexp)) + (vm-mime-encapsulate-messages (list (car mp)) + vm-forwarded-headers + vm-unforwarded-header-regexp + nil) (goto-char header-end) (insert "MIME-Version: 1.0\n") - (insert (if vm-mime-avoid-folding-content-type - "Content-Type: multipart/digest; boundary=\"" - "Content-Type: multipart/digest;\n\tboundary=\"") - boundary "\"\n") + (insert "Content-Type: message/rfc822\n") (insert "Content-Transfer-Encoding: " (vm-determine-proper-content-transfer-encoding (point) @@ -678,9 +681,7 @@ (let ((b (current-buffer))) (set-buffer mail-buffer) (mail-text) - (vm-mime-attach-object b "multipart/digest" - (list (concat "boundary=\"" - boundary "\"")) nil t) + (vm-mime-attach-object b "message/rfc822" nil nil t) (add-hook 'kill-buffer-hook (list 'lambda () (list 'if (list 'eq mail-buffer '(current-buffer)) @@ -755,10 +756,10 @@ The current message will be copied to a Mail mode buffer and you can edit the message and send it as usual. -NOTE: since you are doing a resend, a Resent-To header is -provided for you to fill in. If you don't fill it in, when you -send the message it will go to the original recipients listed in -the To and Cc headers. You may also create a Resent-Cc header." +NOTE: since you are doing a resend, a Resent-To header is provided +for you to fill in the new recipient list. If you don't fill in +this header, what happens when you send the message is undefined. +You may also create a Resent-Cc header." (interactive) (vm-follow-summary-cursor) (vm-select-folder-buffer) @@ -855,7 +856,8 @@ (cond ((equal vm-digest-send-type "mime") (setq boundary (vm-mime-encapsulate-messages mlist vm-mime-digest-headers - vm-mime-digest-discard-header-regexp)) + vm-mime-digest-discard-header-regexp + t)) (goto-char header-end) (insert "MIME-Version: 1.0\n") (insert (if vm-mime-avoid-folding-content-type @@ -877,18 +879,6 @@ vm-rfc1153-digest-discard-header-regexp))) (goto-char start) (setq mp mlist) - (if prefix - (progn - (message "Building digest preamble...") - (while mp - (let ((vm-summary-uninteresting-senders nil)) - (insert (vm-sprintf 'vm-digest-preamble-format (car mp)) "\n")) - (if vm-digest-center-preamble - (progn - (forward-char -1) - (center-line) - (forward-char 1))) - (setq mp (cdr mp))))) (if miming (let ((b (current-buffer))) (set-buffer mail-buffer) @@ -900,6 +890,22 @@ (list 'lambda () (list 'if (list 'eq mail-buffer '(current-buffer)) (list 'kill-buffer b)))))) + (if prefix + (save-excursion + (message "Building digest preamble...") + (if miming + (progn + (set-buffer mail-buffer) + (mail-text))) + (while mp + (let ((vm-summary-uninteresting-senders nil)) + (insert (vm-sprintf 'vm-digest-preamble-format (car mp)) "\n")) + (if vm-digest-center-preamble + (progn + (forward-char -1) + (center-line) + (forward-char 1))) + (setq mp (cdr mp))))) (mail-position-on-field "To") (message "Building %s digest... done" vm-digest-send-type))) (run-hooks 'vm-send-digest-hook) diff -r 4636a6841cd6 -r b980b6286996 lisp/vm/vm-save.el --- a/lisp/vm/vm-save.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/vm/vm-save.el Mon Aug 13 09:31:12 2007 +0200 @@ -434,8 +434,9 @@ (setq vm-last-written-file file))) (defun vm-pipe-message-to-command (command prefix-arg) - "Run shell command with the some or all of the current message as input. -By default the entire message is used. + "Runs a shell command with some or all of the contents of the +current message as input. +By default, the entire message is used. With one \\[universal-argument] the text portion of the message is used. With two \\[universal-argument]'s the header portion of the message is used. With three \\[universal-argument]'s the visible header portion of the message diff -r 4636a6841cd6 -r b980b6286996 lisp/vm/vm-startup.el --- a/lisp/vm/vm-startup.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/vm/vm-startup.el Mon Aug 13 09:31:12 2007 +0200 @@ -63,7 +63,7 @@ (inhibit-local-variables t) (enable-local-variables nil) ;; for XEmacs/Mule - (coding-system-for-read 'no-conversion)) + (overriding-file-coding-system 'no-conversion)) (message "Reading %s..." file) (prog1 (find-file-noselect file) ;; update folder history @@ -80,25 +80,25 @@ ;; the file coding system and decoding it. ;; This is only possible if a file is visited and then vm-mode ;; is run on it afterwards. - (defvar buffer-file-coding-system) + (defvar file-coding-system) (if (and vm-xemacs-mule-p - (not (eq (get-coding-system buffer-file-coding-system) + (not (eq (get-coding-system file-coding-system) (get-coding-system 'no-conversion-unix))) - (not (eq (get-coding-system buffer-file-coding-system) + (not (eq (get-coding-system file-coding-system) (get-coding-system 'no-conversion-dos))) - (not (eq (get-coding-system buffer-file-coding-system) + (not (eq (get-coding-system file-coding-system) (get-coding-system 'no-conversion-mac))) - (not (eq (get-coding-system buffer-file-coding-system) + (not (eq (get-coding-system file-coding-system) (get-coding-system 'binary)))) (let ((buffer-read-only nil) (omodified (buffer-modified-p))) (unwind-protect (progn (encode-coding-region (point-min) (point-max) - buffer-file-coding-system) - (set-buffer-file-coding-system 'no-conversion nil) + file-coding-system) + (set-file-coding-system 'no-conversion nil) (decode-coding-region (point-min) (point-max) - buffer-file-coding-system)) + file-coding-system)) (set-buffer-modified-p omodified)))) (vm-check-for-killed-summary) (vm-check-for-killed-presentation) @@ -276,7 +276,7 @@ (defun vm-mode (&optional read-only) "Major mode for reading mail. -This is VM 6.27. +This is VM 6.29. Commands: h - summarize folder contents @@ -1011,7 +1011,7 @@ ) nil nil - "Please change the Subject header to a concise bug description.\nRemember to cover the basics, that is, what you expected to\nhappen and what in fact did happen. Please remove these instructions from your message.") + "Please change the Subject header to a concise bug description.\nRemember to cover the basics, that is, what you expected to\nhappen and what in fact did happen. Please remove these\ninstructions from your message.") (save-excursion (goto-char (point-min)) (mail-position-on-field "Subject") @@ -1055,7 +1055,7 @@ (defun vm-session-initialization () (vm-note-emacs-version) (vm-check-emacs-version) - ;(vm-set-debug-flags) +;; (vm-set-debug-flags) ;; If this is the first time VM has been run in this Emacs session, ;; do some necessary preparations. (if (or (not (boundp 'vm-session-beginning)) diff -r 4636a6841cd6 -r b980b6286996 lisp/vm/vm-thread.el --- a/lisp/vm/vm-thread.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/vm/vm-thread.el Mon Aug 13 09:31:12 2007 +0200 @@ -159,8 +159,8 @@ (vm-thread-mark-for-summary-update (get (intern (vm-su-message-id (car message-list)) vm-thread-obarray) - 'children)) - (setq message-list (cdr message-list))))) + 'children))) + (setq message-list (cdr message-list)))) (defun vm-thread-list (message) (let ((done nil) diff -r 4636a6841cd6 -r b980b6286996 lisp/vm/vm-vars.el --- a/lisp/vm/vm-vars.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/vm/vm-vars.el Mon Aug 13 09:31:12 2007 +0200 @@ -419,7 +419,7 @@ A nil value means VM will not offer any support for composing MIME messages.") -(defvar vm-honor-mime-content-disposition t +(defvar vm-honor-mime-content-disposition nil "*Non-nil value means use information from the Content-Disposition header to display MIME messages. The Content-Disposition header specifies whether a MIME object should be displayed inline or diff -r 4636a6841cd6 -r b980b6286996 lisp/vm/vm-version.el --- a/lisp/vm/vm-version.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/vm/vm-version.el Mon Aug 13 09:31:12 2007 +0200 @@ -2,7 +2,7 @@ (provide 'vm-version) -(defconst vm-version "6.27" +(defconst vm-version "6.29" "Version number of VM.") (defun vm-version () diff -r 4636a6841cd6 -r b980b6286996 lisp/vm/vm-virtual.el --- a/lisp/vm/vm-virtual.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/vm/vm-virtual.el Mon Aug 13 09:31:12 2007 +0200 @@ -248,7 +248,13 @@ (list name (list (list (list 'get-buffer (buffer-name))) (if arg (list selector arg) (list selector)))))) - (vm-visit-virtual-folder name read-only))) + (vm-visit-virtual-folder name read-only)) + ;; have to do this again here because the known virtual + ;; folder menu is now hosed because we installed it while + ;; vm-virtual-folder-alist was bound to the temp value above + (if vm-use-menus + (vm-menu-install-known-virtual-folders-menu))) + (defun vm-apply-virtual-folder (name &optional read-only) "Apply the selectors of a named virtual folder to the current folder @@ -275,7 +281,12 @@ (setq clauses (cdr clauses))) (setcar vfolder (format "%s/%s" (buffer-name) (car vfolder))) (setq vm-virtual-folder-alist (list vfolder)) - (vm-visit-virtual-folder (car vfolder) read-only))) + (vm-visit-virtual-folder (car vfolder) read-only)) + ;; have to do this again here because the known virtual + ;; folder menu is now hosed because we installed it while + ;; vm-virtual-folder-alist was bound to the temp value above + (if vm-use-menus + (vm-menu-install-known-virtual-folders-menu))) (defun vm-toggle-virtual-mirror () (interactive) diff -r 4636a6841cd6 -r b980b6286996 lisp/vm/vm-window.el --- a/lisp/vm/vm-window.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/vm/vm-window.el Mon Aug 13 09:31:12 2007 +0200 @@ -134,7 +134,7 @@ (set-buffer (setq work-buffer (get-buffer-create "*vm-wconfig*"))) ;; for XEmacs/MULE (and vm-xemacs-mule-p - (set-buffer-file-coding-system 'no-conversion)) + (set-file-coding-system 'no-conversion)) (erase-buffer) (print vm-window-configurations (current-buffer)) (write-region (point-min) (point-max) file nil 0)) diff -r 4636a6841cd6 -r b980b6286996 lisp/w3/ChangeLog --- a/lisp/w3/ChangeLog Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/w3/ChangeLog Mon Aug 13 09:31:12 2007 +0200 @@ -2,8 +2,23 @@ * Makefile (xemacs-w3): Special target for XEmacs Build. +Mon Apr 21 08:58:02 1997 William M. Perry + +* devices.el: Added magic to not optimize this file under XEmacs - its not + actually used, so no damage. It wouldn't compile under XEmacs because + it has subrs for all these, and our declaring them as defsubsts + thoroughly confuses the byte-compiler. + +Sun Apr 20 12:19:56 1997 William M. Perry + +* w3-sysdp.el: Moved device stuf out into its own devices.el file so that + it can be correctly byte-compiled. + Ditto for the text properties stuff (into w3-props.el) + Fri Apr 18 13:09:31 1997 William M. Perry +* Emacs/W3 3.0.83 released + * Synch'd up to Widget 1.89 Thu Apr 17 06:20:56 1997 "T. V. Raman" diff -r 4636a6841cd6 -r b980b6286996 lisp/w3/Makefile --- a/lisp/w3/Makefile Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/w3/Makefile Mon Aug 13 09:31:12 2007 +0200 @@ -44,12 +44,13 @@ SOURCES = \ $(CUSTOMSOURCES) $(URLSOURCES) mule-sysdp.el w3-widget.el \ - w3-imap.el css.el dsssl.el font.el images.el w3-vars.el \ - w3-cus.el w3-style.el w3-keyword.el w3-forms.el w3-emulate.el \ - w3-auto.el w3-menu.el w3-mouse.el w3-toolbar.el w3-prefs.el \ - w3-speak.el w3-latex.el w3-parse.el w3-display.el w3-print.el \ - w3-about.el w3-hot.el w3-e19.el w3-xemac.el w3.el w3-script.el \ - w3-jscript.el w3-elisp.el dsssl-flow.el + devices.el w3-imap.el css.el dsssl.el dsssl-flow.el font.el \ + images.el w3-vars.el w3-cus.el w3-style.el w3-keyword.el \ + w3-forms.el w3-emulate.el w3-props.el w3-auto.el w3-menu.el \ + w3-mouse.el w3-toolbar.el w3-prefs.el w3-speak.el w3-latex.el \ + w3-parse.el w3-display.el w3-print.el w3-about.el w3-hot.el \ + w3-e19.el w3-xemac.el w3.el w3-script.el w3-jscript.el \ + w3-elisp.el OBJECTS = $(SOURCES:.el=.elc) diff -r 4636a6841cd6 -r b980b6286996 lisp/w3/css.el --- a/lisp/w3/css.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/w3/css.el Mon Aug 13 09:31:12 2007 +0200 @@ -1,7 +1,7 @@ ;;; css.el -- Cascading Style Sheet parser ;; Author: wmperry -;; Created: 1997/04/17 13:50:34 -;; Version: 1.36 +;; Created: 1997/04/21 14:00:12 +;; Version: 1.38 ;; Keywords: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -773,14 +773,14 @@ (if css-running-xemacs 'xemacs 'emacs) (if (css-color-light-p 'default) 'light 'dark))) (type (device-type device))) + ;; For reasons I don't really want to get into, emacspeak and TTY + ;; are mutually exclusive for most of our purposes (insert-before, + ;; xetc) + (if (featurep 'emacspeak) + (setq types (cons 'speech types)) + (if (eq type 'tty) + (setq types (cons 'tty types)))) (cond - ((featurep 'emacspeak) - (setq types (cons 'speech types))) - ((eq type 'tty) - (if (and (fboundp 'tty-color-list) - (/= 0 (length (tty-color-list)))) - (setq types (cons 'ansi-tty types)) - (setq types (cons 'tty types)))) ((eq 'color (device-class)) (if (not (device-bitplanes)) (setq types (cons 'color types)) @@ -802,6 +802,9 @@ (setq types (append (list 'mono 'monochrome) types))) (t (setq types (cons 'unknown types)))) + ;; FIXME: Remove me when the real 3.0 comes out + (if (and (memq 'tty types) (memq 'color types)) + (setq types (cons 'ansi-tty types))) types)) (defmacro css-rule-specificity-internal (rule) @@ -898,7 +901,7 @@ ((or (looking-at "