Mercurial > hg > xemacs-beta
changeset 136:b980b6286996 r20-2b2
Import from CVS: tag r20-2b2
line wrap: on
line diff
--- 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
--- 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 <steve@altair.xemacs.org> + + * XEmacs 20.2-b2 is released. + + * configure.in (beta): OPENWINHOME misspelled. + +Mon Apr 21 14:48:29 1997 Steven L Baur <steve@altair.xemacs.org> + + * etc/BETA (writing): Update with information about how to create + patches. + Sat Apr 19 16:13:16 1997 Steven L Baur <steve@altair.xemacs.org> * XEmacs 20.2-b1 is released.
--- 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.
--- 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."
--- 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."
--- 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.
--- 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 <up>") '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 ===========================================
--- 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
--- 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:
--- 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
--- /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 ÿ
--- 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 <a> 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; }
--- 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 <steve@altair.xemacs.org> + + * 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 <steve@altair.xemacs.org> + + * 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 <steve@altair.xemacs.org> + + * 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 <steve@altair.xemacs.org> + + * 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 <hniksic@srce.hr> + + * 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 <steve@altair.xemacs.org> * utils/skeleton.el (skeleton-pair-insert-maybe): Guard test with
--- 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)
--- 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)
--- 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 <abraham@dina.kvl.dk> - - * Version 1.89 released. - -Thu Apr 17 11:23:20 1997 Per Abrahamsen <abraham@dina.kvl.dk> - - * 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 <abraham@dina.kvl.dk> - - * Version 1.88 released. - -Wed Apr 16 13:28:37 1997 Per Abrahamsen <abraham@dina.kvl.dk> - - * 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 <abraham@dina.kvl.dk> - - * 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 <abraham@dina.kvl.dk> - - * cus-edit.el (custom-save-variables): Save :require symbols. - - * Version 1.85 released. - -Tue Apr 15 11:56:16 1997 Per Abrahamsen <abraham@dina.kvl.dk> - - * 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" <wmperry@aventail.com>. - -Sun Apr 13 19:19:33 1997 Per Abrahamsen <abraham@dina.kvl.dk> - - * custom.texi (Declaring Faces): Documentation property symbol is - `face-documentation'. - Sat Apr 12 18:31:22 1997 Per Abrahamsen <abraham@dina.kvl.dk> * Version 1.84 released.
--- 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 <abraham@dina.kvl.dk> ;; 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
--- 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 <abraham@dina.kvl.dk> ;; 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))
--- 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 <abraham@dina.kvl.dk> ;; 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'")
--- 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 <abraham@dina.kvl.dk> ;; 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)
--- 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 <abraham@dina.kvl.dk> ;; 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
--- 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 <abraham@dina.kvl.dk> ;; Keywords: help, extensions, faces, hypermedia -;; Version: 1.89 +;; Version: 1.84 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ (require 'widget)
--- 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 <abraham@dina.kvl.dk> ;; 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.
--- 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.
--- 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 ))
--- 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 <larsi@menja.ifi.uio.no> + + * gnus.el: Gnus v5.4.46 is released. + +Sat Apr 19 05:40:40 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> + + * gnus-art.el (gnus-read-save-file-name): Expand file name i save + dir. + +Fri Apr 18 14:25:21 1997 Hrvoje Niksic <hniksic@srce.hr> + + * gnus-art.el (gnus-signature-face): New face; use it. + +Sat Apr 19 05:32:43 1997 Kim-Minh Kaplan <kimminh.kaplan@utopia.eunet.fr> + + * gnus-picon.el (gnus-picons-insert-face-if-exists): Add picons to + list. + +Tue Apr 15 14:08:32 1997 Hrvoje Niksic <hniksic@srce.hr> + + * message.el (message-font-lock-keywords): Be a little bit more + case-insensitive. + +Wed Apr 16 02:41:31 1997 Hrvoje Niksic <hniksic@srce.hr> + + * message.el (message-insert-to): New argument FORCE. + +Sat Apr 19 05:18:10 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> + + * message.el (message-setup): Nix out undo list. + +Sat Apr 19 05:00:06 1997 Katsumi Yamaoka <yamaoka@ga.sony.co.jp> + + * gnus-sum.el: Redefine. + +Sat Apr 19 04:53:29 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> + + * 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 <hniksic@srce.hr> + + * 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 <larsi@ifi.uio.no> + + * 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 <larsi@ifi.uio.no> + + * message.el (message-mail-alias-type): New variable. + (message-mode): Use it. + +Wed Apr 16 00:03:37 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> + + * gnus-demon.el (gnus-demon): Ignore errors. + +Tue Apr 15 23:50:02 1997 Brad Howes <bhowes@cssun3.corp.mot.com> + + * gnus-demon.el (gnus-demon-time-to-step): New version. + +Tue Apr 15 23:32:58 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> + + * 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 <jens@metrix.de> + + * gnus.el (gnus-article-display-hook): Fix. + +Sun Apr 13 02:07:33 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> + + * 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 <larsi@menja.ifi.uio.no> * gnus.el: Gnus v5.4.45 is released.
--- 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)
--- 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
--- 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)))))))))
--- 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))
--- 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)))
--- 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)))))))
--- 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)
--- 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)
--- 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)
--- 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\")."
--- 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
--- 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 <grossjohann@ls6.informatik.uni-dortmund.de> +;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> +;; Kai Grossjohann <grossjohann@ls6.informatik.uni-dortmund.de> +;; Joe Hildebrand <joe.hildebrand@ilg.com> +;; David Blacka <davidb@rwhois.net> ;; 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) +
--- 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)))
--- 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)
--- 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.
--- 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.")
--- 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)
--- 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.
--- 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"))
--- 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
--- 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
--- 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
--- 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.
--- 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)))
--- 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 <steve@altair.xemacs.org> + + * 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 <steve@altair.xemacs.org> + + * psgml-xemacs.el (sgml-xemacs-get-popup-value): Allow for + interactive function. + Sat Mar 22 19:58:27 1997 Steven L Baur <steve@altair.xemacs.org> * psgml-html.el (html-mode): Too many backslashes in DOCSTRING.
--- 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 ÿ
--- 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")
--- 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.
--- 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
--- 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 <morioka@jaist.ac.jp> ;; 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)) )))
--- 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 <daveg@synaptics.com> ;; Hrvoje Niksic <hniksic@srce.hr> -- XEmacs port ;; Maintainer: Hrvoje Niksic <hniksic@srce.hr> -;; 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 <up>") '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., <return>, <down>, or <f1>, 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:
--- 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)
--- 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 ###################
--- 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
--- 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 )))
--- 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)
--- 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.
--- 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))))
--- 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)
--- 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)
--- 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)
--- 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
--- 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))
--- 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)
--- 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
--- 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 ()
--- 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)
--- 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))
--- 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 <wmperry@aventail.com> + +* 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 <wmperry@aventail.com> + +* 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 <wmperry@aventail.com> +* Emacs/W3 3.0.83 released + * Synch'd up to Widget 1.89 Thu Apr 17 06:20:56 1997 "T. V. Raman" <raman@Adobe.COM>
--- 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)
--- 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 "<!--+") ; begin (looking-at "--+>")) ; end (goto-char (match-end 0))) - ;; C++ style comments, and we are doing IE compatibility + ;; C++ style comments ((looking-at "//") (end-of-line)) ;; Pre-Processor directives
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/devices.el Mon Aug 13 09:31:12 2007 +0200 @@ -0,0 +1,341 @@ +;;; devices.el -- XEmacs device API emulation +;; Author: wmperry +;; Created: 1997/04/21 15:57:56 +;; Version: 1.2 +;; Keywords: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. +;;; +;;; This file is not part of GNU Emacs, but the same permissions apply. +;;; +;;; GNU Emacs is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; GNU Emacs is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Emacs; see the file COPYING. If not, write to the +;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;;; Boston, MA 02111-1307, USA. +;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; This is a complete implementation of all the device-* functions found in +;; XEmacs 19.14. A 'device' for Emacs 19 is just a frame, from which we can +;; determine the connection to an X display, etc. + +(eval-when-compile + (if (string-match "XEmacs" (emacs-version)) + (set 'byte-optimize nil))) + +(if (string-match "XEmacs" (emacs-version)) + nil +'() +(defalias 'selected-device 'ignore) +(defalias 'device-or-frame-p 'framep) +(defalias 'device-console 'ignore) +(defalias 'device-sound-enabled-p 'ignore) +(defalias 'device-live-p 'frame-live-p) +(defalias 'devicep 'framep) +(defalias 'frame-device 'identity) +(defalias 'redisplay-device 'redraw-frame) +(defalias 'redraw-device 'redraw-frame) +(defalias 'select-device 'select-frame) +(defalias 'set-device-class 'ignore) + +(defun make-device (type connection &optional props) + "Create a new device of type TYPE, attached to connection CONNECTION. + +The valid values for CONNECTION are device-specific; however, +CONNECTION is generally a string. (Specifically, for X devices, +CONNECTION should be a display specification such as \"foo:0\", and +for TTY devices, CONNECTION should be the filename of a TTY device +file, such as \"/dev/ttyp4\", or nil to refer to XEmacs' standard +input/output.) + +PROPS, if specified, should be a plist of properties controlling +device creation. + +If CONNECTION specifies an already-existing device connection, that +device is simply returned; no new device is created, and PROPS +have no effect." + (cond + ((and (eq type 'x) connection) + (make-frame-on-display connection props)) + ((eq type 'x) + (make-frame props)) + ((eq type 'tty) + nil) + (t + (error "Unsupported device-type: %s" type)))) + +(defun make-frame-on-device (type connection &optional props) + "Create a frame of type TYPE on CONNECTION. +TYPE should be a symbol naming the device type, i.e. one of + +x An X display. CONNECTION should be a standard display string + such as \"unix:0\", or nil for the display specified on the + command line or in the DISPLAY environment variable. Only if + support for X was compiled into XEmacs. +tty A standard TTY connection or terminal. CONNECTION should be + a TTY device name such as \"/dev/ttyp2\" (as determined by + the Unix command `tty') or nil for XEmacs' standard input + and output (usually the TTY in which XEmacs started). Only + if support for TTY's was compiled into XEmacs. +ns A connection to a machine running the NeXTstep windowing + system. Not currently implemented. +win32 A connection to a machine running Microsoft Windows NT or + Windows 95. Not currently implemented. +pc A direct-write MS-DOS frame. Not currently implemented. + +PROPS should be an plist of properties, as in the call to `make-frame'. + +If a connection to CONNECTION already exists, it is reused; otherwise, +a new connection is opened." + (make-device type connection props)) + +(defun make-tty-device (&optional tty terminal-type) + "Create a new device on TTY. + TTY should be the name of a tty device file (e.g. \"/dev/ttyp3\" under +SunOS et al.), as returned by the `tty' command. A value of nil means +use the stdin and stdout as passed to XEmacs from the shell. + If TERMINAL-TYPE is non-nil, it should be a string specifying the +type of the terminal attached to the specified tty. If it is nil, +the terminal type will be inferred from the TERM environment variable." + (make-device 'tty tty (list 'terminal-type terminal-type))) + +(defun make-x-device (&optional display) + (make-device 'x display)) + +(defsubst set-device-selected-frame (device frame) + "Set the selected frame of device object DEVICE to FRAME. +If DEVICE is nil, the selected device is used. +If DEVICE is the selected device, this makes FRAME the selected frame." + (select-frame frame)) + +(defsubst set-device-baud-rate (device rate) + "Set the output baud rate of DEVICE to RATE. +On most systems, changing this value will affect the amount of padding +and other strategic decisions made during redisplay." + (setq baud-rate rate)) + +(defun dfw-device (obj) + "Given a device, frame, or window, return the associated device. +Return nil otherwise." + (cond + ((windowp obj) + (window-frame obj)) + ((framep obj) + obj) + (t + nil))) + +(defsubst event-device (event) + "Return the device that EVENT occurred on. +This will be nil for some types of events (e.g. keyboard and eval events)." + (dfw-device (posn-window (event-start event)))) + +(defsubst device-connection (&optional device) + "Return the connection of the specified device. +DEVICE defaults to the selected device if omitted" + (or (cdr-safe (assq 'display (frame-parameters device))) "stdio")) + +(defun find-device (connection &optional type) + "Look for an existing device attached to connection CONNECTION. +Return the device if found; otherwise, return nil. + +If TYPE is specified, only return devices of that type; otherwise, +return devices of any type. (It is possible, although unlikely, +that two devices of different types could have the same connection +name; in such a case, the first device found is returned.)" + (let ((devices (device-list)) + (retval nil)) + (while (and devices (not nil)) + (if (equal connection (device-connection (car devices))) + (setq retval (car devices))) + (setq devices (cdr devices))) + retval)) + +(defalias 'get-device 'find-device) + +(defmacro device-baud-rate (&optional device) + "Return the output baud rate of DEVICE." + 'baud-rate) + +(defsubst device-on-window-system-p (&optional device) + "Return non-nil if DEVICE is on a window system. +This generally means that there is support for the mouse, the menubar, +the toolbar, glyphs, etc." + (and (cdr-safe (assq 'display (frame-parameters device))) t)) + +(defsubst device-name (&optional device) + "Return the name of the specified device." + (or (cdr-safe (assq 'display (frame-parameters device))) "stdio")) + +(defun device-frame-list (&optional device) + "Return a list of all frames on DEVICE. +If DEVICE is nil, the selected device will be used." + (let ((desired (device-connection device))) + (filtered-frame-list (function (lambda (x) (equal (device-connection x) + desired)))))) +(defun device-list () + "Return a list of all devices" + (let ((seen nil) + (cur nil) + (conn nil) + (retval nil) + (not-heard (frame-list))) + (while not-heard + (setq cur (car not-heard) + conn (device-connection cur) + not-heard (cdr not-heard)) + (if (member conn seen) + nil ; Already got it + (setq seen (cons conn seen) ; Whoo hoo, a new one! + retval (cons cur retval)))) + retval)) + +(defvar delete-device-hook nil + "Function or functions to call when a device is deleted. +One argument, the to-be-deleted device.") + +(defun delete-device (device &optional force) + "Delete DEVICE, permanently eliminating it from use. +Normally, you cannot delete the last non-minibuffer-only frame (you must +use `save-buffers-kill-emacs' or `kill-emacs'). However, if optional +second argument FORCE is non-nil, you can delete the last frame. (This +will automatically call `save-buffers-kill-emacs'.)" + (let ((frames (device-frame-list device))) + (run-hook-with-args 'delete-device-hook device) + (while frames + (delete-frame (car frames) force) + (setq frames (cdr frames))))) + +(defsubst device-color-cells (&optional device) + (case window-system + ((x win32 pm) (x-display-color-cells device)) + (ns (ns-display-color-cells device)) + (otherwise 1))) + +(defsubst device-pixel-width (&optional device) + (case window-system + ((x win32 pm) (x-display-pixel-width device)) + (ns (ns-display-pixel-width device)) + (otherwise (frame-width device)))) + +(defsubst device-pixel-height (&optional device) + (case window-system + ((x win32 pm) (x-display-pixel-height device)) + (ns (ns-display-pixel-height device)) + (otherwise (frame-height device)))) + +(defsubst device-mm-width (&optional device) + (case window-system + ((x win32 pm) (x-display-mm-width device)) + (ns (ns-display-mm-width device)) + (otherwise nil))) + +(defsubst device-mm-height (&optional device) + (case window-system + ((x win32 pm) (x-display-mm-height device)) + (ns (ns-display-mm-height device)) + (otherwise nil))) + +(defsubst device-bitplanes (&optional device) + (case window-system + ((x win32 pm) (x-display-planes device)) + (ns (ns-display-planes device)) + (otherwise 2))) + +(defsubst device-class (&optional device) + (case window-system + (x ; X11 + (cond + ((fboundp 'x-display-visual-class) + (let ((val (symbol-name (x-display-visual-class device)))) + (cond + ((string-match "color" val) 'color) + ((string-match "gray-scale" val) 'grayscale) + (t 'mono)))) + ((fboundp 'x-display-color-p) + (if (x-display-color-p device) + 'color + 'mono)) + (t 'color))) + (pm ; OS/2 Presentation Manager + (cond + ((fboundp 'pm-display-visual-class) + (let ((val (symbol-name (pm-display-visual-class device)))) + (cond + ((string-match "color" val) 'color) + ((string-match "gray-scale" val) 'grayscale) + (t 'mono)))) + ((fboundp 'pm-display-color-p) + (if (pm-display-color-p device) + 'color + 'mono)) + (t 'color))) + (ns + (cond + ((fboundp 'ns-display-visual-class) + (let ((val (symbol-name (ns-display-visual-class device)))) + (cond + ((string-match "color" val) 'color) + ((string-match "gray-scale" val) 'grayscale) + (t 'mono)))) + ((fboundp 'ns-display-color-p) + (if (ns-display-color-p device) + 'color + 'mono)) + (t 'mono))) + (otherwise 'color))) + +(defsubst device-class-list () + "Returns a list of valid device classes." + (list 'color 'grayscale 'mono)) + +(defsubst valid-device-class-p (class) + "Given a CLASS, return t if it is valid. +Valid classes are 'color, 'grayscale, and 'mono." + (memq class (device-class-list))) + +(defsubst device-or-frame-type (device-or-frame) + "Return the type (e.g. `x' or `tty') of DEVICE-OR-FRAME. +DEVICE-OR-FRAME should be a device or a frame object. See `device-type' +for a description of the possible types." + (or window-system 'tty)) + +(defsubst device-type (&optional device) + "Return the type of the specified device (e.g. `x' or `tty'). +Value is `tty' for a tty device (a character-only terminal), +`x' for a device which is a connection to an X server, +'ns' for a device which is a connection to a NeXTStep dps server, +'win32' for a Windows-NT window, +'pm' for an OS/2 Presentation Manager window, +'intuition' for an Amiga screen" + (device-or-frame-type device)) + +(defsubst device-type-list () + "Return a list of valid console types." + (if window-system + (list window-system 'tty) + (list 'tty))) + +(defsubst valid-device-type-p (type) + "Given a TYPE, return t if it is valid." + (memq type (device-type-list))) + +) ; This closes the conditional on whether we are in XEmacs or not + +(provide 'devices) + +(eval-when-compile + (if (string-match "XEmacs" (emacs-version)) + (set 'byte-optimize t)))
--- a/lisp/w3/docomp.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/w3/docomp.el Mon Aug 13 09:31:12 2007 +0200 @@ -13,7 +13,8 @@ (setq args (cdr args)))) ;; For Emacs 19 -(w3-declare-variables 'track-mouse 'menu-bar-help-menu 'menu-bar-mode) +(w3-declare-variables 'track-mouse 'menu-bar-help-menu 'menu-bar-mode + 'global-face-data) ;; For XEmacs/Lucid (w3-declare-variables 'current-menubar 'default-menubar 'extent @@ -31,7 +32,7 @@ (w3-declare-variables '*noconv* '*autoconv* '*euc-japan* '*internal* 'w3-mime-list-for-code-conversion 'lc-ltn1 'mule-version 'enable-multibyte-characters - 'charset-latin-iso8859-1 + 'mc-flag 'charset-latin-iso8859-1 'file-coding-system-for-read 'file-coding-system) ;; For TM
--- a/lisp/w3/dsssl-flow.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/w3/dsssl-flow.el Mon Aug 13 09:31:12 2007 +0200 @@ -1,7 +1,7 @@ ;;; dsssl-flow.el --- DSSSL flow objects ;; Author: wmperry -;; Created: 1997/04/18 13:48:10 -;; Version: 1.2 +;; Created: 1997/04/21 15:58:59 +;; Version: 1.3 ;; Keywords: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -41,6 +41,11 @@ (clean nil) ; cleanup instance of backend ) +(defvar dsssl-flow-active-faces nil) +(defvar dsssl-flow-active-voices nil) +(make-variable-buffer-local 'dsssl-flow-active-faces) +(make-variable-buffer-local 'dsssl-flow-active-voices) + (defun dsssl-flow-display (flows processor) (let ((handler (dsssl-flow-processor-handler processor)) (flow-stack (list flows)) @@ -104,7 +109,7 @@ (applet ; Wow, Java ) (script ; Scripts - (w3-handle-empty-tag)) + ) (form-element ; Any form element ) ;; pinhead, flame, and cookie can now all be handled by
--- a/lisp/w3/font.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/w3/font.el Mon Aug 13 09:31:12 2007 +0200 @@ -1,7 +1,7 @@ ;;; font.el --- New font model ;; Author: wmperry -;; Created: 1997/04/04 16:02:58 -;; Version: 1.44 +;; Created: 1997/04/20 19:19:45 +;; Version: 1.45 ;; Keywords: faces ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -32,12 +32,36 @@ (require 'cl) (eval-and-compile - (if (not (and (string-match "XEmacs" emacs-version) - (or (> emacs-major-version 19) - (>= emacs-minor-version 14)))) - (require 'w3-sysdp))) + (require 'devices)) + +(eval-and-compile + (if (not (fboundp 'try-font-name)) + (defsubst try-font-name (fontname &rest args) + (case window-system + ((x win32 pm) (car-safe (x-list-fonts fontname))) + (ns (car-safe (ns-list-fonts fontname))) + (otherwise nil)))) + (if (not (fboundp 'facep)) + (defsubst facep (face) + "Return t if X is a face name or an internal face vector." + (if (not window-system) + nil ; FIXME if FSF ever does TTY faces + (and (or (internal-facep face) + (and (symbolp face) (assq face global-face-data))) + t)))) + (if (not (fboundp 'set-face-property)) + (defsubst set-face-property (face property value &optional locale + tag-set how-to-add) + "Change a property of FACE." + (and (symbolp face) + (put face property value)))) + (if (not (fboundp 'face-property)) + (defsubst face-property (face property &optional locale tag-set exact-p) + "Return FACE's value of the given PROPERTY." + (and (symbolp face) (get face property))))) (require 'disp-table) + (if (not (fboundp '<<)) (fset '<< 'lsh)) (if (not (fboundp '&)) (fset '& 'logand)) (if (not (fboundp '|)) (fset '| 'logior))
--- a/lisp/w3/url-vars.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/w3/url-vars.el Mon Aug 13 09:31:12 2007 +0200 @@ -1,7 +1,7 @@ ;;; url-vars.el --- Variables for Uniform Resource Locator tool ;; Author: wmperry -;; Created: 1997/04/18 20:28:20 -;; Version: 1.54 +;; Created: 1997/04/21 22:07:55 +;; Version: 1.55 ;; Keywords: comm, data, processes, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -38,7 +38,7 @@ (defmacro defcustom (var value doc &rest args) (` (defvar (, var) (, value) (, doc)))))) -(defconst url-version (let ((x "p3.0.83")) +(defconst url-version (let ((x "p3.0.84")) (if (string-match "State: \\([^ \t\n]+\\)" x) (substring x (match-beginning 1) (match-end 1)) x))
--- a/lisp/w3/w3-display.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/w3/w3-display.el Mon Aug 13 09:31:12 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-display.el --- display engine v99999 ;; Author: wmperry -;; Created: 1997/04/11 14:42:46 -;; Version: 1.173 +;; Created: 1997/04/21 21:59:42 +;; Version: 1.175 ;; Keywords: faces, help, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -27,6 +27,8 @@ ;;; Boston, MA 02111-1307, USA. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (require 'cl) +(eval-when-compile + (require 'w3-props)) (require 'css) (require 'font) (require 'w3-widget) @@ -770,6 +772,15 @@ ;; The table handling +(if (and w3-running-xemacs (featurep 'mule)) + (make-charset 'w3-dingbats "Dingbats character set for Emacs/W3" + '(registry "" dimension 1 chars 96 final ?:))) + +(defun w3-make-char (oct) + (if (and w3-running-xemacs (featurep 'mule)) + (make-char 'w3-dingbats (if (characterp oct) (char-int oct) oct)) + oct)) + (defvar w3-table-ascii-border-chars [nil nil nil ?/ nil ?- ?\\ ?- nil ?\\ ?| ?| ?/ ?- ?| ?+] "*Vector of ascii characters to use to draw table borders. @@ -781,7 +792,23 @@ This vector is used when terminal characters are used via glyphs") (defvar w3-table-graphic-border-chars - [nil nil nil ?j nil ?q ?m ?v nil ?k ?x ?u ?l ?w ?t ?n] + (vector + nil + nil + nil + (w3-make-char ?j) + nil + (w3-make-char ?q) + (w3-make-char ?m) + (w3-make-char ?v) + nil + (w3-make-char ?k) + (w3-make-char ?x) + (w3-make-char ?u) + (w3-make-char ?l) + (w3-make-char ?w) + (w3-make-char ?t) + (w3-make-char ?n)) "Vector of characters to use to draw table borders. This vector is used when terminal characters are used directly")
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/w3-props.el Mon Aug 13 09:31:12 2007 +0200 @@ -0,0 +1,94 @@ +;;; w3-props.el --- Additional text property stuff +;; Author: wmperry +;; Created: 1997/04/20 19:19:14 +;; Version: 1.1 +;; Keywords: faces + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu) +;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. +;;; +;;; This file is part of GNU Emacs. +;;; +;;; GNU Emacs is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; GNU Emacs is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Emacs; see the file COPYING. If not, write to the +;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;;; Boston, MA 02111-1307, USA. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Additional text property functions. + +;; The following three text property functions are not generally available (and +;; it's not certain that they should be) so they are inlined for speed. +;; The case for `fillin-text-property' is simple; it may or not be generally +;; useful. (Since it is used here, it is useful in at least one place.;-) +;; However, the case for `append-text-property' and `prepend-text-property' is +;; more complicated. Should they remove duplicate property values or not? If +;; so, should the first or last duplicate item remain? Or the one that was +;; added? In our implementation, the first duplicate remains. + +(defsubst fillin-text-property (start end setprop markprop value &optional object) + "Fill in one property of the text from START to END. +Arguments PROP and VALUE specify the property and value to put where none are +already in place. Therefore existing property values are not overwritten. +Optional argument OBJECT is the string or buffer containing the text." + (let ((start (text-property-any start end markprop nil object)) next) + (while start + (setq next (next-single-property-change start markprop object end)) + (put-text-property start next setprop value object) + (put-text-property start next markprop value object) + (setq start (text-property-any next end markprop nil object))))) + +(if (not (fboundp 'unique)) + (defsubst unique (list) + "Uniquify LIST, deleting elements using `delq'. +Return the list with subsequent duplicate items removed by side effects." + (let ((list list)) + (while list + (setq list (setcdr list (delq (car list) (cdr list)))))) + list)) + +;; A generalisation of `facemenu-add-face' for any property, but without the +;; removal of inactive faces via `facemenu-discard-redundant-faces' and special +;; treatment of `default'. Uses `unique' to remove duplicate property values. +(defsubst prepend-text-property (start end prop value &optional object) + "Prepend to one property of the text from START to END. +Arguments PROP and VALUE specify the property and value to prepend to the value +already in place. The resulting property values are always lists, and unique. +Optional argument OBJECT is the string or buffer containing the text." + (let ((val (if (listp value) value (list value))) next prev) + (while (/= start end) + (setq next (next-single-property-change start prop object end) + prev (get-text-property start prop object)) + (put-text-property + start next prop + (unique (append val (if (listp prev) prev (list prev)))) + object) + (setq start next)))) + +(defsubst append-text-property (start end prop value &optional object) + "Append to one property of the text from START to END. +Arguments PROP and VALUE specify the property and value to append to the value +already in place. The resulting property values are always lists, and unique. +Optional argument OBJECT is the string or buffer containing the text." + (let ((val (if (listp value) value (list value))) next prev) + (while (/= start end) + (setq next (next-single-property-change start prop object end) + prev (get-text-property start prop object)) + (put-text-property + start next prop + (unique (append (if (listp prev) prev (list prev)) val)) + object) + (setq start next)))) + +(provide 'w3-props)
--- a/lisp/w3/w3-speak.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/w3/w3-speak.el Mon Aug 13 09:31:12 2007 +0200 @@ -192,6 +192,7 @@ (when (> now (+ 3 url-speak-last-progress-indication)) (setq url-speak-last-progress-indication now) + (apply 'message (ad-get-args 0)) (emacspeak-auditory-icon 'progress)))) (provide 'w3-speak)
--- a/lisp/w3/w3-sysdp.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/w3/w3-sysdp.el Mon Aug 13 09:31:12 2007 +0200 @@ -322,104 +322,6 @@ (if tail (setcdr tail new-parent)))) -(sysdep-defun facep (face) - "Return t if X is a face name or an internal face vector." - ;; CAUTION!!! This is Emacs 19.x, for x <= 28, specific - ;; I know of no version of Lucid Emacs or XEmacs that did not have - ;; facep. Even if they did, they are unsupported, so big deal. - (if (not window-system) - nil ; FIXME if FSF ever does TTY faces - (and (or (internal-facep face) - (and (symbolp face) (assq face global-face-data))) - t))) - -(sysdep-defun set-face-property (face property value &optional locale - tag-set how-to-add) - "Change a property of FACE." - (and (symbolp face) - (put face property value))) - -(sysdep-defun face-property (face property &optional locale tag-set exact-p) - "Return FACE's value of the given PROPERTY." - (and (symbolp face) (get face property))) - -;;; Additional text property functions. - -;; The following three text property functions are not generally available (and -;; it's not certain that they should be) so they are inlined for speed. -;; The case for `fillin-text-property' is simple; it may or not be generally -;; useful. (Since it is used here, it is useful in at least one place.;-) -;; However, the case for `append-text-property' and `prepend-text-property' is -;; more complicated. Should they remove duplicate property values or not? If -;; so, should the first or last duplicate item remain? Or the one that was -;; added? In our implementation, the first duplicate remains. - -(sysdep-defun fillin-text-property (start end setprop markprop value &optional object) - "Fill in one property of the text from START to END. -Arguments PROP and VALUE specify the property and value to put where none are -already in place. Therefore existing property values are not overwritten. -Optional argument OBJECT is the string or buffer containing the text." - (let ((start (text-property-any start end markprop nil object)) next) - (while start - (setq next (next-single-property-change start markprop object end)) - (put-text-property start next setprop value object) - (put-text-property start next markprop value object) - (setq start (text-property-any next end markprop nil object))))) - -;; This function (from simon's unique.el) is rewritten and inlined for speed. -;(defun unique (list function) -; "Uniquify LIST, deleting elements using FUNCTION. -;Return the list with subsequent duplicate items removed by side effects. -;FUNCTION is called with an element of LIST and a list of elements from LIST, -;and should return the list of elements with occurrences of the element removed, -;i.e., a function such as `delete' or `delq'. -;This function will work even if LIST is unsorted. See also `uniq'." -; (let ((list list)) -; (while list -; (setq list (setcdr list (funcall function (car list) (cdr list)))))) -; list) - -(sysdep-defun unique (list) - "Uniquify LIST, deleting elements using `delq'. -Return the list with subsequent duplicate items removed by side effects." - (let ((list list)) - (while list - (setq list (setcdr list (delq (car list) (cdr list)))))) - list) - -;; A generalisation of `facemenu-add-face' for any property, but without the -;; removal of inactive faces via `facemenu-discard-redundant-faces' and special -;; treatment of `default'. Uses `unique' to remove duplicate property values. -(sysdep-defun prepend-text-property (start end prop value &optional object) - "Prepend to one property of the text from START to END. -Arguments PROP and VALUE specify the property and value to prepend to the value -already in place. The resulting property values are always lists, and unique. -Optional argument OBJECT is the string or buffer containing the text." - (let ((val (if (listp value) value (list value))) next prev) - (while (/= start end) - (setq next (next-single-property-change start prop object end) - prev (get-text-property start prop object)) - (put-text-property - start next prop - (unique (append val (if (listp prev) prev (list prev)))) - object) - (setq start next)))) - -(sysdep-defun append-text-property (start end prop value &optional object) - "Append to one property of the text from START to END. -Arguments PROP and VALUE specify the property and value to append to the value -already in place. The resulting property values are always lists, and unique. -Optional argument OBJECT is the string or buffer containing the text." - (let ((val (if (listp value) value (list value))) next prev) - (while (/= start end) - (setq next (next-single-property-change start prop object end) - prev (get-text-property start prop object)) - (put-text-property - start next prop - (unique (append (if (listp prev) prev (list prev)) val)) - object) - (setq start next)))) - (sysdep-defun buffer-substring-no-properties (st nd) "Return the characters of part of the buffer, without the text properties. The two arguments START and END are character positions; @@ -452,349 +354,6 @@ (setq plist (cdr (cdr plist)))) (and plist (car (cdr plist)))) -;; Device functions -;; By wmperry@cs.indiana.edu -;; This is a complete implementation of all the device-* functions found in -;; XEmacs 19.14. A 'device' for Emacs 19 is just a frame, from which we can -;; determine the connection to an X display, etc. - -(sysdep-defalias 'selected-device 'ignore) -(sysdep-defalias 'device-or-frame-p 'framep) -(sysdep-defalias 'device-console 'ignore) -(sysdep-defalias 'device-sound-enabled-p 'ignore) -(sysdep-defalias 'device-live-p 'frame-live-p) -(sysdep-defalias 'devicep 'framep) -(sysdep-defalias 'frame-device 'identity) -(sysdep-defalias 'redisplay-device 'redraw-frame) -(sysdep-defalias 'redraw-device 'redraw-frame) -(sysdep-defalias 'select-device 'select-frame) -(sysdep-defalias 'set-device-class 'ignore) - -(sysdep-defun make-device (type connection &optional props) - "Create a new device of type TYPE, attached to connection CONNECTION. - -The valid values for CONNECTION are device-specific; however, -CONNECTION is generally a string. (Specifically, for X devices, -CONNECTION should be a display specification such as \"foo:0\", and -for TTY devices, CONNECTION should be the filename of a TTY device -file, such as \"/dev/ttyp4\", or nil to refer to XEmacs' standard -input/output.) - -PROPS, if specified, should be a plist of properties controlling -device creation. - -If CONNECTION specifies an already-existing device connection, that -device is simply returned; no new device is created, and PROPS -have no effect." - (cond - ((and (eq type 'x) connection) - (make-frame-on-display connection props)) - ((eq type 'x) - (make-frame props)) - ((eq type 'tty) - nil) - (t - (error "Unsupported device-type: %s" type)))) - -(sysdep-defun make-frame-on-device (type connection &optional props) - "Create a frame of type TYPE on CONNECTION. -TYPE should be a symbol naming the device type, i.e. one of - -x An X display. CONNECTION should be a standard display string - such as \"unix:0\", or nil for the display specified on the - command line or in the DISPLAY environment variable. Only if - support for X was compiled into XEmacs. -tty A standard TTY connection or terminal. CONNECTION should be - a TTY device name such as \"/dev/ttyp2\" (as determined by - the Unix command `tty') or nil for XEmacs' standard input - and output (usually the TTY in which XEmacs started). Only - if support for TTY's was compiled into XEmacs. -ns A connection to a machine running the NeXTstep windowing - system. Not currently implemented. -win32 A connection to a machine running Microsoft Windows NT or - Windows 95. Not currently implemented. -pc A direct-write MS-DOS frame. Not currently implemented. - -PROPS should be an plist of properties, as in the call to `make-frame'. - -If a connection to CONNECTION already exists, it is reused; otherwise, -a new connection is opened." - (make-device type connection props)) - -(sysdep-defun make-tty-device (&optional tty terminal-type) - "Create a new device on TTY. - TTY should be the name of a tty device file (e.g. \"/dev/ttyp3\" under -SunOS et al.), as returned by the `tty' command. A value of nil means -use the stdin and stdout as passed to XEmacs from the shell. - If TERMINAL-TYPE is non-nil, it should be a string specifying the -type of the terminal attached to the specified tty. If it is nil, -the terminal type will be inferred from the TERM environment variable." - (make-device 'tty tty (list 'terminal-type terminal-type))) - -(sysdep-defun make-x-device (&optional display) - (make-device 'x display)) - -(sysdep-defun set-device-selected-frame (device frame) - "Set the selected frame of device object DEVICE to FRAME. -If DEVICE is nil, the selected device is used. -If DEVICE is the selected device, this makes FRAME the selected frame." - (select-frame frame)) - -(sysdep-defun set-device-baud-rate (device rate) - "Set the output baud rate of DEVICE to RATE. -On most systems, changing this value will affect the amount of padding -and other strategic decisions made during redisplay." - (setq baud-rate rate)) - -(sysdep-defun dfw-device (obj) - "Given a device, frame, or window, return the associated device. -Return nil otherwise." - (cond - ((windowp obj) - (window-frame obj)) - ((framep obj) - obj) - (t - nil))) - -(sysdep-defun event-device (event) - "Return the device that EVENT occurred on. -This will be nil for some types of events (e.g. keyboard and eval events)." - (dfw-device (posn-window (event-start event)))) - -(sysdep-defun find-device (connection &optional type) - "Look for an existing device attached to connection CONNECTION. -Return the device if found; otherwise, return nil. - -If TYPE is specified, only return devices of that type; otherwise, -return devices of any type. (It is possible, although unlikely, -that two devices of different types could have the same connection -name; in such a case, the first device found is returned.)" - (let ((devices (device-list)) - (retval nil)) - (while (and devices (not nil)) - (if (equal connection (device-connection (car devices))) - (setq retval (car devices))) - (setq devices (cdr devices))) - retval)) - -(sysdep-defalias 'get-device 'find-device) - -(sysdep-defun device-baud-rate (&optional device) - "Return the output baud rate of DEVICE." - baud-rate) - -(sysdep-defun device-on-window-system-p (&optional device) - "Return non-nil if DEVICE is on a window system. -This generally means that there is support for the mouse, the menubar, -the toolbar, glyphs, etc." - (and (cdr-safe (assq 'display (frame-parameters device))) t)) - -(sysdep-defun device-name (&optional device) - "Return the name of the specified device." - ;; doesn't handle the 19.29 multiple X display stuff yet - ;; doesn't handle NeXTStep either - (cond - ((null window-system) "stdio") - ((getenv "DISPLAY") - (let ((str (getenv "DISPLAY")) - (x (1- (length (getenv "DISPLAY")))) - (y 0)) - (while (/= y x) - (if (or (= (aref str y) ?:) - (= (aref str y) ?.)) - (aset str y ?-)) - (setq y (1+ y))) - str)) - (t "stdio"))) - -(sysdep-defun device-connection (&optional device) - "Return the connection of the specified device. -DEVICE defaults to the selected device if omitted" - (or (cdr-safe (assq 'display (frame-parameters device))) "stdio")) - -(sysdep-defun device-frame-list (&optional device) - "Return a list of all frames on DEVICE. -If DEVICE is nil, the selected device will be used." - (let ((desired (device-connection device))) - (filtered-frame-list (function (lambda (x) (equal (device-connection x) - desired)))))) -(sysdep-defun device-list () - "Return a list of all devices" - (let ((seen nil) - (cur nil) - (conn nil) - (retval nil) - (not-heard (frame-list))) - (while not-heard - (setq cur (car not-heard) - conn (device-connection cur) - not-heard (cdr not-heard)) - (if (member conn seen) - nil ; Already got it - (setq seen (cons conn seen) ; Whoo hoo, a new one! - retval (cons cur retval)))) - retval)) - -(sysdep-defvar delete-device-hook nil - "Function or functions to call when a device is deleted. -One argument, the to-be-deleted device.") - -(sysdep-defun delete-device (device &optional force) - "Delete DEVICE, permanently eliminating it from use. -Normally, you cannot delete the last non-minibuffer-only frame (you must -use `save-buffers-kill-emacs' or `kill-emacs'). However, if optional -second argument FORCE is non-nil, you can delete the last frame. (This -will automatically call `save-buffers-kill-emacs'.)" - (let ((frames (device-frame-list device))) - (run-hook-with-args 'delete-device-hook device) - (while frames - (delete-frame (car frames) force) - (setq frames (cdr frames))))) - -(sysdep-defalias 'device-color-cells - (cond - ((null window-system) 'ignore) - ((fboundp 'display-color-cells) 'display-color-cells) - ((fboundp 'x-display-color-cells) 'x-display-color-cells) - ((fboundp 'ns-display-color-cells) 'ns-display-color-celles) - (t 'ignore))) - -(sysdep-defun try-font-name (fontname &rest args) - (cond - ((eq window-system 'x) (car-safe (x-list-fonts fontname))) - ((eq window-system 'ns) (car-safe (ns-list-fonts fontname))) - ((eq window-system 'win32) (car-safe (x-list-fonts fontname))) - ((eq window-system 'pm) (car-safe (x-list-fonts fontname))) - (t nil))) - -(sysdep-defalias 'device-pixel-width - (cond - ((and (memq window-system '(x win32 pm)) (fboundp 'x-display-pixel-width)) - 'x-display-pixel-width) - ((and (eq window-system 'ns) (fboundp 'ns-display-pixel-width)) - 'ns-display-pixel-width) - (t 'ignore))) - -(sysdep-defalias 'device-pixel-height - (cond - ((and (memq window-system '(x win32 pm)) (fboundp 'x-display-pixel-height)) - 'x-display-pixel-height) - ((and (eq window-system 'ns) (fboundp 'ns-display-pixel-height)) - 'ns-display-pixel-height) - (t 'ignore))) - -(sysdep-defalias 'device-mm-width - (cond - ((and (memq window-system '(x win32 pm)) (fboundp 'x-display-mm-width)) - 'x-display-mm-width) - ((and (eq window-system 'ns) (fboundp 'ns-display-mm-width)) - 'ns-display-mm-width) - (t 'ignore))) - -(sysdep-defalias 'device-mm-height - (cond - ((and (memq window-system '(x win32 pm)) (fboundp 'x-display-mm-height)) - 'x-display-mm-height) - ((and (eq window-system 'ns) (fboundp 'ns-display-mm-height)) - 'ns-display-mm-height) - (t 'ignore))) - -(sysdep-defalias 'device-bitplanes - (cond - ((and (memq window-system '(x win32 pm)) (fboundp 'x-display-planes)) - 'x-display-planes) - ((and (eq window-system 'ns) (fboundp 'ns-display-planes)) - 'ns-display-planes) - (t 'ignore))) - -(sysdep-defalias 'device-class - (cond - ;; First, Xwindows - ((and (eq window-system 'x) (fboundp 'x-display-visual-class)) - (function - (lambda (&optional device) - (let ((val (symbol-name (x-display-visual-class device)))) - (cond - ((string-match "color" val) 'color) - ((string-match "gray-scale" val) 'grayscale) - (t 'mono)))))) - ;; Now, Presentation-Manager under OS/2 - ((and (eq window-system 'pm) (fboundp 'pm-display-visual-class)) - (function - (lambda (&optional device) - (let ((val (symbol-name (pm-display-visual-class device)))) - (cond - ((string-match "color" val) 'color) - ((string-match "gray-scale" val) 'grayscale) - (t 'mono)))))) - ;; A slightly different way of doing it under OS/2 - ((and (eq window-system 'pm) (fboundp 'pm-display-color-p)) - (function - (lambda (&optional device) - (if (pm-display-color-p) - 'color - 'mono)))) - ((fboundp 'number-of-colors) - (function - (lambda (&optional device) - (if (= 2 (number-of-colors)) - 'mono - 'color)))) - ((and (eq window-system 'x) (fboundp 'x-color-p)) - (function - (lambda (&optional device) - (if (x-color-p) - 'color - 'mono)))) - ((and (eq window-system 'ns) (fboundp 'ns-display-visual-class)) - (function - (lambda (&optional device) - (let ((val (symbol-name (ns-display-visual-class)))) - (cond - ((string-match "color" val) 'color) - ((string-match "gray-scale" val) 'grayscale) - (t 'mono)))))) - (t (function (lambda (&optional device) 'color))))) - -(sysdep-defun device-class-list () - "Returns a list of valid device classes." - (list 'color 'grayscale 'mono)) - -(sysdep-defun valid-device-class-p (class) - "Given a CLASS, return t if it is valid. -Valid classes are 'color, 'grayscale, and 'mono." - (memq class (device-class-list))) - -(sysdep-defun device-or-frame-type (device-or-frame) - "Return the type (e.g. `x' or `tty') of DEVICE-OR-FRAME. -DEVICE-OR-FRAME should be a device or a frame object. See `device-type' -for a description of the possible types." - (if (or (cdr-safe (assq 'display (frame-parameters device-or-frame))) - (cdr-safe (assq 'window-id (frame-parameters device-or-frame)))) - window-system - 'tty)) - -(sysdep-defun device-type (&optional device) - "Return the type of the specified device (e.g. `x' or `tty'). -Value is `tty' for a tty device (a character-only terminal), -`x' for a device which is a connection to an X server, -'ns' for a device which is a connection to a NeXTStep dps server, -'win32' for a Windows-NT window, -'pm' for an OS/2 Presentation Manager window, -'intuition' for an Amiga screen" - (device-or-frame-type device)) - -(sysdep-defun device-type-list () - "Return a list of valid console types." - (if window-system - (list window-system 'tty) - (list 'tty))) - -(sysdep-defun valid-device-type-p (type) - "Given a TYPE, return t if it is valid." - (memq type (device-type-list))) - ;; Extent stuff (sysdep-fset 'delete-extent 'delete-overlay) (sysdep-fset 'extent-end-position 'overlay-end)
--- a/lisp/w3/w3-vars.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/w3/w3-vars.el Mon Aug 13 09:31:12 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-vars.el,v --- All variable definitions for emacs-w3 ;; Author: wmperry -;; Created: 1997/04/18 20:28:20 -;; Version: 1.125 +;; Created: 1997/04/21 22:07:54 +;; Version: 1.126 ;; Keywords: comm, help, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -33,7 +33,7 @@ (require 'w3-cus) ; Grab everything that is customized (defconst w3-version-number - (let ((x "p3.0.83")) + (let ((x "p3.0.84")) (if (string-match "State:[ \t\n]+.\\([^ \t\n]+\\)" x) (setq x (substring x (match-beginning 1) (match-end 1))) (setq x (substring x 1))) @@ -41,7 +41,7 @@ (function (lambda (x) (if (= x ?-) "." (char-to-string x)))) x "")) "Version # of w3-mode.") -(defconst w3-version-date (let ((x "1997/04/18 20:28:20")) +(defconst w3-version-date (let ((x "1997/04/21 22:07:54")) (if (string-match "Date: \\([^ \t\n]+\\)" x) (substring x (match-beginning 1) (match-end 1)) x))
--- a/lisp/w3/w3-xemac.el Mon Aug 13 09:30:13 2007 +0200 +++ b/lisp/w3/w3-xemac.el Mon Aug 13 09:31:12 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-xemac.el --- XEmacs specific functions for emacs-w3 ;; Author: wmperry -;; Created: 1997/04/10 00:03:38 -;; Version: 1.18 +;; Created: 1997/04/21 21:59:34 +;; Version: 1.20 ;; Keywords: faces, help, mouse, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
--- a/lwlib/lwlib.c Mon Aug 13 09:30:13 2007 +0200 +++ b/lwlib/lwlib.c Mon Aug 13 09:31:12 2007 +0200 @@ -36,7 +36,7 @@ #define alloca __builtin_alloca #endif -#if ((!__GNUC__) && !defined(__hpux)) && !defined(_AIX) && !defined (_SCO_DS) && !defined (__USLC__) && !defined(sinix) && !defined(WINDOWSNT) +#if ((!__GNUC__) && !defined(__hpux)) && !defined(_AIX) && !defined (_SCO_DS) && !defined (__USLC__) && !defined(sinix) && !defined(WINDOWSNT) && !defined(_SEQUENT_) #include <alloca.h> #endif
--- a/lwlib/xlwmenu.c Mon Aug 13 09:30:13 2007 +0200 +++ b/lwlib/xlwmenu.c Mon Aug 13 09:31:12 2007 +0200 @@ -69,6 +69,10 @@ #else {XtNfont, XtCFont, XtRFontStruct, sizeof(XFontStruct *), offset(menu.font), XtRString, "XtDefaultFont"}, +# ifdef USE_XFONTSET + {XtNfontSet, XtCFontSet, XtRFontSet, sizeof(XFontSet), + offset(menu.font_set), XtRString, "XtDefaultFontSet"}, +# endif #endif {XtNforeground, XtCForeground, XtRPixel, sizeof(Pixel), offset(menu.foreground), XtRString, "XtDefaultForeground"}, @@ -328,10 +332,16 @@ XmStringExtent (mw->menu.font_list, s, &width, &height); return width; #else +# ifdef USE_XFONTSET + XRectangle ri, rl; + XmbTextExtents (mw->menu.font_set, s, strlen (s), &ri, &rl); + return rl.width; +# else XCharStruct xcs; int drop; XTextExtents (mw->menu.font, s, strlen (s), &drop, &drop, &drop, &xcs); return xcs.width; +# endif /* USE_XFONTSET */ #endif } @@ -686,8 +696,13 @@ 0, /* ???? layout_direction */ 0); #else +# ifdef USE_XFONTSET + XmbDrawString (XtDisplay (mw), window, mw->menu.font_set, gc, + x, y + mw->menu.font_ascent, string, strlen (string)); +# else XDrawString (XtDisplay (mw), window, gc, x, y + mw->menu.font_ascent, string, strlen (string)); +# endif /* USE_XFONTSET */ #endif } @@ -2660,8 +2675,28 @@ XmFontListFreeFontContext (context); } #else /* Not Motif */ +# ifdef USE_XFONTSET + XFontStruct **fontstruct_list; + char **fontname_list; + XFontStruct *font; + int fontcount = XFontsOfFontSet(mw->menu.font_set, &fontstruct_list, + &fontname_list); + mw->menu.font_ascent = 0; + mw->menu.font_descent = 0; +# if 0 /* nasty, personal debug, Kazz */ + fprintf(stderr, "fontSet count is %d\n", fontcount); +# endif + while (--fontcount >= 0) { + font = fontstruct_list[fontcount]; + if (font->ascent > (int) mw->menu.font_ascent) + mw->menu.font_ascent = font->ascent; + if (font->descent > (int) mw->menu.font_descent) + mw->menu.font_descent = font->descent; + } +# else /* ! USE_XFONTSET */ mw->menu.font_ascent = mw->menu.font->ascent; mw->menu.font_descent = mw->menu.font->descent; +# endif #endif /* NEED_MOTIF */ }
--- a/lwlib/xlwmenuP.h Mon Aug 13 09:30:13 2007 +0200 +++ b/lwlib/xlwmenuP.h Mon Aug 13 09:31:12 2007 +0200 @@ -28,6 +28,9 @@ XmFontList fallback_font_list; #else XFontStruct * font; +# ifdef USE_XFONTSET + XFontSet font_set; +# endif #endif Dimension font_ascent, font_descent; /* extracted from font/fontlist */
--- a/man/ChangeLog Mon Aug 13 09:30:13 2007 +0200 +++ b/man/ChangeLog Mon Aug 13 09:31:12 2007 +0200 @@ -1,3 +1,8 @@ +Sat Apr 19 20:48:00 1997 Steven L Baur <steve@altair.xemacs.org> + + * lispref/files.texi (File Name Expansion): Update documentation + of file-relative-name. + Mon Apr 7 21:02:39 1997 Steven L Baur <steve@altair.xemacs.org> * lispref/lispref.texi: Update version numbers (with patches from
--- a/man/custom.texi Mon Aug 13 09:30:13 2007 +0200 +++ b/man/custom.texi Mon Aug 13 09:31:12 2007 +0200 @@ -13,7 +13,7 @@ @comment node-name, next, previous, up @top The Customization Library -Version: 1.89 +Version: 1.84 @menu * Introduction:: @@ -492,50 +492,9 @@ @table @code @item :type @var{value} should be a widget type. - @item :options @var{value} should be a list of possible members of the specified type. For hooks, this is a list of function names. - -@item :initialize -@var{value} should be a function used to initialize the variable. It -takes two arguments, the symbol and value given in the @code{defcustom} call. -Some predefined functions are: - -@table @code -@item custom-initialize-set -Use the @code{:set} method to initialize the variable. Do not -initialize it if already bound. This is the default @code{:initialize} -method. - -@item custom-initialize-default -Always use @code{set-default} to initialize the variable, even if a -@code{:set} method has been specified. - -@item custom-initialize-reset -If the variable is already bound, reset it by calling the @code{:set} -method with the value returned by the @code{:get} method. - -@item custom-initialize-changed -Like @code{custom-initialize-reset}, but use @code{set-default} to -initialize the variable if it is not bound and has not been set -already. -@end table - -@item :set -@var{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 @code{set-default}. - -@item :get -@var{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 @code{default-value}. - -@item :require -@var{value} should be a feature symbol. Each feature will be required -after initialization, of the the user have saved this option. - @end table @xref{Sexp Types,,,widget,The Widget Library}, for information about @@ -606,7 +565,7 @@ Internally, custom uses the symbol property @code{factory-face} for the program specified default face properties, @code{saved-face} for -properties saved by the user, and @code{face-documentation} for the +properties saved by the user, and @code{face-doc-string} for the documentation string.@refill @end defun @@ -675,6 +634,11 @@ @section Wishlist @itemize @bullet +@item +The menu items should be grayed out when the information is +missing. I.e. if a variable doesn't have a factory setting, the user +should not be allowed to select the @samp{Factory} menu item. + @item Better support for keyboard operations in the customize buffer. @@ -699,6 +663,10 @@ Make it possible to append to `choice', `radio', and `set' options. @item +Make it possible to customize code, for example to enable or disable a +global minor mode. + +@item Ask whether set or modified variables should be saved in @code{kill-buffer-hook}. @@ -721,32 +689,6 @@ Make it possible to include a comment/remark/annotation when saving an option. -@item -Add some direct support for meta variables, i.e. make it possible to -specify that this variable should be reset when that variable is -changed. - -@item -Add tutorial. - -@item -Describe the @code{:type} syntax in this manual. - -@item -Find a place is this manual for the following text: - -@strong{Radio vs. Buttons} - -Use a radio if you can't find a good way to describe the item in the -choice menu text. I.e. it is better to use a radio if you expect the -user would otherwise manually select each item from the choice menu in -turn to see what it expands too. - -Avoid radios if some of the items expands to complex structures. - -I mostly use radios when most of the items are of type -@code{function-item} or @code{variable-item}. - @end itemize @contents
--- a/man/gnus.texi Mon Aug 13 09:30:13 2007 +0200 +++ b/man/gnus.texi Mon Aug 13 09:31:12 2007 +0200 @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Gnus 5.4.45 Manual +@settitle Gnus 5.4.46 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -287,7 +287,7 @@ @tex @titlepage -@title Gnus 5.4.45 Manual +@title Gnus 5.4.46 Manual @author by Lars Magne Ingebrigtsen @page @@ -323,7 +323,7 @@ spool or your mbox file. All at the same time, if you want to push your luck. -This manual corresponds to Gnus 5.4.45. +This manual corresponds to Gnus 5.4.46. @end ifinfo @@ -3727,8 +3727,11 @@ @item S O p @kindex S O p (Summary) @findex gnus-uu-digest-post-forward +@cindex digests +@cindex making digests Digest the current series and forward the result to a newsgroup -(@code{gnus-uu-digest-mail-forward}). +(@code{gnus-uu-digest-mail-forward}). This command uses the +process/prefix convention. @item S u @kindex S u (Summary) @@ -6369,10 +6372,10 @@ @subsection Pick and Read @cindex pick and read -Some newsreaders (like @code{nn} and, uhm, @code{nn}) use a two-phased -reading interface. The user first marks the articles she wants to read -from a summary buffer. Then she starts reading the articles with just -an article buffer displayed. +Some newsreaders (like @code{nn} and, uhm, @code{Netnews} on VM/CMS) use +a two-phased reading interface. The user first marks the articles she +wants to read from a summary buffer. Then she starts reading the +articles with just an article buffer displayed. @findex gnus-pick-mode @kindex M-x gnus-pick-mode @@ -13474,7 +13477,10 @@ First, pick one (1) legal mail address that you can be reached at, and put it in your @code{From} header of all your news articles. (I've -chosen @samp{larsi@@trym.ifi.uio.no}.) +chosen @samp{larsi@@trym.ifi.uio.no}, but for many addresses on the form +@samp{larsi+usenet@@ifi.uio.no} will be a better choice. Ask your +sysadm whether your sendmail installation accepts keywords in the local +part of the mail address.) @lisp (setq message-default-news-headers @@ -13520,6 +13526,12 @@ citizen, you can even send off complaints to the proper authorities on each unsolicited commercial email---at your leisure. +If you are also a lazy net citizen, you will probably prefer complaining +automatically with the @file{gnus-junk.el} package, availiable FOR FREE +at @file{<URL:http://stud2.tuwien.ac.at/~e9426626/gnus-junk.html>}. +Since most e-mail spam is sent automatically, this may reconcile the +cosmic balance somewhat. + This works for me. It allows people an easy way to contact me (they can just press @kbd{r} in the usual way), and I'm not bothered at all with spam. It's a win-win situation. Forging @code{From} headers to point @@ -16022,7 +16034,7 @@ files = "files" *[ space <string> ] exclude-files = "exclude-files" *[ space <string> ] read-only = "read-only" [ space "nil" / space "t" ] -adapt = "adapt" [ space "nil" / space "t" / space adapt-rule ] +adapt = "adapt" [ space "ignore" / space "t" / space adapt-rule ] adapt-rule = "(" *[ <string> *[ "(" <string> <integer> ")" ] ")" local = "local" *[ space "(" <string> space <form> ")" ] eval = "eval" space <form>
--- a/man/lispref/files.texi Mon Aug 13 09:30:13 2007 +0200 +++ b/man/lispref/files.texi Mon Aug 13 09:31:12 2007 +0200 @@ -1567,8 +1567,7 @@ @defun file-relative-name filename &optional directory This function does the inverse of expansion---it tries to return a relative name that is equivalent to @var{filename} when interpreted -relative to @var{directory}. (If such a relative name would be longer -than the absolute name, it returns the absolute name instead.) +relative to @var{directory}. @c XEmacs feature? If @var{directory} is @code{nil} or omitted, the value of @@ -1578,7 +1577,7 @@ (file-relative-name "/foo/bar" "/foo/") @result{} "bar") (file-relative-name "/foo/bar" "/hack/") - @result{} "/foo/bar") + @result{} "../foo/bar") @end example @end defun
--- a/man/message.texi Mon Aug 13 09:30:13 2007 +0200 +++ b/man/message.texi Mon Aug 13 09:31:12 2007 +0200 @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Message 5.4.45 Manual +@settitle Message 5.4.46 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -39,7 +39,7 @@ @tex @titlepage -@title Message 5.4.45 Manual +@title Message 5.4.46 Manual @author by Lars Magne Ingebrigtsen @page @@ -79,7 +79,7 @@ * Key Index:: List of Message mode keys. @end menu -This manual corresponds to Message 5.4.45. Message is distributed with +This manual corresponds to Message 5.4.46. Message is distributed with the Gnus distribution bearing the same version number as this manual has. @@ -567,7 +567,12 @@ @cindex mail aliases @cindex aliases -Message uses @code{mailabbrev} to handle mail aliases. +@vindex message-mail-alias-type +The @code{message-mail-alias-type} variable controls what type of mail +alias expansion to use. Currently only one form is supported---Message +uses @code{mailabbrev} to handle mail aliases. If this variable is +@code{nil}, no mail alias expansion will be performed. + @code{mailabbrev} works by parsing the @file{/etc/mailrc} and @file{~/.mailrc} files. These files look like: @@ -979,6 +984,35 @@ @vindex message-mode-syntax-table Syntax table used in message mode buffers. +@item message-send-method-alist +@vindex message-send-method-alist + +Alist of ways to send outgoing messages. Each element has the form + +@lisp +(TYPE PREDICATE FUNCTION) +@end lisp + +@table @var +@item type +A symbol that names the method. + +@item predicate +A function called without any parameters to determine whether the +message is a message of type @var{type}. + +@item function +A function to be called if @var{predicate} returns non-@code{nil}. +@var{function} is called with one parameter -- the prefix. +@end table + +@lisp +((news message-news-p message-send-via-news) + (mail message-mail-p message-send-via-mail)) +@end lisp + + + @end table
--- a/man/widget.texi Mon Aug 13 09:30:13 2007 +0200 +++ b/man/widget.texi Mon Aug 13 09:31:12 2007 +0200 @@ -13,7 +13,7 @@ @comment node-name, next, previous, up @top The Emacs Widget Library -Version: 1.89 +Version: 1.84 @menu * Introduction:: @@ -24,8 +24,6 @@ * Sexp Types:: * Widget Properties:: * Defining New Widgets:: -* Widget Browser:: -* Widget Minor Mode:: * Widget Wishlist.:: @end menu @@ -231,10 +229,9 @@ Activating one of these will convert it to the other. This is useful for implementing multiple-choice fields. You can create it wit @item The @samp{@b{( )}} and @samp{@b{(*)}} buttons. -Only one radio button in a @code{radio-button-choice} widget can be -selected at any time. When you push one of the unselected radio -buttons, it will be selected and the previous selected radio button will -become unselected. +Only one radio button in a @code{radio-button-choice} widget can be selected at any +time. When you push one of the unselected radio buttons, it will be +selected and the previous selected radio button will become unselected. @item The @samp{@b{[Apply Form]}} @samp{@b{[Reset Form]}} buttons. These are explicit buttons made with the @code{push-button} widget. The main difference from the @code{link} widget is that the buttons are will be @@ -588,7 +585,6 @@ * checkbox:: * checklist:: * editable-list:: -* group:: @end menu @node link, url-link, Basic Types, Basic Types @@ -925,13 +921,6 @@ Insert a literal @samp{%}. @end table -@item :greedy -Usually, a checklist will only match if the items are in the exact -sequence given in the specification. By setting @code{:greedy} to -non-nil, it will allow the items to come in any sequence. However, if -you extract the value they will be in the sequence given in the -checklist. I.e. the original sequence is forgotten. - @item button-args A list of keywords to pass to the checkboxes. Useful for setting e.g. the @samp{:help-echo} for each checkbox. @@ -946,7 +935,7 @@ The list of types. @end table -@node editable-list, group, checklist, Basic Types +@node editable-list, , checklist, Basic Types @comment node-name, next, previous, up @subsection The @code{editable-list} Widget @@ -956,7 +945,7 @@ TYPE ::= (editable-list [KEYWORD ARGUMENT]... TYPE) @end example -The value is a list, where each member represents one widget of type +The value is a list, where each member represent one widget of type @var{type}. The following extra properties are recognized. @@ -998,43 +987,30 @@ @end table -@node group, , editable-list, Basic Types -@comment node-name, next, previous, up -@subsection The @code{group} Widget - -This widget simply group other widget together. - -Syntax: - -@example -TYPE ::= (group [KEYWORD ARGUMENT]... TYPE...) -@end example - -The value is a list, with one member for each @var{type}. - @node Sexp Types, Widget Properties, Basic Types, Top @comment @section Sexp Types A number of widgets for editing s-expressions (lisp types) are also -available. These basically fall in the following categories. +available. These basically fall in three categories: @dfn{atoms}, +@dfn{composite types}, and @dfn{generic}. @menu -* constants:: * generic:: * atoms:: * composite:: @end menu -@node constants, generic, Sexp Types, Sexp Types +@node generic, atoms, Sexp Types, Sexp Types @comment node-name, next, previous, up -@subsection The Constant Widgets. +@subsection The Generic Widget. -The @code{const} widget can contain any lisp expression, but the user is +The @code{const} and @code{sexp} widgets can contain any lisp +expression. In the case of the @code{const} widget the user is prohibited from editing edit it, which is mainly useful as a component of one of the composite widgets. -The syntax for the @code{const} widget is +The syntax for the generic widgets is @example TYPE ::= (const [KEYWORD ARGUMENT]... [ VALUE ]) @@ -1048,33 +1024,6 @@ buffer. @end deffn -There are two variations of the @code{const} widget, namely -@code{variable-item} and @code{function-item}. These should contain a -symbol with a variable or function binding. The major difference from -the @code{const} widget is that they will allow the user to see the -variable or function documentation for the symbol. - -@deffn Widget variable-item -An immutable symbol that is bound as a variable. -@end deffn - -@deffn Widget function-item -An immutable symbol that is bound as a function. -@end deffn - -@node generic, atoms, constants, Sexp Types -@comment node-name, next, previous, up -@subsection Generic Sexp Widget. - -The @code{sexp} widget can contain any lisp expression, and allows the -user to edit it inline in the buffer. - -The syntax for the @code{const} widget is - -@example -TYPE ::= (const [KEYWORD ARGUMENT]... [ VALUE ]) -@end example - @deffn Widget sexp This will allow you to edit any valid s-expression in an editable buffer field. @@ -1167,8 +1116,8 @@ component. There must be exactly two components. @end deffn -@deffn Widget list -The value of a @code{list} widget is a list containing the value of +@deffn Widget lisp +The value of a @code{lisp} widget is a list containing the value of each of its component. @end deffn @@ -1309,7 +1258,7 @@ @code{:deactivated} keywords instead. -@node Defining New Widgets, Widget Browser, Widget Properties, Top +@node Defining New Widgets, Widget Wishlist., Widget Properties, Top @comment node-name, next, previous, up @section Defining New Widgets @@ -1413,48 +1362,7 @@ default'' in this text. @end deffn -@node Widget Browser, Widget Minor Mode, Defining New Widgets, Top -@comment node-name, next, previous, up -@section Widget Browser - -There is a separate package to browse widgets. This is intended to help -programmers who want to examine the content of a widget. The browser -shows the value of each keyword, but uses links for certain keywords -such as `:parent', which avoids printing cyclic structures. - -@deffn Command widget-browse WIDGET -Create a widget browser for WIDGET. -When called interactively, prompt for WIDGET. -@end deffn - -@deffn Command widget-browse-other-window WIDGET -Create a widget browser for WIDGET and show it in another window. -When called interactively, prompt for WIDGET. -@end deffn - -@deffn Command widget-browse-at POS -Create a widget browser for the widget at POS. -When called interactively, use the position of point. -@end deffn - -@node Widget Minor Mode, Widget Wishlist., Widget Browser, Top -@comment node-name, next, previous, up -@section Widget Minor Mode - -There is a minor mode for manipulating widgets in major modes that -doesn't provide any support for widgets themselves. This is mostly -intended to be useful for programmers doing experiments. - -@deffn Command widget-minor-mode -Togle minor mode for traversing widgets. -With arg, turn widget mode on if and only if arg is positive. -@end deffn - -@defvar widget-minor-mode-keymap -Keymap used in @code{widget-minor-mode}. -@end defvar - -@node Widget Wishlist., , Widget Minor Mode, Top +@node Widget Wishlist., , Defining New Widgets, Top @comment node-name, next, previous, up @section Wishlist. @@ -1482,7 +1390,7 @@ specific to the first widget where I happended to use them. @item -Finish @code{:tab-order}. +Flag to make @code{widget-move} skip a specified button. @item Document `helper' functions for defining new widgets. @@ -1514,27 +1422,13 @@ Perhaps the correct model is delegation? @item +Document @code{widget-browse}. + +@item Make indentation work with glyphs and propertional fonts. @item -Add commands to show overview of object and class hierarchies to the -browser. - -@item -Find a way to disable mouse highlight for inactive widgets. - -@item -Add @code{property-list} widget. - -@item -Add @code{association-list} widget. - -@item -Add @code{key-binding} widget. - -@item -Find clean way to implement variable length list. -See @code{TeX-printer-list} for an explanation. +Add object and class hierarchies to the browser. @end itemize
--- a/src/ChangeLog Mon Aug 13 09:30:13 2007 +0200 +++ b/src/ChangeLog Mon Aug 13 09:31:12 2007 +0200 @@ -1,3 +1,32 @@ +Tue Apr 22 11:54:02 1997 Steven L Baur <steve@altair.xemacs.org> + + * emacs.c (main_1): Add syms_of_balloon_x and guard with + HAVE_X_WINDOWS. + (main_1): Add vars_of_balloon_x and guard with HAVE_X_WINDOWS. + + * process.c (get_process): This function can be passed a BUFFER as + a parameter. + +Tue Apr 22 01:32:00 1997 Kyle Jones <kyle@crystal.WonderWorks.COM> + + * src/menubar-x.c (pre_activate_hook): + set in_menu_callback around call to call to + menu_item_descriptor_to_widget_value. + + * src/event-stream.c (Fnext_event): + signal error if in_menu_callback non-nil to avoid + reentering the menubar code and causing a crash later. + + * src/cmdloop.c (command_loop_3): + signal error if in_menu_callback non-nil to avoid + inflooping calling Fnext_event, which will signal an + error if the situation is not caught earlier. + +Tue Apr 22 08:22:22 1997 Hrvoje Niksic <hniksic@srce.hr> + + * balloon-x.c, balloon_help.c, balloon_help.h: Modified to conform + to XEmacs coding standards. + Thu Apr 17 17:16:34 1997 Steven L Baur <steve@altair.xemacs.org> * balloon-x.c: New file from Douglas Keller.
--- a/src/Makefile.in.in Mon Aug 13 09:30:13 2007 +0200 +++ b/src/Makefile.in.in Mon Aug 13 09:31:12 2007 +0200 @@ -516,7 +516,7 @@ #endif #ifndef HAVE_XIM -#define INPUT_METHOD_X_OBJS +#define INPUT_METHOD_X_OBJS input-method-xfs.o #elif defined(XIM_MOTIF) #define INPUT_METHOD_X_OBJS input-method-motif.o #else @@ -527,8 +527,8 @@ glyphs-x.o GUI_X_OBJS MENUBAR_X_OBJS objects-x.o redisplay-x.o \ SCROLLBAR_X_OBJS TOOLBAR_X_OBJS INPUT_METHOD_X_OBJS xgccache.o \ xselect.o \ - balloon_help.o balloon-x.o - + balloon_help.o +#define BALLOONOBJS balloon-x.o #ifdef HAVE_XMU #define XMU_OBJS XMU_LIB = -lXmu @@ -605,7 +605,7 @@ #else # define XOBJS # define XMU_OBJS - +# define BALLOONOBJS #endif /* HAVE_X_WINDOWS */ /* We should be able to deal with Canna and Wnn in tty mode once MULE is */ @@ -761,7 +761,7 @@ #ifdef TOOLTALK # define TOOLTALK_OBJS tooltalk.o -# if (defined (IRIX5) || defined (HPUX) || defined (POWERPC) || defined (AIX4) || defined (LINUX)) +# if (defined (IRIX5) || defined (HPUX) || defined (POWERPC) || defined (AIX4) || defined (LINUX) || (defined (OSF1) && defined (DEC_ALPHA))) # define LIB_TOOLTALK -ltt # else # if (defined (SPARC) && !defined (USG)) @@ -782,7 +782,11 @@ #endif /* !TOOLTALK */ #ifdef HAVE_CDE -# define LIB_CDE -lDtSvc -ltt +# if (defined (OSF1) && defined (DEC_ALPHA)) +# define LIB_CDE -lDtSvc -ltt -lcxx +# else +# define LIB_CDE -lDtSvc -ltt +# endif /* (defined (OSF1) && defined (DEC_ALPHA)) */ #else # define LIB_CDE #endif @@ -890,7 +894,7 @@ strftime.o SUNPRO_OBJS symbols.o syntax.o sysdep.o \ TOOLBAR_OBJS TOOLTALK_OBJS TTY_OBJS \ undo.o UNEXEC \ - XOBJS XMU_OBJS \ + XOBJS XMU_OBJS BALLOONOBJS \ window.o #ifdef HAVE_TTY
--- a/src/balloon-x.c Mon Aug 13 09:30:13 2007 +0200 +++ b/src/balloon-x.c Mon Aug 13 09:31:12 2007 +0200 @@ -1,3 +1,26 @@ +/* + Copyright (c) 1997 Douglas Keller + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + + #include <config.h> #include "lisp.h" @@ -8,72 +31,77 @@ /* ### start of hack */ -static unsigned long alloc_color( Display* dpy, const char* colorname, int light ) +static unsigned long +alloc_color (Display* dpy, const char* colorname, int light) { - Colormap cmap = DefaultColormap( dpy, DefaultScreen(dpy) ); + Colormap cmap = DefaultColormap (dpy, DefaultScreen(dpy)); unsigned long pixel = 0; XColor color; - if( XParseColor(dpy, cmap, colorname, &color) && XAllocColor(dpy, cmap, &color) ) - { - pixel = color.pixel; - } + if (XParseColor(dpy, cmap, colorname, &color) && XAllocColor(dpy, cmap, &color)) + { + pixel = color.pixel; + } else - { - if( light ) { - printf("Warning: could not allocate color \"%s\", using \"white\"\n", colorname); - pixel = alloc_color( dpy, "white", True ); + if (light) + { + printf ("Warning: could not allocate color \"%s\", using \"white\"\n", + colorname); + pixel = alloc_color (dpy, "white", True); + } + else + { + printf ("Warning: could not allocate color \"%s\", using \"black\"\n", + colorname); + pixel = alloc_color (dpy, "black", True); + } } - else - { - printf("Warning: could not allocate color \"%s\", using \"black\"\n", colorname); - pixel = alloc_color( dpy, "black", True ); - } - } return pixel; } -static XFontStruct* open_font( Display* dpy, const char* font_name ) +static XFontStruct * +open_font (Display* dpy, const char* font_name) { XFontStruct* fontStruct = NULL; - fontStruct = XLoadQueryFont( dpy, font_name ? font_name : "fixed" ); - if( fontStruct == NULL ) - { - printf("Warning: could not load font \"%s\", using \"fixed\".\n", font_name); - fontStruct = XLoadQueryFont( dpy, "fixed" ); - assert( fontStruct != NULL ); - } + fontStruct = XLoadQueryFont (dpy, font_name ? font_name : "fixed"); + if (fontStruct == NULL) + { + printf ("Warning: could not load font \"%s\", using \"fixed\".\n", font_name); + fontStruct = XLoadQueryFont (dpy, "fixed"); + assert (fontStruct != NULL); + } return fontStruct; } -static void init( void ) +static void +init (void) { static int init; - if( !init ) - { - Pixel fg, bg, shine, shadow; - XFontStruct* font; - Display *dpy = DEVICE_X_DISPLAY (XDEVICE (Vdefault_x_device)); + if (!init) + { + Pixel fg, bg, shine, shadow; + XFontStruct* font; + Display *dpy = DEVICE_X_DISPLAY (XDEVICE (Vdefault_x_device)); + + fg = alloc_color (dpy, "grey60", 1); + bg = alloc_color (dpy, "black", 0); - fg = alloc_color( dpy, "grey60", 1 ); - bg = alloc_color( dpy, "black", 0 ); - - shine = alloc_color( dpy, "grey80", 1 ); - shadow = alloc_color( dpy, "grey40", 0 ); + shine = alloc_color (dpy, "grey80", 1); + shadow = alloc_color (dpy, "grey40", 0); - font = open_font( dpy, "-adobe-helvetica-medium-r-normal--12-*" ); + font = open_font (dpy, "-adobe-helvetica-medium-r-normal--12-*"); - balloon_help_create( dpy, bg, fg, shine, shadow, font ); - init = 1; - } + balloon_help_create (dpy, bg, fg, shine, shadow, font); + init = 1; + } } /* ### end of hack */ -DEFUN( "show-balloon-help", Fshow_balloon_help, 1, 1, 0, /* +DEFUN ("show-balloon-help", Fshow_balloon_help, 1, 1, 0, /* Show balloon help. */ (string)) @@ -83,33 +111,33 @@ p = (char *) XSTRING_DATA (string); - init(); + init (); - balloon_help_show( p ); + balloon_help_show (p); return Qnil; } -DEFUN( "hide-balloon-help", Fhide_balloon_help, 0, 0, 0, /* +DEFUN ("hide-balloon-help", Fhide_balloon_help, 0, 0, 0, /* Hide balloon help. */ ()) { - init(); + init (); - balloon_help_hide(); + balloon_help_hide (); return Qnil; } -DEFUN( "balloon-help-move-to-pointer", Fballoon_help_move_to_pointer, 0, 0, 0, /* +DEFUN ("balloon-help-move-to-pointer", Fballoon_help_move_to_pointer, 0, 0, 0, /* Hide balloon help. */ ()) { - init(); + init (); - balloon_help_move_to_pointer(); + balloon_help_move_to_pointer (); return Qnil; } @@ -123,9 +151,9 @@ void syms_of_balloon_x (void) { - DEFSUBR( Fshow_balloon_help ); - DEFSUBR( Fhide_balloon_help ); - DEFSUBR( Fballoon_help_move_to_pointer ); + DEFSUBR (Fshow_balloon_help); + DEFSUBR (Fhide_balloon_help); + DEFSUBR (Fballoon_help_move_to_pointer); } void
--- a/src/balloon_help.c Mon Aug 13 09:30:13 2007 +0200 +++ b/src/balloon_help.c Mon Aug 13 09:31:12 2007 +0200 @@ -1,3 +1,25 @@ +/* Balloon Help + Copyright (c) 1997 Douglas Keller + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + /* * Balloon Help * @@ -74,8 +96,9 @@ ============================================================================*/ -static GC create_gc( Display* dpy, Window win, unsigned long fg, unsigned long bg, - XFontStruct* fontStruct ) +static GC +create_gc (Display* dpy, Window win, unsigned long fg, unsigned long bg, + XFontStruct* fontStruct) { XGCValues gcv; unsigned long mask; @@ -88,22 +111,24 @@ mask = GCFont | GCBackground | GCForeground | GCJoinStyle | GCLineWidth; - return XCreateGC( dpy, win, mask, &gcv ); + return XCreateGC (dpy, win, mask, &gcv); } -static void destroy_gc( Display* dpy, GC gc ) +static void +destroy_gc (Display* dpy, GC gc) { - if( gc ) - { - XFreeGC( dpy, gc ); - } + if (gc) + { + XFreeGC (dpy, gc); + } } /*============================================================================ ============================================================================*/ -static Window create_window( Display* dpy, unsigned long bg ) +static Window +create_window (Display* dpy, unsigned long bg) { Window win; XSetWindowAttributes attr; @@ -115,87 +140,94 @@ attr.save_under = True; win = - XCreateWindow( dpy, - DefaultRootWindow( dpy ), + XCreateWindow (dpy, + DefaultRootWindow (dpy), 0, 0, 1, 1, 0, CopyFromParent, InputOutput, CopyFromParent, - attr_mask, &attr ); + attr_mask, &attr); - XSelectInput( dpy, win, + XSelectInput (dpy, win, SubstructureRedirectMask | SubstructureNotifyMask | ExposureMask | EnterWindowMask | - LeaveWindowMask ); + LeaveWindowMask); return win; } -static void destroy_window( Display* dpy, Window win ) +static void +destroy_window (Display* dpy, Window win) { - if( win ) - { - XDestroyWindow( dpy, win ); - } + if (win) + { + XDestroyWindow (dpy, win); + } +} + +/*============================================================================ + +============================================================================*/ + +static void +get_pointer_xy (Display* dpy, int* x_return, int* y_return) +{ + int dummy; + unsigned int mask; + Window dummy_win; + + XQueryPointer (dpy, RootWindow(dpy, DefaultScreen(dpy)), &dummy_win, &dummy_win, + x_return, y_return, &dummy, &dummy, &mask); } /*============================================================================ ============================================================================*/ -static void get_pointer_xy( Display* dpy, int* x_return, int* y_return ) +static void +create_pixmap_mask (int width, int height) +{ + b_maskWidth = width; + b_maskHeight = height; + b_mask = XCreatePixmap (b_dpy, b_win, width, height, 1); +} + +static void +destroy_pixmap_mask(void) { - int dummy; - unsigned int mask; - Window dummy_win; + XFreePixmap (b_dpy, b_mask); +} - XQueryPointer( dpy, RootWindow(dpy, DefaultScreen(dpy)), &dummy_win, &dummy_win, - x_return, y_return, &dummy, &dummy, &mask ); +static void +grow_pixmap_mask (int width, int height) +{ + if (width > b_maskWidth || height > b_maskHeight) + { + destroy_pixmap_mask (); + create_pixmap_mask (width, height); + } } /*============================================================================ ============================================================================*/ -static void create_pixmap_mask( int width, int height ) -{ - b_maskWidth = width; - b_maskHeight = height; - b_mask = XCreatePixmap( b_dpy, b_win, width, height, 1 ); -} - -static void destroy_pixmap_mask( void ) -{ - XFreePixmap( b_dpy, b_mask ); -} - -static void grow_pixmap_mask( int width, int height ) -{ - if( width > b_maskWidth || height > b_maskHeight ) - { - destroy_pixmap_mask(); - create_pixmap_mask( width, height ); - } -} - -/*============================================================================ - -============================================================================*/ - -static void text_extent( XFontStruct* fontStruct, const char* text, int len, - int* width, int* height ) +static void +text_extent (XFontStruct* fontStruct, const char* text, int len, + int* width, int* height) { XCharStruct extent; int dummy; - XTextExtents( fontStruct, text, len, &dummy, &dummy, &dummy, &extent ); + XTextExtents (fontStruct, text, len, &dummy, &dummy, &dummy, &extent); *width = extent.width; *height = fontStruct->ascent + fontStruct->descent; } -static void get_text_size( Display* dpy, XFontStruct* fontStruct, const char* text, - int* max_width, int* max_height ) +static void +get_text_size (Display* dpy, XFontStruct* fontStruct, const char* text, + int* max_width, int* max_height) { int width; int height; @@ -205,25 +237,26 @@ *max_width = *max_height = 0; start = text; - while( (end = strchr(start, '\n')) ) - { - text_extent( fontStruct, start, end - start, &width, &height ); - *max_width = max( width, *max_width ); - *max_height += height; + while ((end = strchr(start, '\n'))) + { + text_extent (fontStruct, start, end - start, &width, &height); + *max_width = max (width, *max_width); + *max_height += height; - start = end + 1; - } - text_extent( fontStruct, start, strlen(start), &width, &height ); - *max_width = max( width, *max_width ); + start = end + 1; + } + text_extent (fontStruct, start, strlen (start), &width, &height); + *max_width = max (width, *max_width); *max_height += height; /* Min width */ - *max_width = max( *max_width, CONE_WIDTH / 2 * 3 ); + *max_width = max (*max_width, CONE_WIDTH / 2 * 3); } -static void draw_text( Display* dpy, Window win, GC gc, XFontStruct* fontStruct, - int x, int y, const char* text ) +static void +draw_text (Display* dpy, Window win, GC gc, XFontStruct* fontStruct, + int x, int y, const char* text) { const char* start; const char* end; @@ -234,100 +267,102 @@ font_height = fontStruct->ascent + fontStruct->descent; start = text; - while( (end = strchr(start, '\n')) ) - { - XDrawString( dpy, win, gc, x, y, start, end - start ); + while ((end = strchr(start, '\n'))) + { + XDrawString (dpy, win, gc, x, y, start, end - start); - start = end + 1; - y += font_height; - } - XDrawString( dpy, win, gc, x, y, start, strlen(start) ); + start = end + 1; + y += font_height; + } + XDrawString (dpy, win, gc, x, y, start, strlen (start)); } /*============================================================================ ============================================================================*/ -static int get_shape( int last_shape, int x, int y, int width, int height, - int screen_width, int screen_height ) +static int +get_shape (int last_shape, int x, int y, int width, int height, + int screen_width, int screen_height) { /* Can we use last_shape */ - if( SHAPE_CONE_TOP_LEFT == last_shape ) - { - if( (x + width < screen_width) && (y + height < screen_height) ) + if (SHAPE_CONE_TOP_LEFT == last_shape) { - return last_shape; + if ((x + width < screen_width) && (y + height < screen_height)) + { + return last_shape; + } } - } - else if( SHAPE_CONE_TOP_RIGHT == last_shape ) - { - if( (x - width > 0) && (y + height < screen_height) ) + else if (SHAPE_CONE_TOP_RIGHT == last_shape) { - return last_shape; + if ((x - width > 0) && (y + height < screen_height)) + { + return last_shape; + } } - } - else if( SHAPE_CONE_BOTTOM_LEFT == last_shape ) - { - if( (x + width < screen_width) && (y - height > 0) ) + else if (SHAPE_CONE_BOTTOM_LEFT == last_shape) { - return last_shape; + if ((x + width < screen_width) && (y - height > 0)) + { + return last_shape; + } } - } - else if( SHAPE_CONE_BOTTOM_RIGHT == last_shape ) - { - if( (x - width > 0) && (y - height > 0) ) + else if (SHAPE_CONE_BOTTOM_RIGHT == last_shape) { - return last_shape; + if ((x - width > 0) && (y - height > 0)) + { + return last_shape; + } } - } /* Try to pick a shape that will not get changed, ie if top left quadrant, top_left */ - if( x < screen_width / 2 ) - { - if( y < screen_height / 2 ) + if (x < screen_width / 2) { - return SHAPE_CONE_TOP_LEFT; - } - else - { - return SHAPE_CONE_BOTTOM_LEFT; + if (y < screen_height / 2) + { + return SHAPE_CONE_TOP_LEFT; + } + else + { + return SHAPE_CONE_BOTTOM_LEFT; + } } - } else - { - if( y < screen_height / 2 ) { - return SHAPE_CONE_TOP_RIGHT; + if (y < screen_height / 2) + { + return SHAPE_CONE_TOP_RIGHT; + } + else + { + return SHAPE_CONE_BOTTOM_RIGHT; + } } - else - { - return SHAPE_CONE_BOTTOM_RIGHT; - } - } /* ### if width or height is greater than 1/2 the width or height then we might run off the screen */ - abort(); + abort (); return 0; } -static void make_mask( int shape, int x, int y, int width, int height ) +static void +make_mask (int shape, int x, int y, int width, int height) { XPoint cone[ 3 ]; - grow_pixmap_mask( width, height ); + grow_pixmap_mask (width, height); /* Clear mask */ - XSetForeground( b_dpy, b_maskGC, 0 ); - XFillRectangle( b_dpy, b_mask, b_maskGC, - 0, 0, width, height ); + XSetForeground (b_dpy, b_maskGC, 0); + XFillRectangle (b_dpy, b_mask, b_maskGC, + 0, 0, width, height); /* Enable text area */ - XSetForeground( b_dpy, b_maskGC, 1 ); - XFillRectangle( b_dpy, b_mask, b_maskGC, - 0, shape & SHAPE_CONE_TOP ? CONE_HEIGHT : 0, width, height - CONE_HEIGHT ); + XSetForeground (b_dpy, b_maskGC, 1); + XFillRectangle (b_dpy, b_mask, b_maskGC, 0, + shape & SHAPE_CONE_TOP ? CONE_HEIGHT : 0, width, height - CONE_HEIGHT); /* Enable for cone area */ cone[0].x = (shape & SHAPE_CONE_LEFT) ? CONE_WIDTH / 2 : width - (CONE_WIDTH / 2); @@ -337,154 +372,156 @@ cone[2].x = (shape & SHAPE_CONE_LEFT) ? CONE_WIDTH : width - CONE_WIDTH; cone[2].y = (shape & SHAPE_CONE_TOP) ? CONE_HEIGHT : height - CONE_HEIGHT; - XFillPolygon( b_dpy, b_mask, b_maskGC, cone, 3, Nonconvex, CoordModeOrigin ); + XFillPolygon (b_dpy, b_mask, b_maskGC, cone, 3, Nonconvex, CoordModeOrigin); } -static void show_help( XtPointer data, XtIntervalId* id ) +static void +show_help (XtPointer data, XtIntervalId* id) { int x, y; int shape; XPoint border[ 3 ]; - if( id == NULL || (id && b_timer) && b_text ) - { - b_timer = None; + if (id == NULL || (id && b_timer) && b_text) + { + b_timer = None; - /* size */ - get_text_size( b_dpy, b_fontStruct, b_text, &b_width, &b_height ); - b_width += 2 * MARGIN_WIDTH + 2 * BORDER_WIDTH; - b_height += 2 * MARGIN_WIDTH + 2 * BORDER_WIDTH + CONE_HEIGHT; + /* size */ + get_text_size (b_dpy, b_fontStruct, b_text, &b_width, &b_height); + b_width += 2 * MARGIN_WIDTH + 2 * BORDER_WIDTH; + b_height += 2 * MARGIN_WIDTH + 2 * BORDER_WIDTH + CONE_HEIGHT; - /* origin */ - get_pointer_xy( b_dpy, &x, &y ); + /* origin */ + get_pointer_xy (b_dpy, &x, &y); - /* guess at shape */ - shape = get_shape( b_lastShape, x, y, b_width, b_height, b_screenWidth, b_screenHeight ); + /* guess at shape */ + shape = get_shape(b_lastShape, x, y, b_width, b_height, + b_screenWidth, b_screenHeight); - x += (shape & SHAPE_CONE_LEFT) ? POINTER_OFFSET : -POINTER_OFFSET; - y += (shape & SHAPE_CONE_TOP) ? POINTER_OFFSET : -POINTER_OFFSET; + x += (shape & SHAPE_CONE_LEFT) ? POINTER_OFFSET : -POINTER_OFFSET; + y += (shape & SHAPE_CONE_TOP) ? POINTER_OFFSET : -POINTER_OFFSET; - /* make sure it is still ok with offset */ - shape = get_shape( shape, x, y, b_width, b_height, b_screenWidth, b_screenHeight ); + /* make sure it is still ok with offset */ + shape = get_shape (shape, x, y, b_width, b_height, b_screenWidth, b_screenHeight); - b_lastX = x; - b_lastY = y; - b_lastShape = shape; + b_lastX = x; + b_lastY = y; + b_lastShape = shape; - make_mask( shape, x, y, b_width, b_height ); + make_mask (shape, x, y, b_width, b_height); - XShapeCombineMask( b_dpy, b_win, ShapeBounding, 0, 0, b_mask, ShapeSet ); + XShapeCombineMask (b_dpy, b_win, ShapeBounding, 0, 0, b_mask, ShapeSet); - XMoveResizeWindow( b_dpy, b_win, - (shape & SHAPE_CONE_LEFT) ? x : x - b_width, - (shape & SHAPE_CONE_TOP) ? y : y - b_height, - b_width, b_height ); + XMoveResizeWindow(b_dpy, b_win, + (shape & SHAPE_CONE_LEFT) ? x : x - b_width, + (shape & SHAPE_CONE_TOP) ? y : y - b_height, + b_width, b_height); - XClearWindow( b_dpy, b_win ); + XClearWindow (b_dpy, b_win); - XMapRaised( b_dpy, b_win ); - b_winMapped = True; + XMapRaised (b_dpy, b_win); + b_winMapped = True; - draw_text( b_dpy, b_win, b_gc, b_fontStruct, - BORDER_WIDTH + MARGIN_WIDTH, - BORDER_WIDTH + MARGIN_WIDTH + ((shape & SHAPE_CONE_TOP) ? CONE_HEIGHT : 0), - b_text ); + draw_text (b_dpy, b_win, b_gc, b_fontStruct, + BORDER_WIDTH + MARGIN_WIDTH, + BORDER_WIDTH + MARGIN_WIDTH + ((shape & SHAPE_CONE_TOP) ? CONE_HEIGHT : 0), + b_text); - /* 3d border */ - /* shine- top left */ - border[0].x = 0 + BORDER_WIDTH_HALF; - border[0].y = ((shape & SHAPE_CONE_TOP) ? b_height : b_height - CONE_HEIGHT) - BORDER_WIDTH_HALF; - border[1].x = 0 + BORDER_WIDTH_HALF; - border[1].y = ((shape & SHAPE_CONE_TOP) ? CONE_HEIGHT : 0) + BORDER_WIDTH_HALF; - border[2].x = b_width - BORDER_WIDTH_HALF; - border[2].y = border[1].y; - XDrawLines( b_dpy, b_win, b_shineGC, border, 3, CoordModeOrigin ); + /* 3d border */ + /* shine- top left */ + border[0].x = 0 + BORDER_WIDTH_HALF; + border[0].y = ((shape & SHAPE_CONE_TOP) ? b_height : b_height - CONE_HEIGHT) - BORDER_WIDTH_HALF; + border[1].x = 0 + BORDER_WIDTH_HALF; + border[1].y = ((shape & SHAPE_CONE_TOP) ? CONE_HEIGHT : 0) + BORDER_WIDTH_HALF; + border[2].x = b_width - BORDER_WIDTH_HALF; + border[2].y = border[1].y; + XDrawLines (b_dpy, b_win, b_shineGC, border, 3, CoordModeOrigin); - /* shadow- bottom right */ - border[0].x = 0 + BORDER_WIDTH_HALF; - border[0].y = ((shape & SHAPE_CONE_TOP) ? b_height : b_height - CONE_HEIGHT) - BORDER_WIDTH_HALF; - border[1].x = b_width - BORDER_WIDTH_HALF; - border[1].y = border[0].y; - border[2].x = b_width - BORDER_WIDTH_HALF; - border[2].y = ((shape & SHAPE_CONE_TOP) ? CONE_HEIGHT : 0) + BORDER_WIDTH_HALF; - XDrawLines( b_dpy, b_win, b_shadowGC, border, 3, CoordModeOrigin ); + /* shadow- bottom right */ + border[0].x = 0 + BORDER_WIDTH_HALF; + border[0].y = ((shape & SHAPE_CONE_TOP) ? b_height : b_height - CONE_HEIGHT) - BORDER_WIDTH_HALF; + border[1].x = b_width - BORDER_WIDTH_HALF; + border[1].y = border[0].y; + border[2].x = b_width - BORDER_WIDTH_HALF; + border[2].y = ((shape & SHAPE_CONE_TOP) ? CONE_HEIGHT : 0) + BORDER_WIDTH_HALF; + XDrawLines (b_dpy, b_win, b_shadowGC, border, 3, CoordModeOrigin); - /* cone */ - if( SHAPE_CONE_TOP_LEFT == shape ) - { - XClearArea( b_dpy, b_win, - CONE_WIDTH / 2 + BORDER_WIDTH, - CONE_HEIGHT, - CONE_WIDTH / 2 - BORDER_WIDTH, - BORDER_WIDTH, False ); - XDrawLine( b_dpy, b_win, b_shadowGC, - 0, - 0, - CONE_WIDTH / 2 + BORDER_WIDTH_HALF, - CONE_HEIGHT ); - XDrawLine( b_dpy, b_win, b_shineGC, - 0, - 0, - CONE_WIDTH - BORDER_WIDTH_HALF, - CONE_HEIGHT ); - } - else if( SHAPE_CONE_TOP_RIGHT == shape ) - { - XClearArea( b_dpy, b_win, - b_width - CONE_WIDTH + BORDER_WIDTH, - CONE_HEIGHT, - CONE_WIDTH / 2 - BORDER_WIDTH, - BORDER_WIDTH, False ); - XDrawLine( b_dpy, b_win, b_shadowGC, - b_width, - 0, - b_width - CONE_WIDTH / 2 - BORDER_WIDTH_HALF, - CONE_HEIGHT ); - XDrawLine( b_dpy, b_win, b_shineGC, - b_width, - 0, - b_width - CONE_WIDTH + BORDER_WIDTH_HALF, - CONE_HEIGHT ); + /* cone */ + if (SHAPE_CONE_TOP_LEFT == shape) + { + XClearArea (b_dpy, b_win, + CONE_WIDTH / 2 + BORDER_WIDTH, + CONE_HEIGHT, + CONE_WIDTH / 2 - BORDER_WIDTH, + BORDER_WIDTH, False); + XDrawLine (b_dpy, b_win, b_shadowGC, + 0, + 0, + CONE_WIDTH / 2 + BORDER_WIDTH_HALF, + CONE_HEIGHT); + XDrawLine (b_dpy, b_win, b_shineGC, + 0, + 0, + CONE_WIDTH - BORDER_WIDTH_HALF, + CONE_HEIGHT); + } + else if (SHAPE_CONE_TOP_RIGHT == shape) + { + XClearArea (b_dpy, b_win, + b_width - CONE_WIDTH + BORDER_WIDTH, + CONE_HEIGHT, + CONE_WIDTH / 2 - BORDER_WIDTH, + BORDER_WIDTH, False); + XDrawLine (b_dpy, b_win, b_shadowGC, + b_width, + 0, + b_width - CONE_WIDTH / 2 - BORDER_WIDTH_HALF, + CONE_HEIGHT); + XDrawLine (b_dpy, b_win, b_shineGC, + b_width, + 0, + b_width - CONE_WIDTH + BORDER_WIDTH_HALF, + CONE_HEIGHT); + } + else if (SHAPE_CONE_BOTTOM_LEFT == shape) + { + XClearArea (b_dpy, b_win, + CONE_WIDTH / 2 + BORDER_WIDTH, + b_height - CONE_HEIGHT - BORDER_WIDTH, + CONE_WIDTH / 2 - BORDER_WIDTH, + BORDER_WIDTH, False); + XDrawLine (b_dpy, b_win, b_shadowGC, + 0, + b_height - 1, + CONE_WIDTH, + b_height - 1 - CONE_HEIGHT); + XDrawLine (b_dpy, b_win, b_shineGC, + 0, + b_height - 1, + CONE_WIDTH / 2 + BORDER_WIDTH, + b_height - 1 - CONE_HEIGHT); + } + else if (SHAPE_CONE_BOTTOM_RIGHT == shape) + { + XClearArea (b_dpy, b_win, + b_width - 1 - CONE_WIDTH + BORDER_WIDTH, + b_height - CONE_HEIGHT - BORDER_WIDTH, + CONE_WIDTH / 2 - BORDER_WIDTH - 1, + BORDER_WIDTH, False); + XDrawLine (b_dpy, b_win, b_shadowGC, + b_width - 1, + b_height - 1, + b_width - 1 - CONE_WIDTH, + b_height - 1 - CONE_HEIGHT); + XDrawLine (b_dpy, b_win, b_shineGC, + b_width - 1, + b_height - 1, + b_width - 1 - CONE_WIDTH / 2 - BORDER_WIDTH, + b_height - 1 - CONE_HEIGHT); + } } - else if( SHAPE_CONE_BOTTOM_LEFT == shape ) - { - XClearArea( b_dpy, b_win, - CONE_WIDTH / 2 + BORDER_WIDTH, - b_height - CONE_HEIGHT - BORDER_WIDTH, - CONE_WIDTH / 2 - BORDER_WIDTH, - BORDER_WIDTH, False ); - XDrawLine( b_dpy, b_win, b_shadowGC, - 0, - b_height - 1, - CONE_WIDTH, - b_height - 1 - CONE_HEIGHT ); - XDrawLine( b_dpy, b_win, b_shineGC, - 0, - b_height - 1, - CONE_WIDTH / 2 + BORDER_WIDTH, - b_height - 1 - CONE_HEIGHT ); - } - else if( SHAPE_CONE_BOTTOM_RIGHT == shape ) - { - XClearArea( b_dpy, b_win, - b_width - 1 - CONE_WIDTH + BORDER_WIDTH, - b_height - CONE_HEIGHT - BORDER_WIDTH, - CONE_WIDTH / 2 - BORDER_WIDTH - 1, - BORDER_WIDTH, False ); - XDrawLine( b_dpy, b_win, b_shadowGC, - b_width - 1, - b_height - 1, - b_width - 1 - CONE_WIDTH, - b_height - 1 - CONE_HEIGHT ); - XDrawLine( b_dpy, b_win, b_shineGC, - b_width - 1, - b_height - 1, - b_width - 1 - CONE_WIDTH / 2 - BORDER_WIDTH, - b_height - 1 - CONE_HEIGHT); - } - } } @@ -492,122 +529,128 @@ ============================================================================*/ -void balloon_help_create( Display* dpy, - Pixel fg, Pixel bg, Pixel shine, Pixel shadow, - XFontStruct* font ) +void +balloon_help_create (Display* dpy, + Pixel fg, Pixel bg, Pixel shine, Pixel shadow, + XFontStruct* font) { - if( b_dpy ) balloon_help_destroy(); + if (b_dpy) balloon_help_destroy (); b_dpy = dpy; b_fontStruct = font; - b_win = create_window( dpy, bg ); - b_gc = create_gc( dpy, b_win, fg, bg, b_fontStruct ); + b_win = create_window (dpy, bg); + b_gc = create_gc (dpy, b_win, fg, bg, b_fontStruct); - b_shineGC = create_gc( dpy, b_win, shine, bg, b_fontStruct ); - b_shadowGC = create_gc( dpy, b_win, shadow, bg, b_fontStruct ); + b_shineGC = create_gc (dpy, b_win, shine, bg, b_fontStruct); + b_shadowGC = create_gc (dpy, b_win, shadow, bg, b_fontStruct); - create_pixmap_mask( 1, 1 ); - b_maskGC = create_gc( dpy, b_mask, bg, fg, b_fontStruct ); + create_pixmap_mask (1, 1); + b_maskGC = create_gc (dpy, b_mask, bg, fg, b_fontStruct); b_winMapped = False; b_timer = None; b_delay = 500; - b_screenWidth = DisplayWidth( b_dpy, DefaultScreen(b_dpy) ); - b_screenHeight = DisplayHeight( b_dpy, DefaultScreen(b_dpy) ); + b_screenWidth = DisplayWidth (b_dpy, DefaultScreen(b_dpy)); + b_screenHeight = DisplayHeight (b_dpy, DefaultScreen(b_dpy)); b_lastShape = SHAPE_CONE_FREE; } -void balloon_help_destroy( void ) +void +balloon_help_destroy (void) { - assert( b_dpy != NULL ); + assert (b_dpy != NULL); b_dpy = NULL; - destroy_window( b_dpy, b_win ); - destroy_gc( b_dpy, b_gc ); + destroy_window (b_dpy, b_win); + destroy_gc (b_dpy, b_gc); - destroy_gc( b_dpy, b_shineGC ); - destroy_gc( b_dpy, b_shadowGC ); + destroy_gc (b_dpy, b_shineGC); + destroy_gc (b_dpy, b_shadowGC); - destroy_pixmap_mask(); - destroy_gc( b_dpy, b_maskGC ); + destroy_pixmap_mask (); + destroy_gc (b_dpy, b_maskGC); - if( b_timer ) XtRemoveTimeOut( b_timer ); + if (b_timer) XtRemoveTimeOut (b_timer); } -void balloon_help_set_delay( unsigned long milliseconds ) +void +balloon_help_set_delay (unsigned long milliseconds) { b_delay = milliseconds; } -void balloon_help_show( const char* text ) +void +balloon_help_show (const char* text) { - assert( b_dpy != NULL ); + assert (b_dpy != NULL); /* We don't copy the text */ b_text = text; b_lastShape = SHAPE_CONE_FREE; - if( b_winMapped ) - { - /* If help is already being shown, don't delay just update */ - show_help( NULL, NULL ); - } + if (b_winMapped) + { + /* If help is already being shown, don't delay just update */ + show_help (NULL, NULL); + } else - { - b_timer = - XtAppAddTimeOut( XtDisplayToApplicationContext(b_dpy), - b_delay, show_help, NULL ); - } + { + b_timer = + XtAppAddTimeOut (XtDisplayToApplicationContext(b_dpy), + b_delay, show_help, NULL); + } } -void balloon_help_hide( void ) +void +balloon_help_hide (void) { - assert( b_dpy != NULL ); + assert (b_dpy != NULL); b_text = NULL; - XUnmapWindow( b_dpy, b_win ); + XUnmapWindow (b_dpy, b_win); b_winMapped = False; - if( b_timer ) - { - XtRemoveTimeOut( b_timer ); - b_timer = None; - } + if (b_timer) + { + XtRemoveTimeOut (b_timer); + b_timer = None; + } } -void balloon_help_move_to_pointer( void ) +void +balloon_help_move_to_pointer (void) { - assert( b_dpy != NULL ); + assert (b_dpy != NULL); - if( b_winMapped ) - { - int x, y; - int shape = b_lastShape; + if (b_winMapped) + { + int x, y; + int shape = b_lastShape; - get_pointer_xy( b_dpy, &x, &y ); + get_pointer_xy (b_dpy, &x, &y); - x += (shape & SHAPE_CONE_LEFT) ? POINTER_OFFSET : -POINTER_OFFSET; - y += (shape & SHAPE_CONE_TOP) ? POINTER_OFFSET : -POINTER_OFFSET; + x += (shape & SHAPE_CONE_LEFT) ? POINTER_OFFSET : -POINTER_OFFSET; + y += (shape & SHAPE_CONE_TOP) ? POINTER_OFFSET : -POINTER_OFFSET; - shape = get_shape( shape, x, y, b_width, b_height, b_screenWidth, b_screenHeight ); + shape = get_shape (shape, x, y, b_width, b_height, b_screenWidth, b_screenHeight); - if( shape == b_lastShape ) - { - b_lastX = x; - b_lastY = y; + if (shape == b_lastShape) + { + b_lastX = x; + b_lastY = y; - XMoveWindow( b_dpy, b_win, - shape & SHAPE_CONE_LEFT ? x : x - b_width, - shape & SHAPE_CONE_TOP ? y : y - b_height ); + XMoveWindow (b_dpy, b_win, + shape & SHAPE_CONE_LEFT ? x : x - b_width, + shape & SHAPE_CONE_TOP ? y : y - b_height); + } + else + { + /* text would be off screen, rebuild with new shape */ + b_lastShape = SHAPE_CONE_FREE; + show_help (NULL, NULL); + } } - else - { - /* text would be off screen, rebuild with new shape */ - b_lastShape = SHAPE_CONE_FREE; - show_help( NULL, NULL ); - } - } }
--- a/src/balloon_help.h Mon Aug 13 09:30:13 2007 +0200 +++ b/src/balloon_help.h Mon Aug 13 09:31:12 2007 +0200 @@ -1,15 +1,37 @@ +/* Balloon Help + Copyright (c) 1997 Douglas Keller + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + #ifndef BALLOON_HELP_H #define BALLOON_HELP_H #include <X11/Intrinsic.h> -void balloon_help_create( Display* dpy, +void balloon_help_create (Display* dpy, Pixel fg, Pixel bg, Pixel shine, Pixel shadow, - XFontStruct* font ); -void balloon_help_destroy( void ); -void balloon_help_set_delay( unsigned long milliseconds ); -void balloon_help_show( const char* text ); -void balloon_help_hide( void ); -void balloon_help_move_to_pointer( void ); + XFontStruct* font); +void balloon_help_destroy (void); +void balloon_help_set_delay (unsigned long milliseconds); +void balloon_help_show (const char* text); +void balloon_help_hide (void); +void balloon_help_move_to_pointer (void); #endif /* BALLOON_HELP_H */
--- a/src/emacs.c Mon Aug 13 09:30:13 2007 +0200 +++ b/src/emacs.c Mon Aug 13 09:31:12 2007 +0200 @@ -758,6 +758,9 @@ syms_of_abbrev (); syms_of_alloc (); +#ifdef HAVE_X_WINDOWS + syms_of_balloon_x (); +#endif syms_of_buffer (); syms_of_bytecode (); syms_of_callint (); @@ -1065,6 +1068,9 @@ vars_of_abbrev (); vars_of_alloc (); +#ifdef HAVE_X_WINDOWS + vars_of_balloon_x (); +#endif vars_of_buffer (); vars_of_bytecode (); vars_of_callint ();
--- a/src/event-Xt.c Mon Aug 13 09:30:13 2007 +0200 +++ b/src/event-Xt.c Mon Aug 13 09:31:12 2007 +0200 @@ -2634,9 +2634,9 @@ event_stream = Xt_event_stream; -#ifdef HAVE_XIM +#if defined(HAVE_XIM) || defined(USE_XFONTSET) Initialize_Locale(); -#endif /* HAVE_XIM */ +#endif /* HAVE_XIM || USE_XFONTSET */ XtToolkitInitialize (); Xt_app_con = XtCreateApplicationContext ();
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/input-method-xfs.c Mon Aug 13 09:31:12 2007 +0200 @@ -0,0 +1,95 @@ +/* input-method-xfs.c provides just only locale initialize + for non Motif people. (stoled from input-method-xlib.c) + Why I made this code is to initialize X locale environment for + the purpose of use XFontSet correctly in lwlib/xlwmenu.c. + And this code donot provides input methods under Xlib while they + prefer to use Canna, Wnn, skk or something like that. + This code has been tested on FreeBSD 2.2.1 and Solaris2.5. + + Copyright (C) 1997 Kazuyuki IENAGA. + +This file is a part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include <X11/Xlocale.h> /* More portable than <locale.h> ? */ +#include <config.h> +#include "lisp.h" +#include "frame.h" +#include "device.h" +#include "window.h" +#include "buffer.h" +#include "console-x.h" +#include "EmacsFrame.h" +#include "events.h" + +#ifdef __FreeBSD__ +#include <osreldate.h> +#endif + +#ifdef USE_XFONTSET +void +Initialize_Locale (void) +{ + char *locale; + + XtSetLanguageProc (NULL, (XtLanguageProc) NULL, NULL); +#ifdef __FreeBSD_version +# if __FreeBSD_version >= 199701 /* waiting FreeBSD supports all locale */ + if ((locale = setlocale(LC_CTYPE, "")) == NULL) +# else + if ((locale = setlocale (LC_ALL, "")) == NULL) +# endif +#else + if ((locale = setlocale (LC_ALL, "")) == NULL) +#endif + { + stderr_out ("Can't set locale.\n"); + stderr_out ("Using C locale instead.\n"); + putenv ("LANG=C"); + putenv ("LC_ALL=C"); + if ((locale = setlocale (LC_ALL, "C")) == NULL) + { + stderr_out ("Can't even set locale to `C'!\n"); + return; + } + } + + if (!XSupportsLocale ()) + { + stderr_out ("X Windows does not support locale `%s'\n", locale); + stderr_out ("Using C Locale instead\n"); + putenv ("LANG=C"); + putenv ("LC_ALL=C"); + if ((locale = setlocale (LC_ALL, "C")) == NULL) + { + stderr_out ("Can't even set locale to `C'!\n"); + return; + } + if (!XSupportsLocale ()) + { + stderr_out ("X Windows does not even support locale `C'!\n"); + return; + } + } + + if (XSetLocaleModifiers ("") == NULL) + { + stderr_out ("XSetLocaleModifiers(\"\") failed\n"); + stderr_out ("Check the value of the XMODIFIERS environment variable.\n"); + } +} +#endif /* USE_XFONTSET */
--- a/src/lisp.h Mon Aug 13 09:30:13 2007 +0200 +++ b/src/lisp.h Mon Aug 13 09:31:12 2007 +0200 @@ -609,7 +609,7 @@ /* There's not any particular reason not to use lrecords for these; some objects get slightly larger, but we get 3 bit tags instead of 4. */ -#define LRECORD_SYMBOL +/* #define LRECORD_SYMBOL */ /* Define the fundamental Lisp data structures */
--- a/src/process.c Mon Aug 13 09:30:13 2007 +0200 +++ b/src/process.c Mon Aug 13 09:31:12 2007 +0200 @@ -444,7 +444,7 @@ static Lisp_Object get_process (Lisp_Object name) { - Lisp_Object proc; + Lisp_Object proc, obj; #ifdef I18N3 /* #### Look more closely into translating process names. */ @@ -455,24 +455,33 @@ if (GC_PROCESSP (name)) return name; - if (GC_NILP (name)) - proc = Fget_buffer_process (Fcurrent_buffer ()); + if (GC_STRINGP (name)) + { + obj = Fget_process (name); + if (GC_NILP (obj)) + obj = Fget_buffer (name); + if (GC_NILP (obj)) + error ("Process %s does not exist", XSTRING_DATA (name)); + } + else if (GC_NILP (name)) + obj = Fcurrent_buffer (); + else + obj = name; + + /* Now obj should be either a buffer object or a process object. + */ + if (GC_BUFFERP (obj)) + { + proc = Fget_buffer_process (obj); + if (GC_NILP (proc)) + error ("Buffer %s has no process", XSTRING_DATA (XBUFFER(obj)->name)); + } else { - proc = Fget_process (name); - if (GC_NILP (proc)) - proc = Fget_buffer_process (Fget_buffer (name)); + /* fsf: CHECK_PROCESS (obj, 0); */ + proc = obj; } - - if (!GC_NILP (proc)) - return proc; - - if (GC_NILP (name)) - error ("Current buffer has no process"); - else - error ("Process %s does not exist", XSTRING_DATA (name)); - /* NOTREACHED */ - return Qnil; /* warning suppression */ + return proc; } DEFUN ("process-id", Fprocess_id, 1, 1, 0, /*
--- a/src/s/decosf4-0.h Mon Aug 13 09:30:13 2007 +0200 +++ b/src/s/decosf4-0.h Mon Aug 13 09:31:12 2007 +0200 @@ -30,3 +30,5 @@ /* Digital Unix 4.0 has a realpath, but it's buggy. And I *do* mean buggy. */ #undef HAVE_REALPATH + +#define LIBS_DEBUG
--- a/src/symsinit.h Mon Aug 13 09:30:13 2007 +0200 +++ b/src/symsinit.h Mon Aug 13 09:31:12 2007 +0200 @@ -44,6 +44,7 @@ void syms_of_abbrev (void); void syms_of_alloc (void); +void syms_of_balloon_x (void); void syms_of_buffer (void); void syms_of_bytecode (void); void syms_of_callint (void); @@ -180,6 +181,7 @@ void vars_of_abbrev (void); void vars_of_alloc (void); +void vars_of_balloon_x (void); void vars_of_buffer (void); void vars_of_bytecode (void); void vars_of_callint (void);
--- a/src/tooltalk.c Mon Aug 13 09:30:13 2007 +0200 +++ b/src/tooltalk.c Mon Aug 13 09:31:12 2007 +0200 @@ -177,7 +177,7 @@ error ("printing unreadable object #<tooltalk_message 0x%x>", p->header.uid); - sprintf (buf, "#<tooltalk_message id:%d 0x%x>", (int) p->m, p->header.uid); + sprintf (buf, "#<tooltalk_message id:%d 0x%x>", p->m, p->header.uid); write_c_string (buf, printcharfun); } @@ -253,7 +253,7 @@ error ("printing unreadable object #<tooltalk_pattern 0x%x>", p->header.uid); - sprintf (buf, "#<tooltalk_pattern id:%d 0x%x>", (int) p->p, p->header.uid); + sprintf (buf, "#<tooltalk_pattern id:%d 0x%x>", p->p, p->header.uid); write_c_string (buf, printcharfun); }