Mercurial > hg > xemacs-beta
changeset 138:6608ceec7cf8 r20-2b3
Import from CVS: tag r20-2b3
line wrap: on
line diff
--- a/CHANGES-beta Mon Aug 13 09:31:13 2007 +0200 +++ b/CHANGES-beta Mon Aug 13 09:31:46 2007 +0200 @@ -1,4 +1,15 @@ -*- indented-text -*- +to 20.2 beta3 +-- Miscellaneous Mule/ Egg/Quail patches courtesy of Jareth Hein +-- Various hyperbole fixes courtesy of Bob Weiner +-- Restoration of obsolete symbol overriding-file-coding-system +-- MULE-ization of lib-complete.el +-- W3-3.0.85 +-- xmine-1.8 coutesy of Jens Lautenbacher +-- efs-1.15-x5 Courtesy of Michael Sperber +-- miscellaneous bug fixes +-- balloon-help.el-1.06 Courtesy of Kyle Jones + to 20.2 beta2 -- sundry psgml fixes -- VM-6.29
--- a/ChangeLog Mon Aug 13 09:31:13 2007 +0200 +++ b/ChangeLog Mon Aug 13 09:31:46 2007 +0200 @@ -1,3 +1,7 @@ +Sun Apr 27 12:25:55 1997 Steven L Baur <steve@altair.xemacs.org> + + * XEmacs 20.2-b3 is released. + Wed Apr 23 10:33:58 1997 Steven L Baur <steve@altair.xemacs.org> * XEmacs 20.2-b2 is released.
--- a/PROBLEMS Mon Aug 13 09:31:13 2007 +0200 +++ b/PROBLEMS Mon Aug 13 09:31:46 2007 +0200 @@ -1036,6 +1036,42 @@ You *have* to compile your own jpeg lib. The one delivered with SGI systems is a C++ lib, which apparently XEmacs cannot cope with. +** XEmacs won't build with the n32 environment on Irix 6. + +Olivier Galibert <Olivier.Galibert@mines.u-nancy.fr> writes: +While making the OS and the compiler able to work on 64b +architectures, SGI designed another mode for using registers +and passing parameters between functions, activated on the +compiler by using -64. Since it was much more efficient ar +using registers even for 32b architectures, they designed +a version for 32b called n32. And it _is_ really better. +This mode should always be used when not using gcc (which +can only do o32 afaik). + +Too bad xemacs can't do n32 out of the box. So here is what +I had to do to compile it in this mode: + +s/irix6-0.h: +- #define LD_SWITCH_SYSTEM -32 ++ #define LD_SWITCH_SYSTEM -n32 -G 0 + +m/iris4d.h: +- #define LIBS_MACHINE -lmld ++ #define LIBS_MACHINE + +- #define C_SWITCH_MACHINE -32 ++ #define C_SWITCH_MACHINE -n32 -G 0 + +(the mld lib does not exist in n32 mode) + +I also added a --cflags='-n32 -O2 -G 0 -s' to the configuration +line but it seems that these flags are ignored for configure test +and since o32 and n32 libraries are independant I had to revert +to the CFLAGS env var. + +Anyway, once done that the compile has gone succesfully, the dump +was OK and I'm writing this in the resulting xemacs-20.2b1 ;-) + ** Slow startup on Linux. People using systems based on the Linux kernel sometimes report that
--- a/etc/NEWS Mon Aug 13 09:31:13 2007 +0200 +++ b/etc/NEWS Mon Aug 13 09:31:46 2007 +0200 @@ -112,6 +112,66 @@ * Changes in XEmacs 20.2 ======================== +Testing of XEmacs 20.1 revealed a number of showstopping bugs at the +very final moment. Instead of confusing the version numbers further, +the `20.1' designation was abandoned, and the release was renamed to +`20.2'. + +** 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. + +** Several Egg/Wnn-related crashes were fixed. + +** lib-complete.el was MULE-ized. + +The commands `find-library', `find-library-other-window' and +`find-library-other-frame' now take an optional coding system +argument. + +** XEmacs 20.0 MULE API supported for backwards compatibilty + +XEmacs 20.2 primarily supports the MULE 3 API. It now also supports +the XEmacs 20.0 MULE API. + +** `values' now has a setf method + +** W3-3.0.85 Courtesy of William Perry + +Bug fixes. See the 20.1 notes for further details. + +** Gnus-5.4.47 Courtesy of Lars Magne Ingebrigtsen + +Bug fixes. See the 20.1 notes for further details. + +** edmacro.el-3.10 Courtesy of Hrvoje Niksic + +Interface changes to maintain Emacs compatibility. + +** live-icon.el-1.3 + +Bug fixes. + +** tpu-edt.el + +Restoration of proper behavior with respect to the zmacs region. + +** xmine.el-1.8 + +** balloon-help.el-1.06 Courtesy of Kyle Jones + +** VM-6.29 + +** Verilog.el-2.25 Courtesy of Michael McNamara + +** etags.c-11.83 Courtesy of F. Potort́ + +** Further support of Custom package by Hrvoje Niksic + +* Changes in XEmacs 20.1 (never publicly released) +======================== + ** The logo has been changed, and the default background color is now a shade of gray instead of the eye-burning white. @@ -127,11 +187,6 @@ 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.
--- a/etc/w3/stylesheet Mon Aug 13 09:31:13 2007 +0200 +++ b/etc/w3/stylesheet Mon Aug 13 09:31:46 2007 +0200 @@ -63,10 +63,12 @@ h5 { font-size : -2pt } h6 { font-size : -4pt } -/* Used to cause problems under Emacs 19, lets try once more, with feeling! */ +/* This causes problems with Emacs 19 */ +@media xemacs { pre,xmp, plaintext { font-family: monospace } key,code,tt { font-family: monospace } +} /* ** Best we can do under Emacs-19 is use the default font and try to make
--- a/lib-src/ChangeLog Mon Aug 13 09:31:13 2007 +0200 +++ b/lib-src/ChangeLog Mon Aug 13 09:31:46 2007 +0200 @@ -1,3 +1,8 @@ +Fri Apr 25 09:12:04 1997 Steven L Baur <steve@altair.xemacs.org> + + * pstogif: Use Martin Buchholz magic to automagically find perl + interpreter. + Tue Apr 8 03:08:22 1997 Steven L Baur <steve@altair.xemacs.org> * Makefile.in.in: C Comment out Make comments. No snide comments
--- a/lib-src/pstogif Mon Aug 13 09:31:13 2007 +0200 +++ b/lib-src/pstogif Mon Aug 13 09:31:46 2007 +0200 @@ -1,4 +1,6 @@ -#!/usr/local/bin/perl +: # -*-Perl-*- +eval 'exec perl -w -S $0 ${1+"$@"}' # Portability kludge + if 0; # # pstogif.pl v1.0, July 1994, by Nikos Drakos <nikos@cbl.leeds.ac.uk> # Computer Based Learning Unit, University of Leeds.
--- a/lisp/ChangeLog Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/ChangeLog Mon Aug 13 09:31:46 2007 +0200 @@ -1,3 +1,41 @@ +Sat Apr 26 16:25:49 1997 Steven L Baur <steve@altair.xemacs.org> + + * utils/lib-complete.el: Make conformant to Lisp coding standards + MULE-ize by allowing for coding system argument. + +Fri Apr 25 08:39:50 1997 Steven L Baur <steve@altair.xemacs.org> + + * packages/info.el: Remove mouse-1 binding. + + * modes/sh-script.el (sh-indent-line): Deal with pathological case + of indenting a first line containing a `#' as first non-white + space character. + +Thu Apr 24 18:40:32 1997 Steven L Baur <steve@altair.xemacs.org> + + * comint/telnet.el (telnet-mode-map): Correct Emacs synch typo. + + * rmail/rmail.el (rmail-get-new-mail): display-time-string is not + necessarily a string. + +Thu Apr 24 11:08:28 1997 Kyle Jones <kyle_jones@wonderworks.com> + + * packages/balloon-help.el: + - default background color now grey80 to match XEmacs default. + - default border width is now 1. + - default font is now "variable" + - balloon-help can now handle variable width fonts. + - loading balooon-help no longer turns on balloon-help-mode. + - new `balloon-help' command. + - changes to the font/background/foreground variables now affect + the help frame at next display. + - help frame should now pop up on the correct display if XEmacs + is running with multiple devices open. + - Customized, courtesy of Hrvoje. + - don't use the padding lines that were needed for 19.12. + Compatibility with older XEmacs versions is hereby disavowed. + - xclock frame name hack is gone. + Wed Apr 23 10:56:05 1997 Steven L Baur <steve@altair.xemacs.org> * prim/files.el (hack-local-variables-prop-line): Mistakenly
--- a/lisp/comint/telnet.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/comint/telnet.el Mon Aug 13 09:31:46 2007 +0200 @@ -120,7 +120,7 @@ (set-keymap-parents telnet-mode-map (list comint-mode-map)) (define-key telnet-mode-map "\C-m" 'telnet-send-input) ; (define-key telnet-mode-map "\C-j" 'telnet-send-input) - (define-key telnet-mode-map "\C-c\C-q" 'send-process-next-char) + (define-key telnet-mode-map "\C-c\C-q" 'telnet-send-process-next-char) (define-key telnet-mode-map "\C-c\C-c" 'telnet-interrupt-subjob) (define-key telnet-mode-map "\C-c\C-z" 'telnet-c-z))
--- a/lisp/efs/dired-faces.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/efs/dired-faces.el Mon Aug 13 09:31:46 2007 +0200 @@ -57,9 +57,9 @@ :group 'dired) (defface dired-face-boring '((((class color)) - (:foreground "Grey")) + (:foreground "Gray65")) (((class grayscale)) - (:foreground "Grey"))) + (:foreground "Gray65"))) "Face used for unimportant files." :group 'dired)
--- a/lisp/efs/dired-shell.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/efs/dired-shell.el Mon Aug 13 09:31:46 2007 +0200 @@ -666,7 +666,7 @@ (list (dired-read-shell-command (concat (if dir - (format "! in %s" (dired-abbreviate-file-name dir)) + (format "! in %s " (dired-abbreviate-file-name dir)) "cd <dir>; ! ") "on " (if on-each "each ")
--- a/lisp/efs/dired-vir.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/efs/dired-vir.el Mon Aug 13 09:31:46 2007 +0200 @@ -75,6 +75,7 @@ (set (make-local-variable 'dired-subdir-alist) nil) (dired-build-subdir-alist) (goto-char (point-min)) + (dired-insert-set-properties (point-min) (point-max)) (dired-initial-position dirname)) (defun dired-virtual-guess-dir ()
--- a/lisp/efs/dired.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/efs/dired.el Mon Aug 13 09:31:46 2007 +0200 @@ -422,9 +422,9 @@ "*File names matching these regexp may be omitted (buffer-local). This only has effect when the subdirectory is in omission mode. To make omission mode the default, set `dired-omit-files' to t. -This only has effect when `dired-omit-files-p' is t. +This only has effect when `dired-omit-files' is t. See also `dired-omit-extensions'.") -(make-variable-buffer-local 'dired-omit-files-regexp) +(make-variable-buffer-local 'dired-omit-regexps) (defvar dired-filename-re-ext "\\..+$" ; start from the first dot. last dot? "*Defines what is the extension of a file name. @@ -1563,7 +1563,7 @@ (run-hooks 'dired-after-readin-hook) ;; I put omit-expunge after the dired-after-readin-hook ;; in case that hook marks files. Does this make sense? Also, users - ;; might want to set dired-omit-files-p in some incredibly clever + ;; might want to set dired-omit-files in some incredibly clever ;; way depending on the contents of the directory... I don't know... (if dired-omit-files (dired-omit-expunge nil t)) @@ -5273,7 +5273,7 @@ (defun dired-omit-toggle (&optional arg) "Toggle between displaying and omitting files matching -`dired-omit-files-regexp' in the current subdirectory. +`dired-omit-regexps' in the current subdirectory. With a positive prefix, omits files in the entire tree dired buffer. With a negative prefix, forces all files in the tree dired buffer to be displayed." @@ -5317,7 +5317,7 @@ (defun dired-omit-expunge (&optional regexp full-buffer) ;; Hides all unmarked files matching REGEXP. - ;; If REGEXP is nil or not specified, uses `dired-omit-files-regexp', + ;; If REGEXP is nil or not specified, uses `dired-omit-regexps', ;; and also omits filenames ending in `dired-omit-extensions'. ;; If REGEXP is the empty string, this function is a no-op. (let ((omit-re (or regexp (dired-omit-regexp)))
--- a/lisp/efs/efs.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/efs/efs.el Mon Aug 13 09:31:46 2007 +0200 @@ -902,7 +902,7 @@ ;;; efs|Andy Norman and Sandy Rutherford ;;; |ange@hplb.hpl.hp.com and sandy@ibm550.sissa.it ;;; |transparent FTP Support for GNU Emacs -;;; |$Date: 1997/04/05 18:07:24 $|$efs release: 1.15 beta $| +;;; |$Date: 1997/04/27 19:30:06 $|$efs release: 1.15 beta $| ;;; Host and listing type notation: ;;; @@ -1597,6 +1597,9 @@ getting out of synch with the FTP client, so using this feature routinely isn't recommended.") +(defvar efs-use-passive-mode nil + "*If non-nil, the ftp client will specify passive mode for all transfers.") + ;;; Hooks and crooks. (defvar efs-ftp-startup-hook nil @@ -1657,7 +1660,7 @@ (defvar efs-cmd-ok-cmds (concat "^quote port \\|^type \\|^quote site \\|^chmod \\|^quote noop\\|" - "^quote pasv")) + "^quote pasv\\|^passive")) ;; Regexp to match commands for which efs-cmd-ok-msgs is a valid server ;; response for success. @@ -1690,6 +1693,8 @@ ; (Sometimes get this with a timeout, ; so treat as fatal.) "^3[0-5][0-7] \\|" ; 3yz = positive intermediate reply + ;; passive + "^[Pp]assive \\|" ;; client codes "^[Hh]ash mark ")) ;; Response to indicate that the requested action was successfully completed. @@ -3656,6 +3661,9 @@ ;; Tell client to send back hash-marks as progress. It isn't ;; usually fatal if this command fails. (efs-guess-hash-mark-size proc) + + (if efs-use-passive-mode + (efs-passive-mode host user)) ;; Run any user startup functions (let ((alist efs-ftp-startup-function-alist) @@ -3697,6 +3705,10 @@ 'efs-hash-mark-size) (string-to-int size)))))))))) +(defun efs-passive-mode (host user) + ;; put ftp into passive mode + (efs-send-cmd host user '(passive))) + ;;;; ------------------------------------------------------------ ;;;; Simple FTP process shell support. ;;;; ------------------------------------------------------------ @@ -4078,6 +4090,10 @@ (efs-fix-path host-type cmd2)) cmd-string (concat "rename " cmd1 " " cmd2)))) + ;; passive command + ((eq cmd0 'passive) + (setq cmd-string "passive")) + (t (error "efs: Don't know how to send %s %s %s %s" cmd0 cmd1 cmd2 cmd3)))) @@ -4211,7 +4227,7 @@ (progn (setq proc (efs-kerberos-login host user proc)) (efs-login-send-user host user proc gate)) - (let ((to (if (memq gate '(proxy local raptor)) + (let ((to (if (memq gate '(proxy raptor)) efs-gateway-host host)) port cmd result) @@ -4245,7 +4261,7 @@ Optional argument GATE specifies which type of gateway is being used. RETRY argument specifies to try twice if we get a 421 response." (let ((cmd (cond - ((memq gate '(local proxy interlock)) + ((memq gate '(proxy interlock)) (format "quote USER \"%s\"@%s" user (if (and efs-nslookup-on-connect (string-match "[^0-9.]" host)) @@ -4273,7 +4289,7 @@ (t (format "quote user \"%s\"" user)))) (msg (format "Logging in as user %s%s..." user - (if (memq gate '(proxy local raptor kerberos)) + (if (memq gate '(proxy raptor kerberos)) (concat "@" host) ""))) result code)
--- a/lisp/egg/egg.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/egg/egg.el Mon Aug 13 09:31:46 2007 +0200 @@ -2724,6 +2724,16 @@ (if (boundp 'mouse-track-cleanup-hook) (add-hook 'mouse-track-cleanup-hook 'fence-mouse-protect)) +(defun egg-lang-switch-callback () + "Do whatever processing is necessary when the language-environment changes." + (if egg:*in-fence-mode* + (progn + (its:reset-input) + (fence-cancel-input))) + (let ((func (get current-language-environment 'set-egg-environ))) + (if (not (null func)) + (funcall func)))) + (defun fence-mode-help-command () "Display documentation for fence-mode." (interactive) @@ -2834,9 +2844,13 @@ (define-key global-map "\C-^" 'special-symbol-input) -(autoload 'busyu-input "busyu" nil t) ;92.10.18 by K.Handa -(autoload 'kakusuu-input "busyu" nil t) ;92.10.18 by K.Handa +(autoload 'busyu-input "egg-busyu" nil t) +(autoload 'kakusuu-input "egg-busyu" nil t) (provide 'egg) +;; if set-lang-environment has already been called, call egg-lang-switch-callback +(if (not (null current-language-environment)) + (egg-lang-switch-callback)) + ;;; egg.el ends here
--- a/lisp/emulators/edt.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/emulators/edt.el Mon Aug 13 09:31:46 2007 +0200 @@ -1509,7 +1509,8 @@ (if (null term) (error "Unable to load EDT terminal specific file for %s" edt-term))) (setq edt-term term)) - (setq edt-orig-transient-mark-mode transient-mark-mode) + (when (boundp 'transient-mark-mode) + (setq edt-orig-transient-mark-mode transient-mark-mode)) (add-hook 'activate-mark-hook (function (lambda () @@ -1532,7 +1533,8 @@ (setq edt-select-mode-text nil) (edt-reset) (force-mode-line-update t) - (setq transient-mark-mode edt-orig-transient-mark-mode) + (when (boundp 'transient-mark-mode) + (setq transient-mark-mode edt-orig-transient-mark-mode)) (message "Original key bindings restored; EDT Emulation disabled")) (defun edt-default-emulation-setup (&optional user-setup) @@ -1590,7 +1592,8 @@ (defun edt-select-default-global-map() "Select default EDT emulation key bindings." (interactive) - (transient-mark-mode 1) + (when (fboundp 'transient-mark-mode) + (transient-mark-mode 1)) (use-global-map edt-default-global-map) (if (not edt-keep-current-page-delimiter) (progn @@ -1607,7 +1610,8 @@ (interactive) (if edt-user-map-configured (progn - (transient-mark-mode 1) + (when (fboundp 'transient-mark-mode) + (transient-mark-mode 1)) (use-global-map edt-user-global-map) (if (not edt-keep-current-page-delimiter) (progn
--- a/lisp/games/xmine.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/games/xmine.el Mon Aug 13 09:31:46 2007 +0200 @@ -2,7 +2,7 @@ ;; Author: Jens Lautenbacher <jens@lemming0.lem.uni-karlsruhe.de> ;; Keywords: games -;; Version: 1.7 +;; Version: 1.8 ;; This file is part of XEmacs. @@ -44,7 +44,7 @@ ;; ;;; First of all we'll define the needed varibles. -(defconst xmine-version-number "1.7" "XEmacs Mine version number.") +(defconst xmine-version-number "1.8" "XEmacs Mine version number.") (defconst xmine-version (format "XEmacs Mine v%s by Jens Lautenbacher © 1997" xmine-version-number) "Full XEmacs Mine version number.") @@ -100,36 +100,39 @@ "------------------ XEmacs XMine ------------------"))) (defvar xmine-glyph-production-list - '(("xmine-new-up" "new_up.gif" "new" nil ) - ("xmine-new-down" "new_down.gif" "NEW" nil ) - ("xmine-quit-up" "quit_up.gif" "quit" nil ) - ("xmine-quit-down" "quit_down.gif" "QUIT" nil ) - ("xmine-up-glyph" "empty_16_up.gif" "@ " xmine-hidden-face ) - ("xmine-up-sel-glyph" "empty_16_up_sel.gif" "@<" xmine-hidden-face ) - ("xmine-down-glyph" "empty_16_down.gif" "? " nil ) + '(("xmine-new-up" "new_up.gif" "new" nil) + ("xmine-new-down" "new_down.gif" "NEW" nil) + ("xmine-quit-up" "quit_up.gif" "quit" nil) + ("xmine-quit-down" "quit_down.gif" "QUIT" nil) + ("xmine-up-glyph" "empty_16_up.gif" "@ " xmine-hidden-face) + ("xmine-up-sel-glyph" "empty_16_up_sel.gif" "@<" xmine-hidden-face) + ("xmine-down-glyph" "empty_16_down.gif" "? " nil) ("xmine-flagged-glyph" "flagged_16_up.gif" "! " xmine-flagged-face) ("xmine-flagged-sel-glyph" "flagged_16_up_sel.gif" "!<" xmine-flagged-face) - ("xmine-mine-glyph" "bomb_16_flat.gif" "* " nil ) - ("xmine-mine-sel-glyph" "bomb_16_flat.gif" "*<" nil ) - ("xmine-trapped-glyph" "bomb_trapped_16_flat.gif" "X " nil ) - ("xmine-0-glyph" "empty_16_flat.gif" ". " nil ) - ("xmine-0-sel-glyph" "empty_16_flat_sel.gif" ".<" nil ) - ("xmine-1-glyph" "1_16_flat.gif" "1 " xmine-number-face ) - ("xmine-1-sel-glyph" "1_16_flat_sel.gif" "1<" xmine-number-face ) - ("xmine-2-glyph" "2_16_flat.gif" "2 " xmine-number-face ) - ("xmine-2-sel-glyph" "2_16_flat_sel.gif" "2<" xmine-number-face ) - ("xmine-3-glyph" "3_16_flat.gif" "3 " xmine-number-face ) - ("xmine-3-sel-glyph" "3_16_flat_sel.gif" "3<" xmine-number-face ) - ("xmine-4-glyph" "4_16_flat.gif" "4 " xmine-number-face ) - ("xmine-4-sel-glyph" "4_16_flat_sel.gif" "4<" xmine-number-face ) - ("xmine-5-glyph" "5_16_flat.gif" "5 " xmine-number-face ) - ("xmine-5-sel-glyph" "5_16_flat_sel.gif" "5<" xmine-number-face ) - ("xmine-6-glyph" "6_16_flat.gif" "6 " xmine-number-face ) - ("xmine-6-sel-glyph" "6_16_flat_sel.gif" "6<" xmine-number-face ) - ("xmine-7-glyph" "7_16_flat.gif" "7 " xmine-number-face ) - ("xmine-7-sel-glyph" "7_16_flat_sel.gif" "7<" xmine-number-face ) - ("xmine-8-glyph" "8_16_flat.gif" "8 " xmine-number-face ) - ("xmine-8-sel-glyph" "8_16_flat_sel.gif" "8<" xmine-number-face ))) + ("xmine-mine-glyph" "bomb_16_flat.gif" "* " nil) + ("xmine-mine-sel-glyph" "bomb_16_flat.gif" "*<" nil) + ("xmine-trapped-glyph" "bomb_trapped_16_flat.gif" "X " nil) + ("xmine-0-glyph" "empty_16_flat.gif" ". " nil) + ("xmine-0-sel-glyph" "empty_16_flat_sel.gif" ".<" nil) + ("xmine-1-glyph" "1_16_flat.gif" "1 " xmine-number-face) + ("xmine-1-sel-glyph" "1_16_flat_sel.gif" "1<" xmine-number-face) + ("xmine-2-glyph" "2_16_flat.gif" "2 " xmine-number-face) + ("xmine-2-sel-glyph" "2_16_flat_sel.gif" "2<" xmine-number-face) + ("xmine-3-glyph" "3_16_flat.gif" "3 " xmine-number-face) + ("xmine-3-sel-glyph" "3_16_flat_sel.gif" "3<" xmine-number-face) + ("xmine-4-glyph" "4_16_flat.gif" "4 " xmine-number-face) + ("xmine-4-sel-glyph" "4_16_flat_sel.gif" "4<" xmine-number-face) + ("xmine-5-glyph" "5_16_flat.gif" "5 " xmine-number-face) + ("xmine-5-sel-glyph" "5_16_flat_sel.gif" "5<" xmine-number-face) + ("xmine-6-glyph" "6_16_flat.gif" "6 " xmine-number-face) + ("xmine-6-sel-glyph" "6_16_flat_sel.gif" "6<" xmine-number-face) + ("xmine-7-glyph" "7_16_flat.gif" "7 " xmine-number-face) + ("xmine-7-sel-glyph" "7_16_flat_sel.gif" "7<" xmine-number-face) + ("xmine-8-glyph" "8_16_flat.gif" "8 " xmine-number-face) + ("xmine-8-sel-glyph" "8_16_flat_sel.gif" "8<" xmine-number-face))) + +(defvar xmine-force-textual nil + "This is for debugging purposes only. No need to set it. Really.") (defun xmine-generate-glyphs () (let ((list xmine-glyph-production-list) @@ -140,7 +143,8 @@ text (caddr elem) face (cadddr elem)) (set (intern var) - (make-glyph (if (eq window-system 'x) + (make-glyph (if (and (not xmine-force-textual) + (eq window-system 'x)) (concat xmine-glyph-dir gif) text))) (if face @@ -241,14 +245,20 @@ (defun xmine-activate-function-button (event) (interactive "e") (let* ((extent (event-glyph-extent event)) - (button (event-button event)) - (action (intern (concat "action" (number-to-string button)))) + (button (number-to-string (event-button event))) + (action (intern (concat "action" button))) + (down-action (intern (concat "down-action" button))) + (restore-down-action (intern (concat "restore-down-action" button))) (mouse-down t) - (up-glyph nil)) + (action-do-it t) + up-glyph) ;; make the glyph look pressed (cond ((annotation-down-glyph extent) (setq up-glyph (annotation-glyph extent)) (set-annotation-glyph extent (annotation-down-glyph extent)))) + (if (extent-property extent down-action) + (setq action-do-it + (funcall (extent-property extent down-action) extent))) (while mouse-down (setq event (next-event event)) (if (button-release-event-p event) @@ -257,8 +267,12 @@ (cond ((annotation-down-glyph extent) (set-annotation-glyph extent up-glyph))) (if (eq extent (event-glyph-extent event)) - (if (extent-property extent action) - (funcall (extent-property extent action) extent))))) + (if (and (extent-property extent action) action-do-it) + (funcall (extent-property extent action) extent) + (if (extent-property extent restore-down-action) + (funcall (extent-property extent restore-down-action) extent))) + (if (extent-property extent restore-down-action) + (funcall (extent-property extent restore-down-action) extent))))) ;;; Here we define the button object's constructor function @@ -268,6 +282,8 @@ (set-extent-property ext 'action1 'xmine-action1) (set-extent-property ext 'action2 'xmine-beep) (set-extent-property ext 'action3 'xmine-action3) + (set-extent-property ext 'down-action2 'xmine-down-action2) + (set-extent-property ext 'restore-down-action2 'xmine-restore-down-action2) (set-extent-property ext 'xmine-glyph (xmine-type-to-glyph type)) (set-extent-property ext 'xmine-sel-glyph (xmine-type-to-sel-glyph type)) (set-extent-property ext 'xmine-type type) @@ -294,6 +310,22 @@ (not (extent-property ext 'xmine-hidden)) (equal "0" (extent-property ext 'xmine-type)))) +(defun xmine-enough-flagged-p (ext) + (let ((list (xmine-get-neighbours ext)) + (number (extent-property ext 'xmine-type)) + (flagged 0) elem res) + (if (not (or (equal number "mine") + (equal number "0"))) + (progn + (setq number (string-to-number number)) + (while (setq elem (pop list)) + (if (extent-property elem 'xmine-flagged) + (setq flagged (1+ flagged)))) + (setq res (>= flagged number)) + )) + res)) + + (defun xmine-mine-button-p (ext) (and ext (equal "mine" (extent-property ext 'xmine-type)))) @@ -313,7 +345,7 @@ (defun xmine-type-to-sel-glyph (type) (eval (intern-soft (concat "xmine-" type "-sel-glyph")))) -;;; the next three functions are the main functions that are used +;;; the next 3 functions are the main functions that are used ;;; inside the button objects and which are bound to the 'action1, ;;; 'action2 and 'action3 slots respectively @@ -353,6 +385,7 @@ (let ((list (xmine-get-neighbours ext)) (xmine-no-unhide-sound t) next) +;; (xmine-restore-down-action2 ext) (if list (xmine-unhide-many-sound)) (while (setq next (pop list)) (if (not (xmine-flat-button-p next)) (xmine-action1 next))))) @@ -390,6 +423,22 @@ xmine-number-of-flagged)))))))) +(defun xmine-down-action2 (ext) + (let ((list (xmine-get-neighbours ext)) + (do-it (xmine-enough-flagged-p ext)) + elem) + (if (not do-it) + (while (setq elem (pop list)) + (set-extent-property elem 'xmine-temp-glyph (annotation-glyph elem)) + (set-annotation-glyph elem (annotation-down-glyph elem)))) + do-it)) + +(defun xmine-restore-down-action2 (ext) + (let ((list (xmine-get-neighbours ext)) + elem) + (while (setq elem (pop list)) + (set-annotation-glyph elem (extent-property elem 'xmine-temp-glyph))))) + ;;; the sounds... (defcustom xmine-play-sounds nil "If XMine should play some sounds for various events to happen." @@ -739,8 +788,9 @@ (defun xmine-key-action2 () (interactive) (let ((action (extent-property xmine-key-sel-button 'action2))) - (if action - (funcall action xmine-key-sel-button)))) + (if (and action (xmine-enough-flagged-p xmine-key-sel-button)) + (funcall action xmine-key-sel-button) + (beep)))) (defun xmine-key-action3 () (interactive)
--- a/lisp/hyperbole/hsite-ex.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/hyperbole/hsite-ex.el Mon Aug 13 09:31:46 2007 +0200 @@ -9,7 +9,7 @@ ;; ORG: InfoDock Associates ;; ;; ORIG-DATE: 15-Apr-91 at 00:48:49 -;; LAST-MOD: 8-Mar-97 at 22:52:36 by Bob Weiner +;; LAST-MOD: 24-Apr-97 at 22:41:33 by Bob Weiner ;; ;; This file is part of Hyperbole. ;; Available for use and distribution under the same terms as GNU Emacs. @@ -285,7 +285,10 @@ (list 'one-window (function (lambda (f) (if (br-in-browser) (br-quit)) (delete-other-windows) (find-file f)))) - (list 'new-frame 'find-file-new-frame) + (list 'new-frame (function (lambda (f) + (if (fboundp 'find-file-new-frame) + (find-file-new-frame f) + (find-file-other-frame f))))) (list 'other-frame 'hpath:find-other-frame) (list 'other-frame-one-window (function (lambda (f) (hpath:find-other-frame f) (delete-other-windows)))))
--- a/lisp/hyperbole/hui-mouse.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/hyperbole/hui-mouse.el Mon Aug 13 09:31:46 2007 +0200 @@ -11,7 +11,7 @@ ;; ORG: InfoDock Associates ;; ;; ORIG-DATE: 04-Feb-89 -;; LAST-MOD: 20-Feb-97 at 11:55:00 by Bob Weiner +;; LAST-MOD: 24-Apr-97 at 22:37:14 by Bob Weiner ;; ;; This file is part of Hyperbole. ;; Available for use and distribution under the same terms as GNU Emacs. @@ -458,7 +458,9 @@ (goto-char (point-max))) ((looking-at "~") (dired-flag-backup-files)) ((looking-at "#") (dired-flag-auto-save-files)) - (t (dired-flag-file-deleted 1)))) + (t (if (fboundp 'dired-flag-file-deletion) + (dired-flag-file-deletion 1) + (dired-flag-file-deleted 1))))) ;;; ************************************************************************ ;;; smart-gnus functions
--- a/lisp/ilisp/ilisp-cmu.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/ilisp/ilisp-cmu.el Mon Aug 13 09:31:46 2007 +0200 @@ -82,9 +82,20 @@ ilisp-reset ":q" - comint-interrupt-regexp "Interrupted at" + comint-interrupt-regexp "Interrupted at") - ilisp-binary-extension "sparcf" - ilisp-init-binary-extension "sparcf" - ilisp-binary-command "\"sparcf\"" - )) + (if (progn + (shell-command "uname -s") + (save-excursion + (set-buffer "*Shell Command Output*") + (goto-char (point-min)) + (looking-at "[Ll]inux"))) + (setq + ilisp-binary-extension "x86f" + ilisp-init-binary-extension "x86f" + ilisp-binary-command "\"x86f\"") + ;; else assume sparc. + (setq ilisp-binary-extension "sparcf" + ilisp-init-binary-extension "sparcf" + ilisp-binary-command "\"sparcf\""))) +
--- a/lisp/modes/cperl-mode.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/modes/cperl-mode.el Mon Aug 13 09:31:46 2007 +0200 @@ -32,7 +32,7 @@ ;;; Corrections made by Ilya Zakharevich ilya@math.mps.ohio-state.edu ;;; XEmacs changes by Peter Arius arius@informatik.uni-erlangen.de -;; $Id: cperl-mode.el,v 1.4 1997/03/16 03:05:17 steve Exp $ +;; $Id: cperl-mode.el,v 1.5 1997/04/27 19:30:26 steve Exp $ ;;; To use this mode put the following into your .emacs file: @@ -3757,7 +3757,8 @@ (save-excursion (cond (inbuffer nil) ; Already there ((file-exists-p tags-file-name) - (visit-tags-table-buffer tags-file-name)) + ;;(visit-tags-table-buffer tags-file-name)) + (visit-tags-table-buffer)) (t (set-buffer (find-file-noselect tags-file-name)))) (cond (dir
--- a/lisp/modes/sh-script.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/modes/sh-script.el Mon Aug 13 09:31:46 2007 +0200 @@ -1002,6 +1002,7 @@ (interactive) (let ((previous (save-excursion (while (and (not (bobp)) + (not (eq (point-min) (point-at-bol))) (progn (forward-line -1) (back-to-indentation)
--- a/lisp/mule/canna.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/mule/canna.el Mon Aug 13 09:31:46 2007 +0200 @@ -5,7 +5,7 @@ ;; Author: Akira Kon <kon@d1.bs2.mt.nec.co.jp> ;; MORIOKA Tomohiko <morioka@jaist.ac.jp> -;; Version: $Revision: 1.5 $ +;; Version: $Revision: 1.6 $ ;; Keywords: Canna, Japanese, input method, mule, multilingual ;; This file is not a part of Emacs yet. @@ -49,7 +49,7 @@ ;; end (defconst canna-rcs-version - "$Id: canna.el,v 1.5 1997/04/10 05:55:27 steve Exp $") + "$Id: canna.el,v 1.6 1997/04/27 19:30:30 steve Exp $") (defun canna-version () "Display version of canna.el in mini-buffer." @@ -174,7 +174,7 @@ (or (canna:memq-recursive 'mode-line-canna-mode default-modeline-format) (setq-default default-modeline-format - (nconc '("" mode-line-canna-mode) + (append '("" mode-line-canna-mode) default-modeline-format)) ) (mapcar (function @@ -184,7 +184,7 @@ (or (canna:memq-recursive 'mode-line-canna-mode modeline-format) (setq modeline-format - (nconc '("" mode-line-canna-mode) + (append '("" mode-line-canna-mode) modeline-format)) ) ))) @@ -760,6 +760,9 @@ (- (point) arg) (point))) (if (= last-command-char ? ) (canna:do-auto-fill)))))) +;; wire us into pending-delete +(put 'canna-self-insert-command 'pending-delete t) + (defun canna-toggle-japanese-mode () "Toggle canna japanese mode." (interactive)
--- a/lisp/mule/chinese-hooks.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/mule/chinese-hooks.el Mon Aug 13 09:31:46 2007 +0200 @@ -113,21 +113,21 @@ ;; Please add your own quail package if any. ;; For GB character input -;;(add-hook 'quail-package-alist '("py" "quail/py")) -;;(add-hook 'quail-package-alist '("qj" "quail/qj")) -;;(add-hook 'quail-package-alist '("punct" "quail/punct")) -;;(add-hook 'quail-package-alist '("sw" "quail/sw")) -;;(add-hook 'quail-package-alist '("tonepy" "quail/tonepy")) -;;(add-hook 'quail-package-alist '("ccdospy" "quail/ccdospy")) -;;(add-hook 'quail-package-alist '("ctlau" "quail/ctlau")) +(add-hook 'quail-package-alist '("py" "quail-py")) +(add-hook 'quail-package-alist '("qj" "quail-qj")) +(add-hook 'quail-package-alist '("punct" "quail-punct")) +(add-hook 'quail-package-alist '("sw" "quail-sw")) +(add-hook 'quail-package-alist '("tonepy" "quail-tonepy")) +(add-hook 'quail-package-alist '("ccdospy" "quail-ccdospy")) +(add-hook 'quail-package-alist '("ctlau" "quail-ctlau")) ;; For BIG5 character input -;;(add-hook 'quail-package-alist '("py-b5" "quail/py-b5")) -;;(add-hook 'quail-package-alist '("qj-b5" "quail/qj-b5")) -;;(add-hook 'quail-package-alist '("punct-b5" "quail/punct-b5")) -;;(add-hook 'quail-package-alist '("ctlaub" "quail/ctlaub")) -;;(add-hook 'quail-package-alist '("zozy" "quail/zozy")) -;;(add-hook 'quail-package-alist '("etzy" "quail/etzy")) +;;(add-hook 'quail-package-alist '("py-b5" "quail-py-b5")) +;;(add-hook 'quail-package-alist '("qj-b5" "quail-qj-b5")) +;;(add-hook 'quail-package-alist '("punct-b5" "quail-punct-b5")) +;;(add-hook 'quail-package-alist '("ctlaub" "quail-ctlaub")) +;;(add-hook 'quail-package-alist '("zozy" "quail-zozy")) +;;(add-hook 'quail-package-alist '("etzy" "quail-etzy")) ;; For Big5 handling
--- a/lisp/mule/cyrillic-hooks.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/mule/cyrillic-hooks.el Mon Aug 13 09:31:46 2007 +0200 @@ -25,9 +25,9 @@ ;; For syntax of Cyrillic (modify-syntax-entry 'cyrillic-iso8859-5 "w") -(modify-syntax-entry ?,L-(B ".") -(modify-syntax-entry ?,Lp(B ".") -(modify-syntax-entry ?,L}(B ".") +(modify-syntax-entry ?-L ".")-A +(modify-syntax-entry ?-Lđ ".")-A +(modify-syntax-entry ?-Lư ".")-A @@ -45,12 +45,12 @@ mnemonic "ISO8/Cyr" )) -;;(add-hook 'quail-package-alist '("jcuken" "quail/cyrillic")) -;;(add-hook 'quail-package-alist '("macedonian" "quail/cyrillic")) -;;(add-hook 'quail-package-alist '("serbian" "quail/cyrillic")) -;;(add-hook 'quail-package-alist '("beylorussian" "quail/cyrillic")) -;;(add-hook 'quail-package-alist '("ukrainian" "quail/cyrillic")) -;;(add-hook 'quail-package-alist '("yawerty" "quail/cyrillic")) +;;(add-hook 'quail-package-alist '("jcuken" "quail-cyrillic")) +;;(add-hook 'quail-package-alist '("macedonian" "quail-cyrillic")) +;;(add-hook 'quail-package-alist '("serbian" "quail-cyrillic")) +;;(add-hook 'quail-package-alist '("beylorussian" "quail-cyrillic")) +;;(add-hook 'quail-package-alist '("ukrainian" "quail-cyrillic")) +(add-hook 'quail-package-alist '("yawerty" "quail-cyrillic")) (define-language-environment 'cyrillic "Cyrillic" @@ -60,6 +60,6 @@ (set-default-buffer-file-coding-system 'iso-8859-5) (setq terminal-coding-system 'iso-8859-5) (setq keyboard-coding-system 'iso-8859-5) -;; (setq-default quail-current-package -;; (assoc "yawerty" quail-package-alist)))) + (setq-default quail-current-package + (assoc "yawerty" quail-package-alist)) ))
--- a/lisp/mule/ethiopic-hooks.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/mule/ethiopic-hooks.el Mon Aug 13 09:31:46 2007 +0200 @@ -51,7 +51,7 @@ (set-charset-ccl-program 'ethiopic ccl-ethiopic) -(add-hook 'quail-package-alist '("ethio" "quail/ethio")) +(add-hook 'quail-package-alist '("ethio" "quail-ethio")) (define-language-environment 'ethiopic "Ethiopic"
--- a/lisp/mule/european-hooks.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/mule/european-hooks.el Mon Aug 13 09:31:46 2007 +0200 @@ -24,23 +24,23 @@ ;;; Synched up with: Mule 2.3. ;; For syntax of Latin-1 characters. -(loop for c from 64 to 127 ; from ',A@(B' to ',A(B' +(loop for c from 64 to 127 ; from 'À' to 'ÿ' do (modify-syntax-entry (make-char 'latin-iso8859-1 c) "w")) (modify-syntax-entry (make-char 'latin-iso8859-1 32) "w") ; no-break space -(modify-syntax-entry ?,AW(B "_") -(modify-syntax-entry ?,Aw(B "_") +(modify-syntax-entry ?× "_") +(modify-syntax-entry ?÷ "_") ;; For syntax of Latin-2 -(loop for c in '(?,B!(B ?,B#(B ?,B%(B ?,B&(B ?,B)(B ?,B*(B ?,B+(B ?,B,(B ?,B.(B ?,B/(B ?,B1(B ?,B3(B ?,B5(B ?,B6(B ?,B9(B ?,B:(B ?,B;(B ?,B<(B) +(loop for c in '(?-B¡ ?£ ?¥ ?¦ ?© ?ª ?« ?¬ ?® ?¯ ?± ?³ ?µ ?¶ ?¹ ?º ?» ?¼)-A do (modify-syntax-entry c "w")) (loop for c from 62 to 126 do (modify-syntax-entry (make-char 'latin-iso8859-2 c) "w")) (modify-syntax-entry (make-char 'latin-iso8859-2 32) "w") ; no-break space -(modify-syntax-entry ?,BW(B ".") -(modify-syntax-entry ?,Bw(B ".") +(modify-syntax-entry ?-B× ".")-A +(modify-syntax-entry ?-B÷ ".")-A ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; EUROPEANS @@ -82,11 +82,11 @@ mnemonic "MIME/Ltn-5" )) -;;(add-hook 'quail-package-alist '("latin-1" "quail/latin")) -;;(add-hook 'quail-package-alist '("latin-2" "quail/latin")) -;;(add-hook 'quail-package-alist '("latin-3" "quail/latin")) -;;(add-hook 'quail-package-alist '("latin-4" "quail/latin")) -;;(add-hook 'quail-package-alist '("latin-5" "quail/latin")) +(add-hook 'quail-package-alist '("latin-1" "quail-latin")) +(add-hook 'quail-package-alist '("latin-2" "quail-latin")) +(add-hook 'quail-package-alist '("latin-3" "quail-latin")) +(add-hook 'quail-package-alist '("latin-4" "quail-latin")) +(add-hook 'quail-package-alist '("latin-5" "quail-latin")) (define-language-environment 'european "European (for Latin-1 through Latin-5)" @@ -98,6 +98,6 @@ (set-buffer-file-coding-system-for-read 'no-conversion) ; iso-8859-1 ;;(setq display-coding-system 'iso-8859-1) ;;(setq keyboard-coding-system 'iso-8859-1) - ;;(setq-default quail-current-package - ;; (assoc "latin-1" quail-package-alist)))) + (setq-default quail-current-package + (assoc "latin-1" quail-package-alist)) ))
--- a/lisp/mule/greek-hooks.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/mule/greek-hooks.el Mon Aug 13 09:31:46 2007 +0200 @@ -27,9 +27,9 @@ (loop for c from 54 to 126 do (modify-syntax-entry (make-char 'greek-iso8859-7 c) "w")) (modify-syntax-entry (make-char 'greek-iso8859-7 32) "w") ; no-break space -(modify-syntax-entry ?,F7(B ".") -(modify-syntax-entry ?,F;(B ".") -(modify-syntax-entry ?,F=(B ".") +(modify-syntax-entry ?-F· ".")-A +(modify-syntax-entry ?-F» ".")-A +(modify-syntax-entry ?-F½ ".")-A ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -45,7 +45,7 @@ mnemonic "MIME/Grk" )) -;;(add-hook 'quail-package-alist '("greek" "quail/greek")) +(add-hook 'quail-package-alist '("greek" "quail-greek")) (define-language-environment 'greek "Greek" @@ -55,6 +55,6 @@ (set-default-buffer-file-coding-system 'iso-8859-7) (setq terminal-coding-system 'iso-8859-7) (setq keyboard-coding-system 'iso-8859-7) -;; (setq-default quail-current-package -;; (assoc "greek" quail-package-alist)))) + (setq-default quail-current-package + (assoc "greek" quail-package-alist)) ))
--- a/lisp/mule/hebrew-hooks.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/mule/hebrew-hooks.el Mon Aug 13 09:31:46 2007 +0200 @@ -53,7 +53,7 @@ mnemonic "CText/Hbrw" )) -;;(add-hook 'quail-package-alist '("hebrew" "quail/hebrew")) +(add-hook 'quail-package-alist '("hebrew" "quail-hebrew")) (define-language-environment 'hebrew "Hebrew" @@ -63,6 +63,6 @@ (set-default-buffer-file-coding-system 'iso-8859-8) (setq terminal-coding-system 'iso-8859-8) (setq keyboard-coding-system 'iso-8859-8) -;; (setq-default quail-current-package -;; (assoc "hebrew" quail-package-alist)))) + (setq-default quail-current-package + (assoc "hebrew" quail-package-alist)) ))
--- a/lisp/mule/ipa-hooks.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/mule/ipa-hooks.el Mon Aug 13 09:31:46 2007 +0200 @@ -37,5 +37,5 @@ ;;; OTHERS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(add-hook 'quail-package-alist '("ipa" "quail/ipa")) +(add-hook 'quail-package-alist '("ipa" "quail-ipa"))
--- a/lisp/mule/isearch-mule.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/mule/isearch-mule.el Mon Aug 13 09:31:46 2007 +0200 @@ -64,10 +64,10 @@ (isearch-fep-quail isearch-fep-prompt-quail isearch-fep-read-quail))) ;; the followings are defined in isearch.el -;; (define-key isearch-mode-map "\C-k" 'isearch-fep-string) -;; (define-key isearch-mode-map "\C-\\" 'isearch-fep-egg) -;; (define-key isearch-mode-map "\M-k" 'isearch-fep-egg) -;; (define-key isearch-mode-map "\C-o" 'isearch-fep-canna) +(define-key isearch-mode-map "\C-k" 'isearch-fep-string) +(define-key isearch-mode-map "\C-\\" 'isearch-fep-egg) +(define-key isearch-mode-map "\M-k" 'isearch-fep-egg) +(define-key isearch-mode-map "\C-o" 'isearch-fep-canna) ;; (define-key isearch-mode-map "\C-\]" 'isearch-fep-quail) (defun isearch-fep-mode ()
--- a/lisp/mule/japanese-hooks.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/mule/japanese-hooks.el Mon Aug 13 09:31:46 2007 +0200 @@ -139,6 +139,29 @@ mnemonic "EUC/Ja" )) +;; EGG specific setup +(define-egg-environment 'japanese + "Japanese settings for egg." + (lambda () + (when (not (featurep 'egg-jpn)) + (load "its/its-hira") + (load "its/its-kata") + (load "its/its-hankaku") + (load "its/its-zenkaku") + (setq its:*standard-modes* + (append + (list (its:get-mode-map "roma-kana") + (its:get-mode-map "roma-kata") + (its:get-mode-map "downcase") + (its:get-mode-map "upcase") + (its:get-mode-map "zenkaku-downcase") + (its:get-mode-map "zenkaku-upcase")) + its:*standard-modes*)) + (provide 'egg-jpn)) + (setq wnn-server-type 'jserver) + (setq egg-default-startup-file "eggrc-wnn") + (setq-default its:*current-map* (its:get-mode-map "roma-kana")))) + (define-language-environment 'japanese "Japanese (includes JIS and EUC)" (lambda () @@ -147,26 +170,6 @@ (set-coding-priority-list '(iso-7 iso-8-2 shift-jis no-conversion)) ;;'(iso-8-2 iso-8-designate iso-8-1 shift-jis big5) - ;; EGG specific setup 97.02.05 jhod - (when (featurep 'egg) - (when (not (featurep 'egg-jpn)) - (provide 'egg-jpn) - (setq wnn-server-type 'jserver) - (load "its/its-hira") - (load "its/its-kata") - (load "its/its-hankaku") - (load "its/its-zenkaku") - (setq its:*standard-modes* - (append - (list (its:get-mode-map "roma-kana") - (its:get-mode-map "roma-kata") - (its:get-mode-map "downcase") - (its:get-mode-map "upcase") - (its:get-mode-map "zenkaku-downcase") - (its:get-mode-map "zenkaku-upcase")) - its:*standard-modes*))) - (setq-default its:*current-map* (its:get-mode-map "roma-kana"))) - ;; Added by mrb, who doesn't speak japanese - so be sceptical... ;; (when (string-match "solaris\\|sunos" system-configuration) ;;(set-native-coding-system 'euc-japan) ; someday
--- a/lisp/mule/korean-hooks.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/mule/korean-hooks.el Mon Aug 13 09:31:46 2007 +0200 @@ -34,18 +34,10 @@ (loop for row from 38 to 41 do (modify-syntax-entry `[korean-ksc5601 ,row] ".")) (loop for row from 42 to 126 do (modify-syntax-entry `[korean-ksc5601 ,row] "w")) -;; EGG specific setup -;(if (featurep 'egg) -; (progn -; (load "its-hangul") -; (setq its:*standard-modes* -; (cons (its:get-mode-map "hangul") its:*standard-modes*)) -; (setq-default its:*current-map* (its:get-mode-map "hangul")))) - -;(add-hook 'quail-package-alist '("hangul" "quail/hangul")) -;(add-hook 'quail-package-alist '("hangul3" "quail/hangul3")) -;(add-hook 'quail-package-alist '("hanja-jis" "quail/hanja-jis")) -;(add-hook 'quail-package-alist '("hanja-ksc" "quail/hanja-ksc")) +(add-hook 'quail-package-alist '("hangul" "quail-hangul")) +(add-hook 'quail-package-alist '("hangul3" "quail-hangul3")) +(add-hook 'quail-package-alist '("hanja-jis" "quail-hanja-jis")) +(add-hook 'quail-package-alist '("hanja-ksc" "quail-hanja-ksc")) (make-coding-system 'euc-korea 'iso2022 @@ -83,6 +75,19 @@ mnemonic "ISO7/Ko" )) +;; EGG specific setup +(define-egg-environment 'korean + "Korean settings for egg" + (lambda () + (when (not (featurep 'egg-kor)) + (load "its-hangul") + (setq its:*standard-modes* + (cons (its:get-mode-map "hangul") its:*standard-modes*)) + (provide 'egg-kor)) + (setq wnn-server-type 'kserver) + (setq egg-default-startup-file "eggrc-wnn") + (setq-default its:*current-map* (its:get-mode-map "hangul")))) + (define-language-environment 'korean "Korean" (lambda () @@ -110,6 +115,6 @@ (cons (its:get-mode-map "hangul") its:*standard-modes*))) (setq-default its:*current-map* (its:get-mode-map "hangul"))) -; (setq-default quail-current-package -; (assoc "hangul" quail-package-alist)))) + (setq-default quail-current-package + (assoc "hangul" quail-package-alist)) ))
--- a/lisp/mule/mule-files.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/mule/mule-files.el Mon Aug 13 09:31:46 2007 +0200 @@ -41,7 +41,13 @@ (setq-default buffer-file-coding-system 'iso-2022-8) (put 'buffer-file-coding-system 'permanent-local t) -(define-obsolete-variable-alias 'file-coding-system 'buffer-file-coding-system) +(define-obsolete-variable-alias + 'file-coding-system + 'buffer-file-coding-system) + +(define-obsolete-variable-alias + 'overriding-file-coding-system + 'coding-system-for-read) (defvar buffer-file-coding-system-for-read 'automatic-conversion "Coding system used when reading a file.
--- a/lisp/mule/mule-keyboard.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/mule/mule-keyboard.el Mon Aug 13 09:31:46 2007 +0200 @@ -93,6 +93,10 @@ (self-insert-internal char) (check-auto-fill)) +;; ### I think this is the right function to put this on... must check further +;; wire us into pending-delete +(put 'keyboard-self-insert-do-insert 'pending-delete t) + (defun keyboard-use-local-map-do-insert (map) (use-local-map map))
--- a/lisp/mule/mule-misc.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/mule/mule-misc.el Mon Aug 13 09:31:46 2007 +0200 @@ -1,4 +1,4 @@ -;;; mule-misc.el --- Miscellaneous Mule functions. +;; mule-misc.el --- Miscellaneous Mule functions. ;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc. ;; Copyright (C) 1995 Amdahl Corporation. @@ -265,7 +265,12 @@ (let ((func (get env 'set-lang-environ))) (if (not (null func)) (funcall func))) - (setq current-language-environment env)) + (setq current-language-environment env) + (if (fboundp 'egg) + (egg-lang-switch-callback)) +;; (if (fboundp 'quail) +;; (quail-lang-switch-callback)) +) (defun define-language-environment (env-sym doc-string enable-function) "Define a new language environment, named by ENV-SYM. @@ -275,3 +280,20 @@ (put env-sym 'lang-environ-doc-string doc-string) (put env-sym 'set-lang-environ enable-function) (setq language-environment-list (cons env-sym language-environment-list))) + +(defun define-egg-environment (env-sym doc-string enable-function) + "Define a new language environment for egg, named by ENV-SYM. +DOC-STRING should be a string describing the environment. +ENABLE-FUNCTION should be a function of no arguments that will be called +when the language environment is made current." + (put env-sym 'egg-environ-doc-string doc-string) + (put env-sym 'set-egg-environ enable-function)) + +(defun define-quail-environment (env-sym doc-string enable-function) + "Define a new language environment for quail, named by ENV-SYM. +DOC-STRING should be a string describing the environment. +ENABLE-FUNCTION should be a function of no arguments that will be called +when the language environment is made current." + (put env-sym 'quail-environ-doc-string doc-string) + (put env-sym 'set-quail-environ enable-function)) +
--- a/lisp/mule/thai-hooks.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/mule/thai-hooks.el Mon Aug 13 09:31:46 2007 +0200 @@ -49,12 +49,13 @@ pre-write-conversion decompose-region )) -(add-hook 'quail-package-alist '("thai" "quail/thai")) +(add-hook 'quail-package-alist '("thai" "quail-thai")) (define-language-environment 'thai "Thai" (lambda () (set-coding-category-system 'iso-8-designate 'tis620) (set-coding-priority-list '(iso-8-designate iso-8-1)) - (set-default-buffer-file-coding-system 'tis620))) - ;;(setq-default quail-current-package (assoc "thai" quail-package-alist)))) + (set-default-buffer-file-coding-system 'tis620) + (setq-default quail-current-package (assoc "thai" quail-package-alist)) + ))
--- a/lisp/mule/vietnamese-hooks-2.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/mule/vietnamese-hooks-2.el Mon Aug 13 09:31:46 2007 +0200 @@ -35,22 +35,22 @@ (loop (write-read-repeat r0 - [ 0 1 ?,2F(B 3 4 ?,2G(B ?,2g(B 7 8 9 10 11 12 13 14 15 - 16 17 18 19 ?,2V(B 21 22 23 24 ?,2[(B 26 27 28 29 ?,2\(B 31 + [ 0 1 ?-2Æ 3 4 ?Ç ?ç 7 8 9 10 11 12 13 14 15-A + 16 17 18 19 ?-2Ö 21 22 23 24 ?Û 26 27 28 29 ?Ü 31-A 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 - ?,2U(B ?,2!(B ?,2"(B ?,2#(B ?,2$(B ?,2%(B ?,2&(B ?,2'(B ?,2((B ?,2)(B ?,2*(B ?,2+(B ?,2,(B ?,2-(B ?,2.(B ?,2/(B - ?,20(B ?,21(B ?,22(B ?,25(B ?,2~(B ?,2>(B ?,26(B ?,27(B ?,28(B ?,2v(B ?,2w(B ?,2o(B ?,2|(B ?,2{(B ?,2x(B ?,2O(B - ?,2u(B ?,1!(B ?,1"(B ?,1#(B ?,1$(B ?,1%(B ?,1&(B ?,1'(B ?,1((B ?,1)(B ?,1*(B ?,1+(B ?,1,(B ?,1-(B ?,1.(B ?,1/(B - ?,10(B ?,11(B ?,12(B ?,2^(B ?,2=(B ?,15(B ?,16(B ?,17(B ?,18(B ?,2q(B ?,2Q(B ?,2W(B ?,2X(B ?,1=(B ?,1>(B ?,2_(B - ?,2`(B ?,2a(B ?,2b(B ?,2c(B ?,2d(B ?,2e(B ?,1F(B ?,1G(B ?,2h(B ?,2i(B ?,2j(B ?,2k(B ?,2l(B ?,2m(B ?,2n(B ?,1O(B - ?,2p(B ?,1Q(B ?,2r(B ?,2s(B ?,2t(B ?,1U(B ?,1V(B ?,1W(B ?,1X(B ?,2y(B ?,2z(B ?,1[(B ?,1\(B ?,2}(B ?,1^(B ?,1_(B - ?,1`(B ?,1a(B ?,1b(B ?,1c(B ?,1d(B ?,1e(B ?,1f(B ?,1g(B ?,1h(B ?,1i(B ?,1j(B ?,1k(B ?,1l(B ?,1m(B ?,1n(B ?,1o(B - ?,1p(B ?,1q(B ?,1r(B ?,1s(B ?,1t(B ?,1u(B ?,1v(B ?,1w(B ?,1x(B ?,1y(B ?,1z(B ?,1{(B ?,1|(B ?,1}(B ?,1~(B ?,2f(B ])))) + ?-2Ơ ?¡ ?¢ ?£ ?¤ ?¥ ?¦ ?§ ?¨ ?© ?ª ?« ?¬ ? ?® ?¯-A + ?-2° ?± ?² ?µ ?₫ ?¾ ?¶ ?· ?¸ ?ö ?÷ ?ï ?ü ?û ?ø ?Ï-A + ?-2ơ ?-1¡ ?¢ ?£ ?¤ ?¥ ?¦ ?§ ?¨ ?© ?ª ?« ?¬ ? ?® ?¯-A + ?-1° ?± ?² ?-2̃ ?½ ?-1µ ?¶ ?· ?¸ ?-2ñ ?Ñ ?× ?Ø ?-1½ ?¾ ?-2ß-A + ?-2à ?á ?â ?ă ?ä ?å ?-1Æ ?Ç ?-2è ?é ?ê ?ë ?́ ?í ?î ?-1Ï-A + ?-2đ ?-1Ñ ?-2̣ ?ó ?ô ?-1Ơ ?Ö ?× ?Ø ?-2ù ?ú ?-1Û ?Ü ?-2ư ?-1̃ ?ß-A + ?-1à ?á ?â ?ă ?ä ?å ?æ ?ç ?è ?é ?ê ?ë ?́ ?í ?î ?ï-A + ?-1đ ?ñ ?̣ ?ó ?ô ?ơ ?ö ?÷ ?ø ?ù ?ú ?û ?ü ?ư ?₫ ?-2æ ]))))-A "CCL program to read VISCII 1.1") (define-ccl-program ccl-write-viscii @@ -106,22 +106,22 @@ '(((read r0) (loop (write-read-repeat r0 - [0 ?,2z(B ?,2x(B 3 ?,2W(B ?,2X(B ?,2f(B 7 8 9 10 11 12 13 14 15 - 16 ?,2Q(B ?,2_(B ?,2O(B ?,2V(B ?,2[(B ?,2}(B ?,2\(B 24 25 26 27 28 29 30 31 + [0 ?-2ú ?ø 3 ?× ?Ø ?æ 7 8 9 10 11 12 13 14 15-A + 16 ?-2Ñ ?ß ?Ï ?Ö ?Û ?ư ?Ü 24 25 26 27 28 29 30 31-A 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 - ?,2`(B ?,2d(B ?,2c(B ?,2a(B ?,2U(B ?,2#(B ?,2'(B ?,2h(B ?,2k(B ?,2((B ?,2i(B ?,2)(B ?,2.(B ?,2l(B ?,2o(B ?,2n(B - ?,2m(B ?,28(B ?,2r(B ?,2v(B ?,2u(B ?,2s(B ?,2w(B ?,25(B ?,26(B ?,27(B ?,2^(B ?,2>(B ?,2~(B ?,2y(B ?,2|(B ?,2{(B - 160 ?,2e(B ?,2b(B ?,2j(B ?,2t(B ?,2=(B ?,2_(B ?,2p(B ?,1e(B ?,1b(B ?,1j(B ?,1t(B ?,1>(B ?,1y(B ?,1p(B ?,2"(B - 192 193 194 195 196 ?,1`(B ?,1d(B ?,1c(B ?,1a(B ?,1U(B ?,2F(B ?,1"(B ?,1F(B ?,1G(B ?,1!(B ?,2G(B - ?,2!(B ?,2%(B ?,2&(B ?,2g(B ?,2%(B ?,2+(B ?,1#(B ?,1%(B ?,1&(B ?,1g(B ?,1$(B ?,1'(B ?,1h(B ?,2,(B ?,1k(B ?,1((B - ?,1i(B ?,1)(B ?,1+(B ?,1,(B ?,1-(B ?,1*(B ?,1.(B ?,1l(B ?,1o(B ?,2-(B ?,2*(B ?,20(B ?,1n(B ?,1m(B ?,18(B ?,1r(B - ?,21(B ?,1v(B ?,1u(B ?,1s(B ?,1w(B ?,10(B ?,11(B ?,12(B ?,1/(B ?,15(B ?,16(B ?,17(B ?,1^(B ?,1>(B ?,1~(B ?,1y(B - ?,22(B ?,1|(B ?,1{(B ?,1z(B ?,1x(B ?,1W(B ?,1X(B ?,1f(B ?,1Q(B ?,1q(B ?,1O(B ?,1V(B ?,1[(B ?,1}(B ?,1\(B ?,2/(B])))) + ?-2à ?ä ?ă ?á ?Ơ ?£ ?§ ?è ?ë ?¨ ?é ?© ?® ?́ ?ï ?î-A + ?-2í ?¸ ?̣ ?ö ?ơ ?ó ?÷ ?µ ?¶ ?· ?̃ ?¾ ?₫ ?ù ?ü ?û-A + 160 ?-2å ?â ?ê ?ô ?½ ?ß ?đ ?-1å ?â ?ê ?ô ?¾ ?ù ?đ ?-2¢-A + 192 193 194 195 196 ?-1à ?ä ?ă ?á ?Ơ ?-2Æ ?-1¢ ?Æ ?Ç ?¡ ?-2Ç-A + ?-2¡ ?¥ ?¦ ?ç ?¥ ?« ?-1£ ?¥ ?¦ ?ç ?¤ ?§ ?è ?-2¬ ?-1ë ?¨-A + ?-1é ?© ?« ?¬ ? ?ª ?® ?́ ?ï ?-2 ?ª ?° ?-1î ?í ?¸ ?̣-A + ?-2± ?-1ö ?ơ ?ó ?÷ ?° ?± ?² ?¯ ?µ ?¶ ?· ?̃ ?¾ ?₫ ?ù-A + ?-2² ?-1ü ?û ?ú ?ø ?× ?Ø ?æ ?Ñ ?ñ ?Ï ?Ö ?Û ?ư ?Ü ?-2¯]))))-A "CCL program to read VSCII-1.") (define-ccl-program ccl-write-vscii @@ -256,7 +256,7 @@ ;; (set-charset-ccl-program 'vietnamese-lower ccl-vietnamese-lower-to-vscii) ;; (set-charset-ccl-program 'vietnamese-upper ccl-vietnamese-upper-to-vscii) -(add-hook 'quail-package-alist '("viqr" "quail/viet")) +(add-hook 'quail-package-alist '("viqr" "quail-viet")) (define-language-environment 'vietnamese "Vietnamese"
--- a/lisp/mule/visual-mode.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/mule/visual-mode.el Mon Aug 13 09:31:46 2007 +0200 @@ -305,7 +305,7 @@ (defvar *visual-punctuations* '(? ?. ?, ?: ?; ?? ?! ?- ?_ ?' ?\" ?/ ?( ?) ?[ ?] ?{ ?} ?\n ?\t ; ASCII ? ?. ?, ?: ?; ?? ?! ?- ?_ ?' ?" ?( ?) ?[ ?] ; Hebrew - ?[2](3[0](B ?[2](3"[0](B ?[2](3'[0](B ?[2](3([0](B ?[2](3#[0](B ?[2](3$[0](B ?[2](3*[0](B ?[2](3+[0](B )) ; Arabic + ?›2](3!›0](B ?›2](3&›0](B ?›2](3%›0](B ?›2](3)›0](B ?›2](3"›0](B ?›2](3'›0](B ?›2](3(›0](B ?›2](3#›0](B ?›2](3$›0](B ?›2](3*›0](B ?›2](3+›0](B )) ; Arabic (defun visual-forward-word (arg) "Move the cursor visually forward by ARG (integer) words. @@ -535,6 +535,9 @@ (if display-direction (visual-backward-char arg))) +;; wire us into pending-delete +(put 'visual-self-insert-command 'pending-delete t) + (defun visual-newline (arg) "newline command for visual-mode. With ARG (integer), insert that many newlines."
--- a/lisp/packages/balloon-help.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/packages/balloon-help.el Mon Aug 13 09:31:46 2007 +0200 @@ -1,4 +1,4 @@ -;;; Balloon help for XEmacs (requires 19.12 or later) +;;; Balloon help for XEmacs (requires 19.15 or later) ;;; Copyright (C) 1995, 1997 Kyle E. Jones ;;; ;;; This program is free software; you can redistribute it and/or modify @@ -28,63 +28,77 @@ ;; following line to your .emacs: ;; ;; (require 'balloon-help) +;; (balloon-help-mode 1) ;; -;; For 19.12 users: -;; If you are using fvwm, [tv]twm or ol[v]wm, you can also add -;; the following lines to various configuration file to use -;; minimal decorations on the balloon help frames. -;; -;; In .emacs: -;; (setq balloon-help-frame-name "balloon-help") +;; The balloon-help frame is a transient window that is not +;; normally decorated by window managers, so the following +;; window manager directives may not be needed. But if they +;; are: ;; -;; For ol[v]wm use this in .Xdefaults: -;; olvwm.NoDecor: balloon-help -;; or -;; olwm.MinimalDecor: balloon-help +;; For ol[v]wm use this in .Xdefaults: +;; olvwm.NoDecor: balloon-help +;; or +;; olwm.MinimalDecor: balloon-help ;; -;; For fvvm use this in your .fvwmrc: -;; NoTitle balloon-help -;; or -;; Style "balloon-help" NoTitle, NoHandles, BorderWidth 0 +;; For fvvm version 1 use this in your .fvwmrc: +;; NoTitle balloon-help +;; or +;; Style "balloon-help" NoTitle, NoHandles, BorderWidth 0 ;; -;; For twm use this in your .twmrc: -;; NoTitle { "balloon-help" } -;; -;; Under 19.13 and later versions the balloon-help frame uses a -;; transient window that is not normally decorated by window -;; managers. So the window manager directives should not be -;; needed for XEmacs 19.13 and beyond. +;; For twm use this in your .twmrc: +;; NoTitle { "balloon-help" } +;; (provide 'balloon-help) -(defvar balloon-help-version "1.05" +(require 'custom) + +(defgroup balloon-help nil + "Balloon-help support in XEmacs" + :group 'frames) + +(defvar balloon-help-version "1.06" "Version string for Balloon Help.") -(defvar balloon-help-mode t +(defvar balloon-help-mode nil "*Non-nil means Balloon help mode is enabled.") -(defvar balloon-help-timeout 1500 - "*Display help after this many milliseconds of mouse inactivity.") +(defcustom balloon-help-timeout 1500 + "*Display help after this many milliseconds of mouse inactivity." + :type 'integer + :group 'balloon-help) -(defvar balloon-help-foreground "black" - "*The foreground color for displaying balloon help text.") +(defcustom balloon-help-foreground "black" + "*The foreground color for displaying balloon help text." + :type 'string + :group 'balloon-help) -(defvar balloon-help-background "rgb:c0/c0/c0" - "*The background color for the balloon help frame.") +(defcustom balloon-help-background "gray80" + "*The background color for the balloon help frame." + :type 'string + :group 'balloon-help) -(defvar balloon-help-background-pixmap "" - "*The background pixmap for the balloon help frame.") +(defcustom balloon-help-background-pixmap "" + "*The background pixmap for the balloon help frame." + :type 'string + :group 'balloon-help) -(defvar balloon-help-font "fixed" - "*The font for displaying balloon help text.") +(defcustom balloon-help-font "variable" + "*The font for displaying balloon help text." + :type 'string + :group 'balloon-help) -(defvar balloon-help-border-color "black" - "*The color for displaying balloon help frame's border.") +(defcustom balloon-help-border-color "black" + "*The color for displaying balloon help frame's border." + :type 'string + :group 'balloon-help) -(defvar balloon-help-border-width 2 - "*The width of the balloon help frame's border.") +(defcustom balloon-help-border-width 1 + "*The width of the balloon help frame's border." + :type 'integer + :group 'balloon-help) -(defvar balloon-help-use-sound nil +(defcustom balloon-help-use-sound nil "*Non-nil value means play a sound to herald the appearance and disappearance of the help frame. @@ -92,14 +106,20 @@ `balloon-help-disappears' will be played when the frame disappears. See the documentation for the function load-sound-file to see how -define sounds.") +define sounds." + :type 'boolean + :group 'balloon-help) -(defvar balloon-help-frame-name nil - "*The frame name to use for the frame to display the balloon help.") +(defcustom balloon-help-frame-name "balloon-help" + "*The frame name to use for the frame to display the balloon help." + :type 'string + :group 'balloon-help) -(defvar balloon-help-aggressively-follow-mouse nil +(defcustom balloon-help-aggressively-follow-mouse nil "*Non-nil means the balloon should move with the mouse even if the mouse -is over the same object as the last mouse motion event.") +is over the same object as the last mouse motion event." + :type 'boolean + :group 'balloon-help) ;;; ;;; End of user variables. @@ -107,7 +127,9 @@ (defvar mouse-motion-hook mouse-motion-handler "Hooks to be run whenever the user moves the mouse. -Each hook is called with one argument, the mouse motion event.") +Each hook is called with one argument, the mouse motion event. +This hooks variable does not exist unless the \"balloon-help\" library +has been loaded.") (defun mouse-motion-hook (event) "Run the hooks attached to mouse-motion-hook." @@ -118,6 +140,9 @@ (defvar balloon-help-frame nil "Balloon help is displayed in this frame.") +(defvar balloon-help-junk-frame nil + "Junk parent frame of balloon-help-frame.") + (defvar balloon-help-help-object nil "Object that the mouse is over that has a help property, nil otherwise.") @@ -127,7 +152,7 @@ (defvar balloon-help-help-object-y nil "Last vertical mouse position over balloon-help-help-object.") -(defvar balloon-help-buffer nil +(defvar balloon-help-buffer (get-buffer-create " *balloon-help*") "Buffer used to display balloon help.") (defvar balloon-help-timeout-id nil @@ -166,22 +191,32 @@ (defun balloon-help-displayed () (and (frame-live-p balloon-help-frame) - (frame-visible-p balloon-help-frame))) + (frame-visible-p balloon-help-frame) + (eq (frame-device balloon-help-frame) (selected-device)))) + +(defun balloon-help (&optional event) + "Display Balloon Help for the object under EVENT. +If EVENT is nil, then point in the selected window is used instead. +See the documentation for balloon-help-mode to find out what this means. +This command must be bound to a mouse event." + (interactive "e") + (unless (device-on-window-system-p) + (error "Cannot display balloon help on %s device" (device-type))) + (let ((balloon-help-mode t)) + (balloon-help-motion-hook event)) + (when balloon-help-timeout-id + (disable-timeout balloon-help-timeout-id) + (setq balloon-help-timeout-id nil)) + (balloon-help-display-help)) (defun balloon-help-motion-hook (event) (cond ((null balloon-help-mode) t) - ((button-press-event-p event) - (setq balloon-help-help-object nil) - (if balloon-help-timeout-id - (disable-timeout balloon-help-timeout-id)) - (if (balloon-help-displayed) - (balloon-help-undisplay-help))) (t - (let* ((buffer (event-buffer event)) - (frame (event-frame event)) - (point (and buffer (event-point event))) - (modeline-point (and buffer (event-modeline-position event))) + (let* ((buffer (if event (event-buffer event) (current-buffer))) + (frame (if event (event-frame event) (selected-frame))) + (point (if event (event-point event) (point))) + (modeline-point (if event (event-modeline-position event))) (modeline-extent (and modeline-point (map-extents (function (lambda (e ignored) e)) @@ -191,14 +226,14 @@ modeline-point modeline-point nil nil 'balloon-help))) - (glyph-extent (event-glyph-extent event)) + (glyph-extent (and event (event-glyph-extent event))) (glyph-extent (if (and glyph-extent (extent-property glyph-extent 'balloon-help)) glyph-extent)) (extent (and point (extent-at point buffer 'balloon-help))) - (button (event-toolbar-button event)) + (button (and event (event-toolbar-button event))) (button (if (and button (toolbar-button-help-string button)) button nil)) @@ -209,8 +244,9 @@ (not (eq frame balloon-help-frame))) (progn (setq balloon-help-help-object nil) - (if id - (disable-timeout id)) + (when id + (disable-timeout id) + (setq balloon-help-timeout-id nil)) (if (balloon-help-displayed) (balloon-help-undisplay-help)))) (let* ((params (frame-parameters frame)) @@ -232,10 +268,15 @@ (save-excursion (set-buffer buffer) current-menubar)) 22 0))) (setq balloon-help-help-object-x - (+ left xleft-toolbar-width (event-x-pixel event)) + (if event + (+ left xleft-toolbar-width + (event-x-pixel event)) + (/ (* (device-pixel-width) 2) 5)) balloon-help-help-object-y - (+ top xtop-toolbar-height menubar-height - (event-y-pixel event)))) + (if event + (+ top xtop-toolbar-height menubar-height + (event-y-pixel event)) + (/ (* (device-pixel-height) 2) 5)))) (cond ((eq frame balloon-help-frame) t) ((eq object balloon-help-help-object) (if (and (balloon-help-displayed) @@ -253,18 +294,9 @@ (function balloon-help-display-help) nil))))))))) -(defun balloon-help-pre-command-hook (&rest ignored) - (setq balloon-help-help-object nil) - (if (balloon-help-displayed) - (balloon-help-undisplay-help))) - -(fset 'balloon-help-post-command-hook 'balloon-help-pre-command-hook) -(fset 'balloon-help-mouse-leave-frame-hook 'balloon-help-pre-command-hook) -(fset 'balloon-help-deselect-frame-hook 'balloon-help-pre-command-hook) - (defun balloon-help-display-help (&rest ignored) (setq balloon-help-timeout-id nil) - (if balloon-help-help-object + (if (and balloon-help-help-object (device-on-window-system-p)) (let* ((object balloon-help-help-object) (help (or (and (extent-live-p object) (extent-property object 'balloon-help)) @@ -281,38 +313,33 @@ (setq help (format "help function signaled: %S" data))))) (if (stringp help) (save-excursion - (if (not (bufferp balloon-help-buffer)) - (setq balloon-help-buffer - (get-buffer-create " *balloon-help*"))) - (if (not (frame-live-p balloon-help-frame)) + (if (or (not (frame-live-p balloon-help-frame)) + (not (eq (selected-device) + (frame-device balloon-help-frame)))) (setq balloon-help-frame (balloon-help-make-help-frame))) (set-buffer balloon-help-buffer) (erase-buffer) (insert help) (if (not (bolp)) (insert ?\n)) - ;; help strings longer than 2 lines have the last - ;; line stolen by the minibuffer, so make sure the - ;; last line is blank. Make the top line blank for - ;; some symmetry. - (if (< 2 (count-lines (point-min) (point-max))) - (progn - (insert ?\n) - ;; add a second blank line at the end to - ;; prevent the modeline bar from clipping the - ;; descenders of the last line of text. - (insert ?\n) - (goto-char (point-min)) - (insert ?\n))) - ;; cursor will be at point-min because we're just - ;; moving point which doesn't affect window-point - ;; when the window isn't selected. Indent - ;; everything so that the cursor will be over a - ;; space. The 1-pixel bar cursor will be - ;; completely invisible this way. +;;; ;; help strings longer than 2 lines have the last +;;; ;; line stolen by the minibuffer, so make sure the +;;; ;; last line is blank. Make the top line blank for +;;; ;; some symmetry. +;;; (if (< 2 (count-lines (point-min) (point-max))) +;;; (progn +;;; (insert ?\n) +;;; ;; add a second blank line at the end to +;;; ;; prevent the modeline bar from clipping the +;;; ;; descenders of the last line of text. +;;; (insert ?\n) +;;; (goto-char (point-min)) +;;; (insert ?\n))) + ;; indent everything by a space for readability (indent-rigidly (point-min) (point-max) 1) + (balloon-help-set-frame-properties) + (balloon-help-resize-help-frame) (balloon-help-move-help-frame) - (balloon-help-resize-help-frame) (balloon-help-expose-help-frame)))))) (defun balloon-help-undisplay-help () @@ -334,49 +361,123 @@ (play-sound 'balloon-help-appears)) (setq balloon-help-display-pending t)))) +(defun balloon-help-set-frame-properties () + (let ((frame balloon-help-frame)) + ;; don't set the font unconditionally because it makes the + ;; frame size flap visibly while XEmacs figures out the new + ;; frame size. + (if (not (equal (face-font 'default frame) balloon-help-font)) + (set-face-font 'default balloon-help-font frame)) + (set-face-foreground 'default balloon-help-foreground frame) + (set-face-background 'default balloon-help-background frame) + (set-face-background 'modeline balloon-help-background frame) + (set-face-background-pixmap 'default balloon-help-background-pixmap frame) + (set-frame-property frame 'border-color balloon-help-border-color) + (set-frame-property frame 'border-width balloon-help-border-width))) + +;;;(defun balloon-help-resize-help-frame () +;;; (save-excursion +;;; (set-buffer balloon-help-buffer) +;;; (let ((longest 0) +;;; (lines 0) +;;; (done nil) +;;; (window-min-height 1) +;;; (window-min-width 1)) +;;; (goto-char (point-min)) +;;; (while (not done) +;;; (end-of-line) +;;; (setq longest (max longest (current-column)) +;;; done (not (= 0 (forward-line)))) +;;; (and (not done) (setq lines (1+ lines)))) +;;; (set-frame-size balloon-help-frame (+ 1 longest) lines)))) + (defun balloon-help-resize-help-frame () (save-excursion (set-buffer balloon-help-buffer) - (let ((longest 0) - (lines 0) - (done nil) - (window-min-height 1) - (window-min-width 1)) + (let* ((longest 0) + (lines 0) + (done nil) + (inst (vector 'string ':data nil)) + (window (frame-selected-window balloon-help-frame)) + (font-width (font-width (face-font 'default) balloon-help-frame)) + start width + (window-min-height 1) + (window-min-width 1)) (goto-char (point-min)) (while (not done) + (setq start (point)) (end-of-line) - (setq longest (max longest (current-column)) + (aset inst 2 (buffer-substring start (point))) + (setq longest (max longest (glyph-width (make-glyph inst) window)) done (not (= 0 (forward-line)))) (and (not done) (setq lines (1+ lines)))) - (set-frame-size balloon-help-frame (+ 1 longest) lines)))) + (setq width (/ longest font-width) + width (if (> longest (* width font-width)) (1+ width) width)) + (set-frame-size balloon-help-frame (+ 0 width) lines)))) + +(defun balloon-help-compute-help-frame-y-location () + (let* ((device-bottom (device-pixel-height + (frame-device balloon-help-frame))) + (y-pos (max 0 (+ 48 balloon-help-help-object-y))) + (height (frame-pixel-height balloon-help-frame)) + (bottom (+ y-pos height))) + (if (>= bottom device-bottom) + (setq y-pos (max 0 (- y-pos (- bottom device-bottom))))) + y-pos )) + +(defun balloon-help-compute-help-frame-x-location () + (let* ((device-right (device-pixel-width (frame-device balloon-help-frame))) + (x-pos (max 0 (+ 32 balloon-help-help-object-x))) + (width (frame-pixel-width balloon-help-frame)) + (right (+ x-pos width))) + (if (>= right device-right) + (setq x-pos (max 0 (- x-pos (- right device-right))))) + x-pos )) + +(defun balloon-help-move-help-frame () + (let ((x (balloon-help-compute-help-frame-x-location)) + (y (balloon-help-compute-help-frame-y-location))) + (set-frame-position balloon-help-frame x y))) (defun balloon-help-make-junk-frame () (let ((window-min-height 1) (window-min-width 1)) - (save-excursion - (set-buffer (generate-new-buffer "*junk-frame-buffer*")) - (prog1 - (make-frame '(minibuffer t initially-unmapped t width 1 height 1)) - (rename-buffer " *junk-frame-buffer*" t))))) + (when (framep balloon-help-junk-frame) + (delete-frame balloon-help-junk-frame) + (setq balloon-help-junk-frame nil)) + (prog1 + (setq balloon-help-junk-frame + (make-frame '(minibuffer t + initially-unmapped t + width 1 + height 1))) + (set-window-buffer (frame-selected-window balloon-help-junk-frame) + balloon-help-buffer)))) (defun balloon-help-make-help-frame () + (when (framep balloon-help-frame) + (delete-frame balloon-help-frame) + (setq balloon-help-frame nil)) (save-excursion (set-buffer balloon-help-buffer) + (setq truncate-lines t) (set-buffer-menubar nil) (let* ((x (balloon-help-compute-help-frame-x-location)) (y (balloon-help-compute-help-frame-y-location)) (window-min-height 1) (window-min-width 1) + (junk-frame (balloon-help-make-junk-frame)) (frame (make-frame (list '(initially-unmapped . t) ;; try to evade frame decorations - (cons 'name (or balloon-help-frame-name - "xclock")) + (cons 'name balloon-help-frame-name) (cons 'border-width balloon-help-border-width) (cons 'border-color balloon-help-border-color) (cons 'top y) (cons 'left x) - (cons 'popup (balloon-help-make-junk-frame)) + (cons 'popup junk-frame) + (cons 'minibuffer + (minibuffer-window junk-frame)) '(width . 3) '(height . 1))))) (set-face-font 'default balloon-help-font frame) @@ -390,33 +491,43 @@ (set-specifier left-toolbar-width (cons frame 0)) (set-specifier right-toolbar-width (cons frame 0)) (set-specifier bottom-toolbar-height (cons frame 0)) + (set-specifier top-toolbar-visible-p (cons frame nil)) + (set-specifier left-toolbar-visible-p (cons frame nil)) + (set-specifier right-toolbar-visible-p (cons frame nil)) + (set-specifier bottom-toolbar-visible-p (cons frame nil)) (set-specifier top-toolbar (cons frame nil)) (set-specifier left-toolbar (cons frame nil)) (set-specifier right-toolbar (cons frame nil)) (set-specifier bottom-toolbar (cons frame nil)) (set-specifier scrollbar-width (cons frame 0)) (set-specifier scrollbar-height (cons frame 0)) - (and (boundp 'text-cursor-visible-p) - (specifierp text-cursor-visible-p) - (set-specifier text-cursor-visible-p (cons frame nil))) + (set-specifier text-cursor-visible-p (cons frame nil)) + (set-specifier has-modeline-p (cons frame nil)) (set-specifier modeline-shadow-thickness (cons frame 0)) + (set-specifier (glyph-image truncation-glyph) [nothing] frame '(x)) (set-face-background 'modeline balloon-help-background frame) frame ))) -(defun balloon-help-compute-help-frame-x-location () - (max 0 (+ 32 balloon-help-help-object-x))) +(defun balloon-help-pre-command-hook () + (unless (eq this-command 'balloon-help) + (balloon-help-go-away))) + +(defun balloon-help-go-away (&rest ignored) + (setq balloon-help-help-object nil) + (if (balloon-help-displayed) + (balloon-help-undisplay-help))) -(defun balloon-help-compute-help-frame-y-location () - (max 0 (+ 48 balloon-help-help-object-y))) +(defun balloon-help-mouse-leave-frame-hook (&rest ignored) + (let* ((mouse (mouse-position)) + (window (car mouse))) + (if (or (null window) (not (eq (window-frame window) balloon-help-frame))) + (balloon-help-go-away)))) -(defun balloon-help-move-help-frame () - (let ((x (balloon-help-compute-help-frame-x-location)) - (y (balloon-help-compute-help-frame-y-location))) - (set-frame-position balloon-help-frame x y))) +;; loses with ClickToFocus under fvwm +;;(fset 'balloon-help-deselect-frame-hook 'balloon-help-go-away) +;;(add-hook 'deselect-frame-hook 'balloon-help-deselect-frame-hook) (add-hook 'mouse-motion-hook 'balloon-help-motion-hook) + (add-hook 'pre-command-hook 'balloon-help-pre-command-hook) -(add-hook 'post-command-hook 'balloon-help-post-command-hook) (add-hook 'mouse-leave-frame-hook 'balloon-help-mouse-leave-frame-hook) -;; loses with ClickToFocus under fvwm -;;(add-hook 'deselect-frame-hook 'balloon-help-deselect-frame-hook)
--- a/lisp/prim/custom-load.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/prim/custom-load.el Mon Aug 13 09:31:46 2007 +0200 @@ -142,7 +142,7 @@ (put 'outl-mouse 'custom-loads '("outl-mouse")) (put 'gnus-treading 'custom-loads '("gnus-sum")) (put 'url-cache 'custom-loads '("url-cache" "url-vars")) -(put 'frames 'custom-loads '("rsz-minibuf" "ediff-wind" "desktop" "detached-minibuf")) +(put 'frames 'custom-loads '("rsz-minibuf" "ediff-wind" "balloon-help" "desktop" "detached-minibuf")) (put 'psgml-html 'custom-loads '("psgml-html")) (put 'nnmail 'custom-loads '("nnmail")) (put 'gnus-article-hiding 'custom-loads '("gnus-art" "gnus-sum")) @@ -217,12 +217,13 @@ (put 'gnus-summary-format 'custom-loads '("gnus-sum")) (put 'gnus-score-decay 'custom-loads '("gnus-score")) (put 'fill 'custom-loads '()) +(put 'balloon-help 'custom-loads '("balloon-help")) (put 'gnus-extract-post 'custom-loads '("gnus-uu")) (put 'debug 'custom-loads '()) (put 'supercite-hooks 'custom-loads '("supercite")) (put 'display 'custom-loads '()) (put 'texinfo-tex 'custom-loads '("texnfo-tex")) -(put 'faces 'custom-loads '("cus-edit" "wid-edit" "gnus" "message" "fast-lock" "ps-print" "highlight-headers")) +(put 'faces 'custom-loads '("cus-edit" "wid-edit" "gnus" "message" "fast-lock" "ps-print" "highlight-headers" "font")) (put 'passwd 'custom-loads '("passwd")) (put 'pages 'custom-loads '("page-ext")) (put 'diary 'custom-loads '("calendar"))
--- a/lisp/prim/sound.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/prim/sound.el Mon Aug 13 09:31:46 2007 +0200 @@ -128,11 +128,15 @@ (interactive "fSound file name: \n\ SSymbol to name this sound: \n\ 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")) + (unless (symbolp sound-name) + (error "sound-name not a symbol")) + (unless (null volume) + (integerp volume) (error "volume not an integer or nil")) (let (buf data (file (locate-file filename default-sound-directory-list sound-ext))) + (unless file + (error "Couldn't load sound file %s" filename)) (unwind-protect (save-excursion (set-buffer (setq buf (get-buffer-create " *sound-tmp*")))
--- a/lisp/quail/quail.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/quail/quail.el Mon Aug 13 09:31:46 2007 +0200 @@ -33,6 +33,7 @@ ;; string, you can input any text from ASCII keyboard. (require 'mule) +(require 'visual-mode) ;;;###autoload (defconst quail-version "2.2") @@ -61,9 +62,9 @@ (make-variable-buffer-local 'quail-keep-state) (defvar quail-mode-string nil) (make-variable-buffer-local 'quail-mode-string) -(defvar quail-overlay nil +(defvar quail-extent nil "Overlay which covers quail zone.") -(make-variable-buffer-local 'quail-overlay) +(make-variable-buffer-local 'quail-extent) (defvar quail-current-key nil "Within Quail mode, a key string typed so far.") (make-variable-buffer-local 'quail-current-key) @@ -465,8 +466,8 @@ (setq quail-mode t quail-mode-string prompt) (erase-buffer) - (or (overlayp quail-overlay) - (setq quail-overlay (make-overlay 1 1))) + (or (extentp quail-extent) + (setq quail-extent (make-extent 1 1))) (set-buffer curbuf)) (cond ((get-buffer-window quail-guidance-buf) ;; `buf' is already shown in some window. @@ -504,10 +505,10 @@ (setq mode-line-format (cons '(quail-mode (mc-flag ("[" quail-mode-string "]"))) mode-line-format))) - (if (null (overlayp quail-overlay)) + (if (null (extentp quail-extent)) (progn - (setq quail-overlay (make-overlay (point) (point))) - (overlay-put quail-overlay 'face quail-region-face))) + (setq quail-extent (make-extent (point) (point))) + (set-extent-face quail-extent 'face quail-region-face))) (make-local-hook 'post-command-hook) (add-hook 'post-command-hook 'quail-reset-state nil t) (setq quail-keep-state nil) @@ -536,7 +537,7 @@ (defun quail-exit-mode () (interactive) (kill-local-variable 'post-command-hook) - (delete-overlay quail-overlay) + (delete-extent quail-extent) (quail-delete-guidance-buf) (let ((modes (quail-extra-mode-list)) (i 0)) @@ -562,23 +563,23 @@ (quail-init-state)))) (defun quail-init-state () - (if (overlayp quail-overlay) - (move-overlay quail-overlay (point) (point)) - (setq quail-overlay (make-overlay (point) (point)))) + (if (extentp quail-extent) + (set-extent-endpoints quail-extent (point) (point)) + (setq quail-extent (make-extent (point) (point)))) (setq quail-current-key nil quail-current-str nil) (if quail-sub-mode (quail-exit-sub-mode)) (quail-setup-guidance-buf)) (defun quail-check-state () - (if (and (overlay-buffer quail-overlay) - (= (point) (overlay-end quail-overlay))) + (if (and (extent-object quail-extent) + (= (point) (extent-end-position quail-extent))) quail-current-key (quail-init-state) nil)) (defun quail-delete-region () - (delete-region (overlay-start quail-overlay) (overlay-end quail-overlay))) + (delete-region (extent-start-position quail-extent) (extent-end-position quail-extent))) (defun quail-insert (str) (quail-delete-region) @@ -593,7 +594,7 @@ (if (and auto-fill-function (> (current-column) fill-column)) (run-hooks 'auto-fill-function)) (let ((len (if (integerp str) (char-bytes str) (length str)))) - (move-overlay quail-overlay (- (point) len) (point))) + (set-extent-endpoints quail-extent (- (point) len) (point))) (quail-show-guidance)) (defun quail-get-candidates (def) @@ -659,9 +660,9 @@ (goto-char (point-min)) (if (search-forward (concat " " key ":") nil t) (if (and str (search-forward (concat "." str) nil t)) - (move-overlay quail-overlay (1+ (match-beginning 0)) (point)) - (move-overlay quail-overlay (match-beginning 0) (point))) - (move-overlay quail-overlay 1 1)) + (set-extent-endpoints quail-extent (1+ (match-beginning 0)) (point)) + (set-extent-endpoints quail-extent (match-beginning 0) (point))) + (set-extent-endpoints quail-extent 1 1)) (select-window (get-buffer-window buf)) ))) @@ -751,6 +752,9 @@ (quail-enter-sub-mode)) ) +;; wire us into pending-delete +(put 'quail-self-insert-command 'pending-delete t) + (defun quail-next-candidate () "Select next candidate." (interactive) @@ -862,7 +866,7 @@ (let ((idx (car candidates)) (maxidx (1+ (/ (1- (length (cdr candidates))) 10))) (num 0) - p p1 p2 str) + p p1 p2) (indent-to 10) (insert (format "(%d/%d)" (1+ (/ idx 10)) maxidx)) (setq candidates (nthcdr (* (/ idx 10) 10) (cdr candidates))) @@ -908,8 +912,8 @@ (get-buffer-create "*Completions*"))) (set-buffer quail-completion-buf) (erase-buffer) - (setq quail-overlay (make-overlay 1 1)) - (overlay-put quail-overlay 'face quail-selection-face) + (setq quail-extent (make-extent 1 1)) + (set-extent-face quail-extent 'face quail-selection-face) (insert "Current candidates:\n") (quail-completion-list key def 1) (quail-display-buffer (current-buffer))) @@ -937,8 +941,7 @@ (defun quail-candidate-with-indent (candidates key) (if (consp candidates) (let ((clm (current-column)) - (i 0) - num) + (i 0)) (while candidates (if (= (% i 10) 0) (insert (format "(%d)" (1+ (/ i 10))))) (insert " " (if (= (% i 10) 9) "0" (+ ?1 (% i 10))) ".")
--- a/lisp/rmail/rmail.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/rmail/rmail.el Mon Aug 13 09:31:46 2007 +0200 @@ -842,6 +842,7 @@ ;; #### BOGUS! Run a hook here instead and let time.el do it. (and (boundp 'display-time-string) display-time-string + (stringp display-time-string) (string-match " Mail" display-time-string) (setq display-time-string (concat
--- a/lisp/utils/lib-complete.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/utils/lib-complete.el Mon Aug 13 09:31:46 2007 +0200 @@ -1,17 +1,11 @@ -;; ======================================================================== -;; lib-complete.el -- Completion on a search path -;; Author : Mike Williams <mike-w@cs.aukuni.ac.nz> -;; Created On : Sat Apr 20 17:47:21 1991 -;; Last Modified By: Heiko M|nkel <muenkel@tnt.uni-hannover.de> -;; Additional XEmacs integration By: Chuck Thompson <cthomp@cs.uiuc.edu> -;; Last Modified On: Thu Jul 1 14:23:00 1994 -;; RCS Info : $Revision: 1.1.1.1 $ $Locker: $ -;; ======================================================================== -;; NOTE: this file must be recompiled if changed. -;; +;;; lib-complete.el --- Completion on the lisp search path + ;; Copyright (C) Mike Williams <mike-w@cs.aukuni.ac.nz> 1991 -;; -;; Keywords: utility, lisp + +;; Author: Mike Williams <mike-w@cs.aukuni.ac.nz> +;; Maintainer: +;; Keywords: lisp, extensions +;; Created: Sat Apr 20 17:47:21 1991 ;; This file is part of XEmacs. @@ -32,6 +26,23 @@ ;;; Synched up with: Not in FSF. +;;; Commentary: + +;; ======================================================================== +;; lib-complete.el -- Completion on a search path +;; Author : Mike Williams <mike-w@cs.aukuni.ac.nz> +;; Created On : Sat Apr 20 17:47:21 1991 +;; Last Modified By: Heiko M|nkel <muenkel@tnt.uni-hannover.de> +;; Additional XEmacs integration By: Chuck Thompson <cthomp@cs.uiuc.edu> +;; Last Modified On: Thu Jul 1 14:23:00 1994 +;; RCS Info : $Revision: 1.2 $ $Locker: $ +;; ======================================================================== +;; NOTE: XEmacs must be redumped if this file is changed. +;; +;; Copyright (C) Mike Williams <mike-w@cs.aukuni.ac.nz> 1991 +;; +;; Keywords: utility, lisp + ;; Many thanks to Hallvard Furuseth <hallvard@ifi.uio.no> for his ;; helpful suggestions. @@ -40,7 +51,11 @@ ;; There is now the new function find-library in this package. -(provide 'lib-complete) +;;; ChangeLog: + +;; 4/26/97: sb Mule-ize. + +;;; Code: ;;=== Usage =============================================================== ;; @@ -307,27 +322,46 @@ ;;=== find-library with completion (Author: Heiko Muenkel) =================== -(defun find-library (library) +(defun find-library (library &optional codesys) "Find and edit the source for the library named LIBRARY. -The extension of the LIBRARY must be omitted." +The extension of the LIBRARY must be omitted. +Under XEmacs/Mule, the optional second argument specifies the +coding system to use when decoding the file. Interactively, +with a prefix argument, you will be prompted for the coding system." (interactive - (list - (get-library-path))) - (find-file library)) + (list (get-library-path) + (if current-prefix-arg + (read-coding-system "Coding System: ")))) + (find-file library codesys)) -(defun find-library-other-window (library) - "Load the library named LIBRARY in another window." +(defun find-library-other-window (library &optional codesys) + "Load the library named LIBRARY in another window. +Under XEmacs/Mule, the optional second argument specifies the +coding system to use when decoding the file. Interactively, +with a prefix argument, you will be prompted for the coding system." (interactive - (list (get-library-path))) - (find-file-other-window library)) + (list (get-library-path) + (if current-prefix-arg + (read-coding-system "Coding System: ")))) + (find-file-other-window library codesys)) -(defun find-library-other-frame (library) - "Load the library named LIBRARY in a newly-created frame." +(defun find-library-other-frame (library &optional codesys) + "Load the library named LIBRARY in a newly-created frame. +Under XEmacs/Mule, the optional second argument specifies the +coding system to use when decoding the file. Interactively, +with a prefix argument, you will be prompted for the coding system." (interactive - (list (get-library-path))) - (find-file-other-frame library)) + (list (get-library-path) + (if current-prefix-arg + (read-coding-system "Coding System: ")))) + (find-file-other-frame library codesys)) ; This conflicts with an existing binding ;(define-key global-map "\C-xl" 'find-library) (define-key global-map "\C-x4l" 'find-library-other-window) (define-key global-map "\C-x5l" 'find-library-other-frame) + + +(provide 'lib-complete) + +;;; lib-complete.el ends here
--- a/lisp/version.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/version.el Mon Aug 13 09:31:46 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 (beta2)"))) +(setq emacs-version (purecopy (concat emacs-version " XEmacs Lucid (beta3)"))) (defconst emacs-major-version (progn (or (string-match "^[0-9]+" emacs-version)
--- a/lisp/w3/ChangeLog Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/w3/ChangeLog Mon Aug 13 09:31:46 2007 +0200 @@ -2,8 +2,55 @@ * Makefile (xemacs-w3): Special target for XEmacs Build. +Thu Apr 24 08:29:34 1997 William M. Perry <wmperry@aventail.com> + +* Emacs/W3 3.0.85 released + +* w3-display.el (w3-display-table-dimensions): Deal with + colgroup/thead/tfoot/col better. Before was ignoring the rest of the + table. ack. + (w3-display-table): ditto + +* w3-prefs.el (w3-preferences-restore-variables): Slap things into + custom-land where they belong. + +* A few customization tweaks. + +Wed Apr 23 21:44:59 1997 <chang@wsu.edu> + +* w3-e19.el (w3-store-in-clipboard): Make this work under OS/2 + +Tue Apr 22 07:23:51 1997 William M. Perry <wmperry@aventail.com> + +* devices.el: Removed defsubsts so that we should be able to share .elc + files again between emacs and XEmacs. + +* font.el: Added in code to make a face blink. Causes lots of screen + flicker under Emacs 19 though, so it is turned off by default. Turn it + on with ESC-: (font-blink-initialize) - should be able to optimize when + the callback actually does anything based on what fonts are visible in + the visible buffers. + (font-face-visible-in-window-p): New function to tell if a face is + visible in a buffer window. + (font-map-windows): New function to map a function over all visible + windows. + (font-blink-callback): Use them to optimize so that invert-face is not + called unless absolutely necessary. + Mon Apr 21 08:58:02 1997 William M. Perry <wmperry@aventail.com> +* w3-e19.el: Added in compile-time require of w3-props so that pages with + backgrounds don't puke and die. + +* w3.el (w3-find-default-stylesheets): Don't load a user's personal + stylesheet if we started up in '-q' mode. + +* Emacs/W3 3.0.84 released + +* w3-display.el: When using XEmacs 20.x w/mule support, we now define our + own special character set. This means that the table border chars work + again in XEmacs/mule + * 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
--- a/lisp/w3/FAQ Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/w3/FAQ Mon Aug 13 09:31:46 2007 +0200 @@ -34,6 +34,15 @@ This will turn on stylistic warnings for any local HTML files or files loaded from the `*.some.domain.name' domain. +Q: How do I make emacs scroll the window horizontally when tabbing + through links? +A: XEmacs: + (add-hook 'w3-mode-hook '(lambda () (auto-show-mode 1))) + + Emacs (if you have hscroll.el from ftp:// ?????): + (autoload 'turn-on-hscroll "hscroll" nil t) + (add-hook 'w3-mode-hook 'turn-on-hscroll) + Courtesy of greg stark <gsstark@mit.edu> Q: How do i get Shift-Tab to go backwards on a text terminal or XTerm? aka: I hate the new text widgets, I can't go through the links with n and b
--- a/lisp/w3/Makefile Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/w3/Makefile Mon Aug 13 09:31:46 2007 +0200 @@ -101,8 +101,8 @@ w3.cps w3.fns w3.kys w3.pgs w3.tps w3.vrs \ w3.log w3.toc w3.aux -w3-vars.elc: w3-cus.el w3-vars.el -w3-display.elc: w3-display.el css.el font.el w3-imap.el -css.elc: css.el font.el -w3.elc: css.el w3-vars.el w3.el -dsssl.elc: dsssl.el dsssl-flow.el +w3-vars.elc: w3-cus.elc w3-vars.el +w3-display.elc: w3-display.el css.elc font.elc w3-imap.elc +css.elc: css.el font.elc +w3.elc: css.elc w3-vars.elc w3.el +dsssl.elc: dsssl.el dsssl-flow.elc
--- a/lisp/w3/devices.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/w3/devices.el Mon Aug 13 09:31:46 2007 +0200 @@ -1,7 +1,7 @@ ;;; devices.el -- XEmacs device API emulation ;; Author: wmperry -;; Created: 1997/04/21 15:57:56 -;; Version: 1.2 +;; Created: 1997/04/22 14:48:02 +;; Version: 1.3 ;; Keywords: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -114,13 +114,13 @@ (defun make-x-device (&optional display) (make-device 'x display)) -(defsubst set-device-selected-frame (device frame) +(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)) -(defsubst set-device-baud-rate (device rate) +(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." @@ -137,12 +137,12 @@ (t nil))) -(defsubst event-device (event) +(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)))) -(defsubst device-connection (&optional device) +(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")) @@ -169,13 +169,13 @@ "Return the output baud rate of DEVICE." 'baud-rate) -(defsubst device-on-window-system-p (&optional device) +(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)) -(defsubst device-name (&optional device) +(defun device-name (&optional device) "Return the name of the specified device." (or (cdr-safe (assq 'display (frame-parameters device))) "stdio")) @@ -218,43 +218,43 @@ (delete-frame (car frames) force) (setq frames (cdr frames))))) -(defsubst device-color-cells (&optional device) +(defun 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) +(defun 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) +(defun 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) +(defun 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) +(defun 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) +(defun 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) +(defun device-class (&optional device) (case window-system (x ; X11 (cond @@ -297,22 +297,22 @@ (t 'mono))) (otherwise 'color))) -(defsubst device-class-list () +(defun device-class-list () "Returns a list of valid device classes." (list 'color 'grayscale 'mono)) -(defsubst valid-device-class-p (class) +(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))) -(defsubst device-or-frame-type (device-or-frame) +(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." (or window-system 'tty)) -(defsubst device-type (&optional device) +(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, @@ -322,13 +322,13 @@ 'intuition' for an Amiga screen" (device-or-frame-type device)) -(defsubst device-type-list () +(defun 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) +(defun valid-device-type-p (type) "Given a TYPE, return t if it is valid." (memq type (device-type-list)))
--- a/lisp/w3/font.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/w3/font.el Mon Aug 13 09:31:46 2007 +0200 @@ -1,7 +1,7 @@ ;;; font.el --- New font model ;; Author: wmperry -;; Created: 1997/04/20 19:19:45 -;; Version: 1.45 +;; Created: 1997/04/24 13:55:44 +;; Version: 1.51 ;; Keywords: faces ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -30,35 +30,47 @@ ;;; The emacsen compatibility package - load it up before anything else ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (require 'cl) - -(eval-and-compile - (require 'devices)) +(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))))) + (condition-case () + (require 'custom) + (error nil)) + (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) + nil ;; We've got what we needed + ;; We have the old custom-library, hack around it! + (defmacro defgroup (&rest args) + nil) + (defmacro defcustom (var value doc &rest args) + (` (defvar (, var) (, value) (, doc)))))) + +(if (not (fboundp 'try-font-name)) + (defun try-font-name (fontname &rest args) + (case window-system + ((x win32 pm) (car-safe (x-list-fonts fontname))) + (ns (car-safe (ns-list-fonts fontname))) + (otherwise nil)))) + +(if (not (fboundp 'facep)) + (defun 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)) + (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)))) + +(if (not (fboundp 'face-property)) + (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)))) (require 'disp-table) @@ -299,7 +311,7 @@ (setq retval (cons type retval)))) retval)) -(defun unique (list) +(defun font-unique (list) (let ((retval) (cur)) (while list @@ -415,8 +427,8 @@ (font-spatial-to-canonical (font-size fontobj-2))))) (set-font-weight retval (font-higher-weight (font-weight fontobj-1) (font-weight fontobj-2))) - (set-font-family retval (unique (append (font-family fontobj-1) - (font-family fontobj-2)))) + (set-font-family retval (font-unique (append (font-family fontobj-1) + (font-family fontobj-2)))) (set-font-style retval (| (font-style fontobj-1) (font-style fontobj-2))) (set-font-registry retval (or (font-registry fontobj-1) (font-registry fontobj-2))) @@ -570,7 +582,7 @@ (aref menu 0))) (normal (mapcar (function (lambda (x) (if x (aref x 0)))) (aref menu 1)))) - (sort (unique (nconc scaled normal)) 'string-lessp)))) + (sort (font-unique (nconc scaled normal)) 'string-lessp)))) (cons "monospace" (mapcar 'car font-family-mappings)))) (defvar font-default-cache nil) @@ -711,7 +723,7 @@ (aref menu 0))) (normal (mapcar (function (lambda (x) (if x (aref x 0)))) (aref menu 1)))) - (sort (unique (nconc scaled normal)) 'string-lessp)))))) + (sort (font-unique (nconc scaled normal)) 'string-lessp)))))) (defun ns-font-create-name (fontobj &optional device) (let ((family (or (font-family fontobj) @@ -1164,4 +1176,67 @@ (apply 'set-face-foreground face color args))) (error nil))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Support for 'blinking' fonts +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun font-map-windows (func &optional arg frame) + (let* ((start (selected-window)) + (cur start) + (result nil)) + (push (funcall func start arg) result) + (while (not (eq start (setq cur (next-window cur)))) + (push (funcall func cur arg) result)) + result)) + +(defun font-face-visible-in-window-p (window face) + (let ((st (window-start window)) + (nd (window-end window)) + (found nil) + (face-at nil)) + (setq face-at (get-text-property st 'face (window-buffer window))) + (if (or (eq face face-at) (and (listp face-at) (memq face face-at))) + (setq found t)) + (while (and (not found) + (/= nd + (setq st (next-single-property-change + st 'face + (window-buffer window) nd)))) + (setq face-at (get-text-property st 'face (window-buffer window))) + (if (or (eq face face-at) (and (listp face-at) (memq face face-at))) + (setq found t))) + found)) + +(defun font-blink-callback () + ;; Optimized to never invert the face unless one of the visible windows + ;; is showing it. + (let ((faces (if font-running-xemacs (face-list t) (face-list))) + (obj nil)) + (while faces + (if (and (setq obj (face-property (car faces) 'font-specification)) + (font-blink-p obj) + (memq t + (font-map-windows 'font-face-visible-in-window-p (car faces)))) + (invert-face (car faces))) + (pop faces)))) + +(defcustom font-blink-interval 0.5 + "How often to blink faces" + :type 'number + :group 'faces) + +(defun font-blink-initialize () + (cond + ((featurep 'itimer) + (if (get-itimer "font-blinker") + (delete-itimer (get-itimer "font-blinker"))) + (start-itimer "font-blinker" 'font-blink-callback + font-blink-interval + font-blink-interval)) + ((fboundp 'run-at-time) + (cancel-function-timers 'font-blink-callback) + (run-at-time font-blink-interval + font-blink-interval + 'font-blink-callback)) + (t nil))) + (provide 'font)
--- a/lisp/w3/mm.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/w3/mm.el Mon Aug 13 09:31:46 2007 +0200 @@ -94,7 +94,8 @@ ;;; Variables, etc ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-and-compile - (require 'cl)) + (require 'cl) + (require 'devices)) (defconst mm-version (let ((x "1.96")) (if (string-match "Revision: \\([^ \t\n]+\\)" x)
--- a/lisp/w3/url-misc.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/w3/url-misc.el Mon Aug 13 09:31:46 2007 +0200 @@ -1,7 +1,7 @@ ;;; url-misc.el --- Misc Uniform Resource Locator retrieval code ;; Author: wmperry -;; Created: 1997/04/16 05:11:58 -;; Version: 1.16 +;; Created: 1997/04/21 23:59:58 +;; Version: 1.17 ;; Keywords: comm, data, processes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -28,6 +28,7 @@ (require 'url-vars) (require 'url-parse) +(require 'widget) (autoload 'Info-goto-node "info" "" t) (defun url-netrek (url)
--- a/lisp/w3/url-vars.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/w3/url-vars.el Mon Aug 13 09:31:46 2007 +0200 @@ -1,7 +1,7 @@ ;;; url-vars.el --- Variables for Uniform Resource Locator tool ;; Author: wmperry -;; Created: 1997/04/21 22:07:55 -;; Version: 1.55 +;; Created: 1997/04/24 20:22:16 +;; Version: 1.57 ;; 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.84")) +(defconst url-version (let ((x "p3.0.85")) (if (string-match "State: \\([^ \t\n]+\\)" x) (substring x (match-beginning 1) (match-end 1)) x)) @@ -245,7 +245,9 @@ (".Z" . "x-compress")) "*An assoc list of file extensions and the appropriate content-transfer-encodings for each." - :type '(repeat (cons (string :tag "Extension") (string :tag "Encoding"))) + :type '(repeat (cons :format "%v" + (string :tag "Extension") + (string :tag "Encoding"))) :group 'url-mime) (defcustom url-mail-command 'url-mail @@ -260,7 +262,8 @@ "*An assoc list of access types and servers that gateway them. Looks like ((\"http\" . \"hostname:portnumber\") ....) This is set up from the ACCESS_proxy environment variables in url-do-setup." - :type '(repeat (cons (string :tag "Protocol") + :type '(repeat (cons :format "%v" + (string :tag "Protocol") (string :tag "Proxy"))) :group 'url)
--- a/lisp/w3/url.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/w3/url.el Mon Aug 13 09:31:46 2007 +0200 @@ -1,13 +1,13 @@ ;;; url.el --- Uniform Resource Locator retrieval tool ;; Author: wmperry -;; Created: 1997/04/16 05:08:07 -;; Version: 1.75 +;; Created: 1997/04/22 15:08:38 +;; Version: 1.76 ;; Keywords: comm, data, processes, hypermedia ;;; LCD Archive Entry: ;;; url|William M. Perry|wmperry@cs.indiana.edu| ;;; Functions for retrieving/manipulating URLs| -;;; 1997/04/16 05:08:07|1.75|Location Undetermined +;;; 1997/04/22 15:08:38|1.76|Location Undetermined ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -38,6 +38,7 @@ (require 'url-parse) (require 'mm) (require 'mule-sysdp) +(require 'devices) (or (featurep 'efs) (featurep 'efs-auto) (condition-case ()
--- a/lisp/w3/w3-cus.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/w3/w3-cus.el Mon Aug 13 09:31:46 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-cus.el --- Customization support for Emacs-W3 ;; Author: wmperry -;; Created: 1997/03/24 06:35:57 -;; Version: 1.7 +;; Created: 1997/04/24 14:57:19 +;; Version: 1.8 ;; Keywords: comm, help, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -279,7 +279,9 @@ "*How to map MIME types to image types for the `image' package. Each entry is a cons cell of MIME types and image-type symbols." :group 'w3-images - :type '(repeat cons)) + :type '(repeat (cons :format "%v" + (string :tag "MIME Type") + (symbol :tag "Image type")))) ;;; Printing variables (defcustom w3-latex-docstyle "{article}"
--- a/lisp/w3/w3-display.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/w3/w3-display.el Mon Aug 13 09:31:46 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-display.el --- display engine v99999 ;; Author: wmperry -;; Created: 1997/04/21 21:59:42 -;; Version: 1.175 +;; Created: 1997/04/24 16:51:06 +;; Version: 1.176 ;; Keywords: faces, help, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1061,6 +1061,9 @@ (if (stringp cur) nil (case (car cur) + ((thead tfoot col colgroup) + (if (nth 2 cur) + (setq content (append (nth 2 cur) content)))) (tr (setq col 0) (setq rows (1+ rows)) @@ -1278,6 +1281,10 @@ (setq fill-prefix "")))) (while content (case (caar content) + ((thead tfoot col colgroup) + (if (nth 2 (car content)) + (setq content (append (nth 2 (car content)) (cdr content))) + (setq content (cdr content)))) (tr (setq w3-display-css-properties (css-get (nth 0 (car content))
--- a/lisp/w3/w3-e19.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/w3/w3-e19.el Mon Aug 13 09:31:46 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-e19.el --- Emacs 19.xx specific functions for emacs-w3 ;; Author: wmperry -;; Created: 1997/04/10 00:03:25 -;; Version: 1.23 +;; Created: 1997/04/24 04:44:57 +;; Version: 1.25 ;; Keywords: faces, help, mouse, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -29,6 +29,8 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Enhancements For Emacs 19 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(eval-when-compile + (require 'w3-props)) (require 'w3-forms) (require 'font) (require 'w3-script) @@ -90,12 +92,11 @@ (defun w3-store-in-clipboard (str) "Store string STR in the Xwindows clipboard" - (cond - ((memq (device-type) '(x pm)) - (x-select-text str)) - ((eq (device-type) 'ns) - (ns-store-pasteboard-internal str)) - (t nil))) + (case (device-type) + (x (x-select-text str)) + (pm (pm-put-clipboard str)) + (ns (ns-store-pasteboard-internal str)) + (otherwise nil))) (defun w3-e19-no-read-only (st nd) ;; Make sure we don't yank any read-only data out of this buffer
--- a/lisp/w3/w3-prefs.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/w3/w3-prefs.el Mon Aug 13 09:31:46 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-prefs.el --- Preferences panels for Emacs-W3 ;; Author: wmperry -;; Created: 1997/03/21 15:52:22 -;; Version: 1.23 +;; Created: 1997/04/24 15:41:27 +;; Version: 1.24 ;; Keywords: hypermedia, preferences ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -56,6 +56,8 @@ (while vars (setq temp (intern (format "w3-preferences-temp-%s" (car vars)))) (set (car vars) (symbol-value temp)) + (if (fboundp 'custom-set-variables) + (eval (` (custom-set-variables '((, (car vars)) (quote (, (symbol-value temp))) t))))) (setq vars (cdr vars))))) (defun w3-preferences-create-temp-variables (vars) @@ -538,6 +540,8 @@ panels (cdr panels)) (if (fboundp func) (funcall func))) + (if (fboundp 'custom-save-variables) + (custom-save-variables)) (w3-preferences-save-options) (message "Options saved") (sit-for 1)
--- a/lisp/w3/w3-props.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/w3/w3-props.el Mon Aug 13 09:31:46 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-props.el --- Additional text property stuff ;; Author: wmperry -;; Created: 1997/04/20 19:19:14 -;; Version: 1.1 +;; Created: 1997/04/22 14:50:19 +;; Version: 1.2 ;; Keywords: faces ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -49,14 +49,13 @@ (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'. +(defsubst w3-props-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)) + (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 @@ -72,7 +71,7 @@ prev (get-text-property start prop object)) (put-text-property start next prop - (unique (append val (if (listp prev) prev (list prev)))) + (w3-props-unique (append val (if (listp prev) prev (list prev)))) object) (setq start next)))) @@ -87,7 +86,7 @@ prev (get-text-property start prop object)) (put-text-property start next prop - (unique (append (if (listp prev) prev (list prev)) val)) + (w3-props-unique (append (if (listp prev) prev (list prev)) val)) object) (setq start next))))
--- a/lisp/w3/w3-vars.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/w3/w3-vars.el Mon Aug 13 09:31:46 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-vars.el,v --- All variable definitions for emacs-w3 ;; Author: wmperry -;; Created: 1997/04/21 22:07:54 -;; Version: 1.126 +;; Created: 1997/04/24 20:22:16 +;; Version: 1.127 ;; Keywords: comm, help, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -33,7 +33,7 @@ (require 'w3-cus) ; Grab everything that is customized (defconst w3-version-number - (let ((x "p3.0.84")) + (let ((x "p3.0.85")) (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/21 22:07:54")) +(defconst w3-version-date (let ((x "1997/04/24 20:22:16")) (if (string-match "Date: \\([^ \t\n]+\\)" x) (substring x (match-beginning 1) (match-end 1)) x))
--- a/lisp/w3/w3.el Mon Aug 13 09:31:13 2007 +0200 +++ b/lisp/w3/w3.el Mon Aug 13 09:31:46 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3.el --- Main functions for emacs-w3 on all platforms/versions ;; Author: wmperry -;; Created: 1997/04/15 23:28:10 -;; Version: 1.111 +;; Created: 1997/04/21 23:55:57 +;; Version: 1.112 ;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1900,6 +1900,10 @@ (let* ((lightp (css-color-light-p 'default)) (longname (if lightp "stylesheet-light" "stylesheet-dark")) (shortname (if lightp "light.css" "dark.css")) + (no-user-init (= 0 (length user-init-file))) + (w3-configuration-directory (if no-user-init + "/this/is/a/highly/unlikely/directory/name" + w3-configuration-directory)) (directories (list data-directory (concat data-directory "w3/") @@ -1919,7 +1923,8 @@ (expand-file-name "stylesheet" dir) (expand-file-name "default.css" dir)))) directories)) - (list w3-default-stylesheet))) + (and (not no-user-init) + (list w3-default-stylesheet)))) (remember possible) (old-asynch (default-value 'url-be-asynchronous)) (found nil)
--- a/man/efs.texi Mon Aug 13 09:31:13 2007 +0200 +++ b/man/efs.texi Mon Aug 13 09:31:46 2007 +0200 @@ -4,6 +4,10 @@ @settitle EFS @comment %**end of header (This is for running Texinfo on a region.) +@direntry +* EFS:: Transparent remote file access via FTP. +@end direntry + @synindex fn vr @node Top, What is EFS?, (dir), (dir)
--- a/src/ChangeLog Mon Aug 13 09:31:13 2007 +0200 +++ b/src/ChangeLog Mon Aug 13 09:31:46 2007 +0200 @@ -1,3 +1,13 @@ +Fri Apr 25 10:53:07 1997 Steven L Baur <steve@altair.xemacs.org> + + * glyphs-x.c: libpng already includes setjmp.h, so don't attempt + to include it twice. + +Thu Apr 24 09:14:13 1997 Steven L Baur <steve@altair.xemacs.org> + + * balloon-x.c (vars_of_balloon_x): Don't override advertised and + supported balloon-help. + 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
--- a/src/balloon-x.c Mon Aug 13 09:31:13 2007 +0200 +++ b/src/balloon-x.c Mon Aug 13 09:31:46 2007 +0200 @@ -131,7 +131,7 @@ } DEFUN ("balloon-help-move-to-pointer", Fballoon_help_move_to_pointer, 0, 0, 0, /* -Hide balloon help. +Move the balloon help to the place where the pointer currently resides. */ ()) { @@ -159,5 +159,5 @@ void vars_of_balloon_x (void) { - Fprovide (intern ("balloon-help")); + Fprovide (intern ("c-balloon-help")); }
--- a/src/cmdloop.c Mon Aug 13 09:31:13 2007 +0200 +++ b/src/cmdloop.c Mon Aug 13 09:31:46 2007 +0200 @@ -216,6 +216,26 @@ static DOESNT_RETURN command_loop_3 (void) { +#ifdef LWLIB_MENUBARS_LUCID + extern int in_menu_callback; /* defined in menubar-x.c */ +#endif /* LWLIB_MENUBARS_LUCID */ + +#ifdef LWLIB_MENUBARS_LUCID + /* + * #### Fix the menu code so this isn't necessary. + * + * We cannot allow the lwmenu code to be reentered, because the + * code is not written to be reentrant and will crash. Therefore + * paths from the menu callbacks back into the menu code have to + * be blocked. Fnext_event is the normal path into the menu code, + * but waiting to signal an error there is too late in case where + * a new command loop has been started. The error will be caught + * and Fnext_event will be called again, looping forever. So we + * signal an error here to avoid the loop. + */ + if (in_menu_callback) + error ("Attempt to enter command_loop_3 inside menu callback"); +#endif /* LWLIB_MENUBARS_LUCID */ /* This function can GC */ for (;;) {
--- a/src/event-Xt.c Mon Aug 13 09:31:13 2007 +0200 +++ b/src/event-Xt.c Mon Aug 13 09:31:46 2007 +0200 @@ -755,8 +755,7 @@ force anyone to remember them. The case of the other character sets is significant, however. */ - if ((((unsigned int) keysym) & (~0xFF)) == ((unsigned int) 0xFF00) || - (((unsigned int) keysym) & (~0xFF)) == ((unsigned int) 0xFE00)) + if ((((unsigned int) keysym) & (~0x1FF)) == ((unsigned int) 0xFE00)) { char buf [255]; char *s1, *s2;
--- a/src/event-stream.c Mon Aug 13 09:31:13 2007 +0200 +++ b/src/event-stream.c Mon Aug 13 09:31:46 2007 +0200 @@ -1989,11 +1989,28 @@ XCOMMAND_BUILDER (con->command_builder); int store_this_key = 0; struct gcpro gcpro1; +#ifdef LWLIB_MENUBARS_LUCID + extern int in_menu_callback; /* defined in menubar-x.c */ +#endif /* LWLIB_MENUBARS_LUCID */ + GCPRO1 (event); - /* DO NOT do QUIT anywhere within this function or the functions it calls. We want to read the ^G as an event. */ +#ifdef LWLIB_MENUBARS_LUCID + /* + * #### Fix the menu code so this isn't necessary. + * + * We cannot allow the lwmenu code to be reentered, because the + * code is not written to be reentrant and will crash. Therefore + * paths from the menu callbacks back into the menu code have to + * be blocked. Fnext_event is the normal path into the menu code, + * so we signal an error here. + */ + if (in_menu_callback) + error ("Attempt to call next-event inside menu callback"); +#endif /* LWLIB_MENUBARS_LUCID */ + if (NILP (event)) event = Fmake_event (); else
--- a/src/glyphs-x.c Mon Aug 13 09:31:13 2007 +0200 +++ b/src/glyphs-x.c Mon Aug 13 09:31:46 2007 +0200 @@ -57,7 +57,11 @@ #include "sysfile.h" +#ifdef HAVE_PNG +#include <png.h> +#else #include <setjmp.h> +#endif #define LISP_DEVICE_TO_X_SCREEN(dev) \ XDefaultScreenOfDisplay (DEVICE_X_DISPLAY (XDEVICE (dev))) @@ -1922,8 +1926,6 @@ #ifdef HAVE_PNG -#include <png.h> - /********************************************************************** * PNG * **********************************************************************/
--- a/src/menubar-x.c Mon Aug 13 09:31:13 2007 +0200 +++ b/src/menubar-x.c Mon Aug 13 09:31:46 2007 +0200 @@ -308,6 +308,18 @@ } +#ifdef LWLIB_MENUBARS_LUCID +int in_menu_callback; + +Lisp_Object +restore_in_menu_callback(Lisp_Object val) +{ + in_menu_callback = XINT(val); + return Qnil; +} +#endif /* LWLIB_MENUBARS_LUCID */ + + /* The order in which callbacks are run is funny to say the least. It's sometimes tricky to avoid running a callback twice, and to avoid returning prematurely. So, this function returns true @@ -338,6 +350,7 @@ Lisp_Object rest = Qnil; Lisp_Object frame; int any_changes = 0; + int count; if (!f) f = x_any_window_to_frame (d, XtWindow (XtParent (widget))); @@ -357,8 +370,22 @@ assert (hack_wv->type == INCREMENTAL_TYPE); VOID_TO_LISP (submenu_desc, hack_wv->call_data); + + /* + * #### Fix the menu code so this isn't necessary. + * + * Protect against reentering the menu code otherwise we will + * crash later when the code gets confused at the state + * changes. + */ + count = specpdl_depth (); + record_unwind_protect (restore_in_menu_callback, + make_int (in_menu_callback)); + in_menu_callback = 1; wv = menu_item_descriptor_to_widget_value (submenu_desc, SUBMENU_TYPE, 1, 0); + unbind_to (count, Qnil); + if (!wv) { wv = xmalloc_widget_value ();
--- a/src/s/decosf4-0.h Mon Aug 13 09:31:13 2007 +0200 +++ b/src/s/decosf4-0.h Mon Aug 13 09:31:46 2007 +0200 @@ -25,7 +25,11 @@ #define regmatch_t sys_regmatch_t #define SYSTEM_MALLOC + +/* Some V4.0* versions before V4.0B don't detect rename properly. */ +#ifndef HAVE_RENAME #define HAVE_RENAME +#endif /* Digital Unix 4.0 has a realpath, but it's buggy. And I *do* mean buggy. */