Mercurial > emacs
changeset 83400:03934708f1e9
Merged from miles@gnu.org--gnu-2005 (patch 152-156, 642-654)
Patches applied:
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-642
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-643
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-644
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-645
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-646
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-647
lisp/gnus/ChangeLog: Remove duplicate entry
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-648
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-649
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-650
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-651
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-652
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-653
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-654
Update from CVS
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-152
Update from CVS: lisp/mml.el (mml-preview): Doc fix.
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-153
Update from CVS
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-154
Update from CVS
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-155
Update from CVS
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-156
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-440
| author | Karoly Lorentey <lorentey@elte.hu> |
|---|---|
| date | Fri, 18 Nov 2005 13:13:34 +0000 |
| parents | 2988c5a31dc1 (current diff) 4571a040cf5b (diff) |
| children | 03335deca80b |
| files | admin/FOR-RELEASE etc/TODO lisp/ChangeLog lisp/Makefile.in lisp/emulation/viper-util.el lisp/files.el lisp/help-fns.el lisp/loadup.el lisp/progmodes/gdb-ui.el lisp/simple.el lisp/startup.el lisp/url/url-handlers.el lispref/ChangeLog mac/makefile.MPW man/ChangeLog man/emacs.texi src/.gdbinit src/Makefile.in src/alloc.c src/dispextern.h src/fileio.c src/keymap.c src/lisp.h src/lread.c src/macterm.c src/print.c src/process.c src/xdisp.c src/xfns.c src/xterm.c |
| diffstat | 115 files changed, 3625 insertions(+), 1615 deletions(-) [+] |
line wrap: on
line diff
--- a/admin/ChangeLog Mon Nov 07 15:25:27 2005 +0000 +++ b/admin/ChangeLog Fri Nov 18 13:13:34 2005 +0000 @@ -1,3 +1,8 @@ +2005-11-11 Kim F. Storm <storm@cua.dk> + + * FOR-RELEASE (FATAL ERRORS): Fix infinite loop in redisplay + when displaying a non-breaking space in an overlay string. + 2005-10-30 Chong Yidong <cyd@stupidchicken.com> * FOR-RELEASE: Init file change implemented.
--- a/admin/FOR-RELEASE Mon Nov 07 15:25:27 2005 +0000 +++ b/admin/FOR-RELEASE Fri Nov 18 13:13:34 2005 +0000 @@ -35,6 +35,8 @@ a bitmap appearence. [Assigned to KFS] +** Install Zhilin's icons. + * FATAL ERRORS ** Investigate reported crashes in compact_small_strings. @@ -44,8 +46,11 @@ * BUGS -** Make where-is-internal detect when a key is shadowed by a shorter -prefix key that prevents you from entering it. +** Fix window resizing bug: +C-x 2, C-x 3, C-x 2. Now try to move the bottom of the +second window to the left. + +** Fix completion highlighting bug in partial completion mode. ** Clean up the confusion about what `unspecified' means in the face defaults for new frames. @@ -59,6 +64,9 @@ * DOCUMENTATION +** Update what needs to be updated now that Global Font Lock mode and +File Name Shadow mode are enabled by default. + ** Check man/info.texi. ** Add missing years in copyright notices of all files. @@ -131,7 +139,7 @@ man/indent.texi "Luc Teirlinck" Chong Yidong man/killing.texi "Luc Teirlinck" Chong Yidong man/kmacro.texi "Luc Teirlinck" Chong Yidong -man/macos.texi +man/macos.texi Chong Yidong man/maintaining.texi Chong Yidong man/major.texi "Luc Teirlinck" Chong Yidong man/mark.texi "Luc Teirlinck" Chong Yidong
--- a/etc/ChangeLog Mon Nov 07 15:25:27 2005 +0000 +++ b/etc/ChangeLog Fri Nov 18 13:13:34 2005 +0000 @@ -1,3 +1,18 @@ +2005-11-16 Nick Roberts <nickrob@snap.net.nz> + + * images/gud/go.xpm, images/gud/go.pbm: Old gud-remove icons. + Use for run/continue. + * images/gud/stop.xpm, images/gud/stop.pbm: Old gud-break icons. + Use for interrupting inferior. + * images/gud/pp.xpm, images/gud/pstar.xpm, images/gud/until.xpm: + Use a more appropriate variable name. + * images/gud/remove.xpm, images/gud/remove.pbm + * images/gud/break.xpm, images/gud/break.pbm: Make more intuitive. + +2005-11-09 Nick Roberts <nickrob@snap.net.nz> + + * images/gud/pp.xpm, images/gud/pp.pbm: New icons. + 2005-11-06 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> * images/copy.xpm, images/copy.pbm, images/low-color/copy.xpm
--- a/etc/NEWS Mon Nov 07 15:25:27 2005 +0000 +++ b/etc/NEWS Fri Nov 18 13:13:34 2005 +0000 @@ -260,6 +260,9 @@ of specifying the current directory. Normally that means to visit the directory with Dired. +You can get the old behavior by typing C-x C-f M-n RET, which fetches +the actual file name into the minibuffer. + +++ ** The completion commands TAB, SPC and ? in the minibuffer apply only to the text before point. If there is text in the buffer after point, @@ -434,6 +437,8 @@ C-h e displays the *Messages* buffer. +C-h d runs apropos-documentation. + C-h followed by a control character is used for displaying files that do not change: @@ -444,23 +449,18 @@ have been moved to C-h F, C-h K and C-h S. C-h c, C-h k, C-h w, and C-h f now handle remapped interactive commands. - - C-h c and C-h k report the actual command (after possible remapping) run by the key sequence. - - C-h w and C-h f on a command which has been remapped now report the command it is remapped to, and the keys which can be used to run that command. For example, if C-k is bound to kill-line, and kill-line is remapped to new-kill-line, these commands now report: - - C-h c and C-h k C-k reports: C-k runs the command new-kill-line - - C-h w and C-h f kill-line reports: kill-line is remapped to new-kill-line which is on C-k, <deleteline> - - C-h w and C-h f new-kill-line reports: new-kill-line is on C-k @@ -673,6 +673,10 @@ ** Minibuffer changes: +++ +*** The new file-name-shadow-mode is turned ON by default, so that when +entering a file name, any prefix which Emacs will ignore is dimmed. + ++++ *** There's a new face `minibuffer-prompt'. Emacs adds this face to the list of text properties stored in the variable `minibuffer-prompt-properties', which is used to display the @@ -3501,7 +3505,7 @@ evaluate when Emacs starts up. If this is done after startup, it evaluates those expressions immediately. -This is useful in packages that can be preloaded. +This is useful in packages that can be preloaded. *** `list-faces-display' takes an optional argument, REGEXP. @@ -4481,6 +4485,11 @@ *** The new function `window-tree' returns a frame's window tree. +++ +*** The functions `get-lru-window' and `get-largest-window' take an optional +argument `dedicated'. If non-nil, those functions do not ignore +dedicated windows. + ++++ ** Customizable fringe bitmaps *** New function `define-fringe-bitmap' can now be used to create new
--- a/etc/TODO Mon Nov 07 15:25:27 2005 +0000 +++ b/etc/TODO Fri Nov 18 13:13:34 2005 +0000 @@ -40,6 +40,8 @@ list fonts, display a font as a sample, etc. [fx is looking at multilingual font selection for Emacs 22.] +** Rewrite the face code to be simpler, clearer and faster. + ** Program Enriched mode to read and save in RTF. [Is there actually a decent single definition of RTF? Maybe see info at http://latex2rtf.sourceforge.net/.]
--- a/etc/images/gud/break.xpm Mon Nov 07 15:25:27 2005 +0000 +++ b/etc/images/gud/break.xpm Fri Nov 18 13:13:34 2005 +0000 @@ -1,30 +1,29 @@ /* XPM */ -static char * stop_xpm[] = { -"24 24 3 1", +static char * break_xpm[] = { +"24 24 2 1", " c None", -". c #F8F810104040", -"X c #F8F8FCFCF8F8", +". c #cc0033", " ", " ", +" ", +" ", +" .... ", +" ........ ", " .......... ", " ............ ", " .............. ", +" .............. ", " ................ ", -" .................. ", -" ..XX..XXX..XX..XXX.. ", -" .X..X..X..X..X.X..X. ", -" .X.....X..X..X.X..X. ", -" .X.....X..X..X.X..X. ", -" ..X....X..X..X.X..X. ", -" ...X...X..X..X.XXX.. ", -" ....X..X..X..X.X.... ", -" ....X..X..X..X.X.... ", -" .X..X..X..X..X.X.... ", -" ..XX...X...XX..X.... ", -" .................. ", +" ................ ", " ................ ", +" ................ ", +" .............. ", " .............. ", " ............ ", " .......... ", +" ........ ", +" .... ", +" ", +" ", " ", " "};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/gud/go.xpm Fri Nov 18 13:13:34 2005 +0000 @@ -0,0 +1,30 @@ +/* XPM */ +static char * go_xpm[] = { +"24 24 3 1", +" c None", +". c #000080800000", +"X c #FFFFFFFFFFFF", +" ", +" ", +" .......... ", +" ............ ", +" .............. ", +" ................ ", +" .................. ", +" ......XX...XX....... ", +" .....X..X.X..X...... ", +" .....X....X..X...... ", +" .....X....X..X...... ", +" .....X....X..X...... ", +" .....X.XX.X..X...... ", +" .....X..X.X..X...... ", +" .....X..X.X..X...... ", +" .....X..X.X..X...... ", +" ......XX...XX....... ", +" .................. ", +" ................ ", +" .............. ", +" ............ ", +" .......... ", +" ", +" "};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/gud/pp.xpm Fri Nov 18 13:13:34 2005 +0000 @@ -0,0 +1,29 @@ +/* XPM */ +static char * pp_xpm[] = { +"24 24 2 1", +" c None", +". c #000000000000", +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" ... ... ... ... ", +" ... ... ... ... ", +" .. .. .. .. ", +" .. .. .. .. ", +" .. .. .. .. ", +" .. .. .. .. ", +" .. .. .. .. ", +" ... .. ... .. ", +" .. .. .. .. ", +" .. .. ", +" .. .. ", +" .. .. ", +" .... .... ", +" ", +" ", +" "};
--- a/etc/images/gud/pstar.xpm Mon Nov 07 15:25:27 2005 +0000 +++ b/etc/images/gud/pstar.xpm Fri Nov 18 13:13:34 2005 +0000 @@ -1,5 +1,5 @@ /* XPM */ -static char * gud_pstar_xpm[] = { +static char * pstar_xpm[] = { "24 24 2 1", " c #BDBDBEBEBDBD", ". c #000000000000",
--- a/etc/images/gud/remove.xpm Mon Nov 07 15:25:27 2005 +0000 +++ b/etc/images/gud/remove.xpm Fri Nov 18 13:13:34 2005 +0000 @@ -1,31 +1,30 @@ /* XPM */ -static char * go_xpm[] = { -"24 24 4 1", +static char * clear_xpm[] = { +"24 24 3 1", " c None", -". c #000080800000", -"X c #FFFFFFFFFFFF", -"o c #F8F8FCFCF8F8", +". c #cc0033", +"X c #F0F0F0", +" ", +" ", " ", " ", +" .... ", +" ........ ", " .......... ", -" ............ ", -" .............. ", -" ................ ", -" .................. ", -" ......XX...oo....... ", -" .....X..X.o..o...... ", -" .....X....o..o...... ", -" .....X....o..o...... ", -" .....X....o..o...... ", -" .....X.XX.o..o...... ", -" .....X..X.o..o...... ", -" .....X..X.o..o...... ", -" .....X..X.o..o...... ", -" ......XX...oo....... ", -" .................. ", -" ................ ", -" .............. ", -" ............ ", +" .XX......XX. ", +" ...XX....XX... ", +" ....XX..XX.... ", +" ......XXXX...... ", +" .......XX....... ", +" ......XXXX...... ", +" .....XX..XX..... ", +" ...XX....XX... ", +" ..XX......XX.. ", +" .X........X. ", " .......... ", +" ........ ", +" .... ", +" ", +" ", " ", " "};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/gud/stop.xpm Fri Nov 18 13:13:34 2005 +0000 @@ -0,0 +1,30 @@ +/* XPM */ +static char * stop_xpm[] = { +"24 24 3 1", +" c None", +". c #cc0033", +"X c #FFFFFFFFFFFF", +" ", +" ", +" .......... ", +" ............ ", +" .............. ", +" ................ ", +" .................. ", +" ..XX..XXX..XX..XXX.. ", +" .X..X..X..X..X.X..X. ", +" .X.....X..X..X.X..X. ", +" .X.....X..X..X.X..X. ", +" ..X....X..X..X.X..X. ", +" ...X...X..X..X.XXX.. ", +" ....X..X..X..X.X.... ", +" ....X..X..X..X.X.... ", +" .X..X..X..X..X.X.... ", +" ..XX...X...XX..X.... ", +" .................. ", +" ................ ", +" .............. ", +" ............ ", +" .......... ", +" ", +" "};
--- a/etc/images/gud/until.xpm Mon Nov 07 15:25:27 2005 +0000 +++ b/etc/images/gud/until.xpm Fri Nov 18 13:13:34 2005 +0000 @@ -1,5 +1,5 @@ /* XPM */ -static char * goto_xpm[] = { +static char * until_xpm[] = { "24 24 6 1", " c None", ". c #cc0033",
--- a/lisp/ChangeLog Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/ChangeLog Fri Nov 18 13:13:34 2005 +0000 @@ -1,3 +1,495 @@ +2005-11-16 Luc Teirlinck <teirllm@auburn.edu> + + * rfn-eshadow.el (file-name-shadow-properties) + (file-name-shadow-tty-properties, file-name-shadow-mode): Remove + autoloads, because the file is now preloaded. + +2005-11-16 Stefan Monnier <monnier@iro.umontreal.ca> + + * printing.el (easy-menu-intern): Don't define. + (pr-get-symbol): Use easy-menu-intern only if defined. + + * simple.el (blink-matching-open): Simplify a bit. + (completion-setup-function): Fix the case of partial-completion-mode + when the minibuffer's contents start with "-". + Obey completion-base-size-function even when + minibuffer-completing-file-name is non-nil. + +2005-11-16 Richard M. Stallman <rms@gnu.org> + + * net/eudcb-ph.el (eudc-ph-open-session): + Use set-process-query-on-exit-flag. + + * mail/smtpmail.el (smtpmail-send-it): Use insert-buffer-contents. + + * international/ucs-tables.el (ucs-set-table-for-input): + Use make-local-variable, not make-variable-buffer-local. + + * emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): + Improve warning message text. + + * savehist.el (savehist-save-hook): Add :group. + + * menu-bar.el (menu-bar-help-menu): + Rename Find Extra Packages to External Packages. + + * cus-edit.el (Custom-reset-standard): Verify that + :custom-standard-value prop exists before calling it. + + * apropos.el (apropos-calc-scores): Use apropos-pattern. + +2005-11-16 Martin Rudalics <rudalics@gmx.at> (tiny change) + + * wid-edit.el (color): Enclose %t in %{...%}. + + * cus-edit.el (face): Enclose %t in %{...%}. + +2005-11-16 Hrvoje Niksic <hniksic@xemacs.org> + + * savehist.el (savehist-mode-hook): Re-add the var. + (savehist-mode): Use it. + +2005-11-16 Stefan Monnier <monnier@iro.umontreal.ca> + + * textmodes/flyspell.el: Fix commenting convention. + Remove unnecessary leading * in custom docstrings. + (flyspell-emacs): Remove unused var. + (flyspell-delete-region-overlays): Use remove-overlays. + (flyspell-accept-buffer-local-defs): Use save-current-buffer. + (flyspell-debug-signal-no-check, flyspell-debug-signal-changed-checked) + (flyspell-debug-signal-pre-word-checked, flyspell-post-command-hook) + (flyspell-debug-signal-word-checked): Use with-current-buffer. + (make-flyspell-overlay): Don't locally reuse a global name. + (flyspell-highlight-incorrect-region) + (flyspell-highlight-duplicate-region): Use flyspell-unhighlight-at. + (flyspell-check-previous-highlighted-word): Use flyspell-overlay-p. + (flyspell-notify-misspell): Remove unused args `start' and `end'. + (flyspell-word): Adjust call accordingly. Use ispell-send-string. + Wrap calls to accept-process-output inside with-local-quit since it's + often called from a post-command-hook. + (flyspell-correct-word, flyspell-auto-correct-word): + Use ispell-send-string. + (flyspell-xemacs-popup): Remove unused arg `event'. Update call. + + * calendar/diary-lib.el (diary-list-entries): Also hide the + terminating newline. + +2005-11-16 Carsten Dominik <dominik@science.uva.nl> + + * textmodes/reftex.el (reftex-use-fonts): Remove the check for + window-system, to allow fonts on tty. + +2005-11-17 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gud.el (gud-speedbar-item-info): New function. + (gud-install-speedbar-variables): Use it to display data types + of watch expression as tooltips in speedbar. + +2005-11-15 Luc Teirlinck <teirllm@auburn.edu> + + * font-core.el (global-font-lock-mode): Add :version keyword, + because default was changed. + + * jka-cmpr-hook.el (auto-compression-mode): Ditto. + + * startup.el (command-line): Use `custom-reevaluate-setting' for + `file-name-shadow-mode'. + + * loadup.el: Preload rfn-eshadow. + + * rfn-eshadow.el (file-name-shadow-mode): Set :init-value to t. + Add :version keyword. + (file-name-shadow-properties, file-name-shadow-tty-properties) + (file-name-shadow): Add :version keyword. + + * cus-edit.el (custom-add-parent-links): Fix bug whereby, for + instance, `(fringe custom-face)' shadowed `(fringe custom-group)' + in the custom-group property of the symbol frames and the fringe + group got no link to its parent group frames. + Doc fix. + +2005-11-16 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gud.el (gud-stop-subjob): New function. + (gud-menu-map, gud-tool-bar-map): Use it. + +2005-11-16 Kim F. Storm <storm@cua.dk> + + * progmodes/gud.el (gud-menu-map): Let [stop] stop program rather + than kill it. + (gud-tool-bar-map): Likewise. Move cont/until/finish buttons + to a more useful/logical place. + +2005-11-16 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gud.el (gud-menu-map): Make visibility of stop and + go buttons complementary. + +2005-11-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * rfn-eshadow.el (rfn-eshadow-regexp): Remove. + (rfn-eshadow-sifn-equal): New function. + (rfn-eshadow-update-overlay): Rewrite to use substitute-in-file-name. + +2005-11-15 Michael Kifer <kifer@cs.stonybrook.edu> + + * viper-utils (viper-non-word-characters-reformed-vi): Quote `-' in + string. + + * viper.el (viper-emacs-state-mode-list): Ensure that + rcirc-mode buffers come up in Emacs state. + + * ediff-util (ediff-make-temp-file): Use proper file-name-handler + operation. + +2005-11-15 Dan Nicolaescu <dann@ics.uci.edu> + + * term.el (term-termcap-format): Fix typos. + (term-down): Fix the negative argument case. + +2005-11-16 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-ui.el: Remove face-alias left over from change on + 2005-08-15. + (gdb-ann3): New command gud-go. + (menu): Accomodate gdb-mi.el. + (gdb-assembler-custom): Make buffer of selected window current + so that set-window-point works. + + * progmodes/gud.el (gud-menu-map, gud-tool-bar-map): Re-define + buttons and include new ones. + +2005-11-16 Kim F. Storm <storm@cua.dk> + + * progmodes/gud.el (gud-tool-bar-item-visible-no-fringe): New function. + (gud-menu-map): Use it. + +2005-11-14 Luc Teirlinck <teirllm@auburn.edu> + + * jka-cmpr-hook.el (auto-compression-mode): Enable it in a way + that works correctly for Custom and that does not override a user + who disables it. + + * help-mode.el (help-make-xrefs, help-xref-on-pp) + (help-xref-interned, help-follow): Make hyperlinks for variables + that are unbound, but have a non-nil variable-documentation property. + + * emacs-lisp/derived.el (define-derived-mode): Remove defvar for + mode hook. (It conflicted with defcustoms for some mode hooks.) + Use the `variable-documentation' property to give the mode hook a + docstring and expand that docstring. + +2005-11-14 Hrvoje Niksic <hniksic@xemacs.org> + + * savehist.el (savehist-mode): Don't bother with + `custom-set-minor-mode'. + (savehist-coding-system): Check XEmacs version. + (history-length): Declare also at run time. + (savehist-mode): Don't emit a message. Don't run the minor mode hook. + Don't set the customize state. + (savehist-minibuffer-hook): Special case for when + minibuffer-history-variable is equal to t. + +2005-11-14 Stefan Monnier <monnier@iro.umontreal.ca> + + * files.el (write-file): Refresh VC status. + + * calendar/diary-lib.el (diary-list-entries, diary-show-all-entries) + (mark-diary-entries, make-diary-entry): Check default-major-mode rather + than fundamental-mode to see if the mode was set. + +2005-11-14 Romain Francoise <romain@orebokech.com> + + * dired-x.el: If `vm-visit-folder' doesn't exist, define it as a + dummy function in `eval-when-compile' to avoid compiler warning. + Require `man' at compile time. + +2005-11-14 Jay Belanger <belanger@truman.edu> + + * calc-alg.el (calcFunc-write-out-power): Rename it to + calcFunc-powerexpand. + (math-write-out-power): Rename it to math-powerexpand; have it + handle negative exponents. + (calc-writeoutpower): Rename it to calc-powerexpand. + + * calc-ext.el: Change calcFunc-writeoutpower and + calc-writeoutpower to calcFunc-powerexpand and calc-powerexpand in + autoloads. + Add calcFunc-ldiv to autoloads. + + * calc-arith.el (calcFunc-ldiv): New function. + + * calc.el (calc-left-divide): New function. + +2005-11-14 Juri Linkov <juri@jurta.org> + + * cus-edit.el (custom-variable-prompt): Set the default value arg + of completing-read. + + * cus-dep.el (custom-make-dependencies): Reverse the list of + found dependencies. + +2005-11-14 Dan Nicolaescu <dann@ics.uci.edu> + + * menu-bar.el (menu-bar-options-menu): Delete "Syntax + Highlighting" entry, it is on by default now. + (menu-bar-options-save): Do not save global-font-lock-mode. + +2005-11-13 Richard M. Stallman <rms@gnu.org> + + * textmodes/flyspell.el (flyspell-large-region): + Call flyspell-accept-buffer-local-defs. + +2005-11-13 Agustin Martin <agustin.martin@hispalinux.es> + + * textmodes/flyspell.el (flyspell-notify-misspell): + Fix misspelling of "Misspelling". + (flyspell-process-localwords): New function. + (flyspell-large-region): Call flyspell-process-localwords and + flyspell-delete-region-overlays. + (flyspell-delete-region-overlays): New function. + (flyspell-delete-all-overlays): Call that. + +2005-11-13 Richard M. Stallman <rms@gnu.org> + + * help.el (help-for-help-internal): Improve doc of C-h a. + (describe-key): Improve prompt; doc fix. + +2005-11-13 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc-svn.el (vc-svn-registered): Catch all errors. + + * cus-dep.el (custom-make-dependencies): Typo. + +2005-11-13 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-util.el (top): Fix compilation warning. + +2005-11-13 Kim F. Storm <storm@cua.dk> + + * help.el (help-for-help-internal): Fix `a' entry. Add `d' entry. + +2005-11-13 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gud.el (gud-menu-map): Move parentheses (again). + (gud-speedbar-buttons): Match on "const char *" too. + + * progmodes/gdb-ui.el (gdb-var-create-handler) + (gdb-var-list-children-handler): Match on "const char *" too. + (gdb-var-evaluate-expression-handler): Match on empty string. + (gdb-var-update-handler): Only call + gdb-var-evaluate-expression-handler when required. + +2005-11-13 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gud.el (gud-menu-map): Revert to window-fringes for + selected window. This still doesn't work for speedbar. + (gud-speedbar-buttons): Handle string expressions properly. + + * progmodes/gdb-ui.el (gdb-var-evaluate-expression-handler) + (gdb-var-create-handler): Handle string expressions properly. + (gdb-var-list-children-regexp, gdb-var-list-children-handler): + Handle string expressions properly. Move "type" field into regexp. + +2005-11-12 Karl Fogel <kfogel@red-bean.com> + + * bookmark.el (bookmark-maybe-message): New function to reduce + code duplication: invokes `message' iff baud-rate is high enough. + (bookmark-write-file): Use above instead of an inline conditional. + (bookmark-load): Same. + +2005-11-12 Karl Fogel <kfogel@red-bean.com> + + * bookmark.el (bookmark-write-file): Don't visit the destination + file, just write the data to it using write-region. This is + similar to revision 1.32 of saveplace.el, but with an additional + change to avoid visiting the file in the first place. + +2005-11-12 Chong Yidong <cyd@stupidchicken.com> + + * hi-lock.el (hi-lock-mode): Set the default value of + font-lock-defaults. + +2005-11-11 Luc Teirlinck <teirllm@auburn.edu> + + * find-lisp.el (find-lisp-find-dired-insert-file): Pass `string' + arg to `file-attributes'. + (find-lisp-format): The UID and GID can now be strings. + +2005-11-12 Kim F. Storm <storm@cua.dk> + + * help.el (help-map): Bind C-h d to apropos-documentation. + + * simple.el (what-cursor-position): Print (EOB) instead of (100%) + when point is at end-of-buffer. + + * apropos.el (apropos-match-face): Doc fix. + (apropos-sort-by-scores): Add new choice `verbose'. + (apropos-documentation-sort-by-scores): New defcustom. + (apropos-pattern): Now contains the pattern entered by the user. + (apropos-pattern-quoted): New defvar. + (apropos-regexp): New defvar, containing the regexp corresponding + to apropos-pattern. + (apropos-all-words-regexp): Rename from apropos-all-regexp. + (apropos-read-pattern): New defun. Use it to read pattern arg in + interactive calls; returns list of words for a word list, and + string for a regexp. + (apropos-parse-pattern): Rename from apropos-rewrite-regexp. Now + parses a list of words or regexp as returned by apropos-read-pattern. + (apropos-calc-scores): Return nil if apropos-regexp doesn't match. + (apropos-score-doc): Return a very high score if the string + entered by the user matches literally. + (apropos-variable): Doc fix. Use apropos-read-pattern. + (apropos-command): Doc fix. Use apropos-read-pattern and + apropos-parse-pattern. Call apropos-print with nosubst=t. + (apropos, apropos-value): Doc fix. Use apropos-read-pattern and + apropos-parse-pattern. + (apropos-documentation): Doc fix. Use apropos-read-pattern and + apropos-parse-pattern. Locally bind apropos-sort-by-scores to + apropos-documentation-sort-by-scores. Call apropos-print with + nosubst=t. + (apropos-documentation-internal): Pass doc string through + substitute-key-definition before adding text properties. + Highlight substring matching literal user input if possible. + (apropos-documentation-check-doc-file): Remove locals beg and end. + Fix calculation of score (as added twice). Pass doc string through + substitute-key-definition before adding text properties. + (apropos-documentation-check-elc-file): Pass doc string through + substitute-key-definition before adding text properties. + Highlight substring matching literal user input if possible. + (apropos-print): Add new arg NOSUBST; if set, command and variable + doc strings have already been passed through substitute-key-definition. + Add code to handle apropos-accumulator items without score element + for backwards compatibility (e.g. with woman package). + Only show scores if apropos-sort-by-scores is `verbose'. + +2005-11-10 Stefan Monnier <monnier@iro.umontreal.ca> + + * jka-cmpr-hook.el (jka-compr-install): Use push and dolist. + Add jka-compr-load-suffixes to load-suffixes. + + * jka-compr.el: Require 'jka-cmpr-hook. + (jka-compr-info-compress-message, jka-compr-info-compress-program) + (jka-compr-info-compress-args, jka-compr-info-uncompress-message) + (jka-compr-info-uncompress-program, jka-compr-info-uncompress-args) + (jka-compr-info-can-append, jka-compr-info-strip-extension) + (jka-compr-info-file-magic-bytes, jka-compr-get-compression-info) + (jka-compr-info-regexp): Remove. Provided by jka-cmpr-hook. + (jka-compr-uninstall): Remove entries from + jka-compr-added-to-file-coding-system-alist after they are used. + (jka-compr-error): Remove unused var `curbuf'. + (jka-compr-file-local-copy): Remove unused var `notfound'. + +2005-11-10 Romain Francoise <romain@orebokech.com> + + * apropos.el (apropos-calc-scores): Use `apropos-pattern'. + +2005-11-11 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gud.el (gud-menu-map): Move parentheses. + (gdb): New command gud-pv. + +2005-11-10 Stefan Monnier <monnier@iro.umontreal.ca> + + * tar-mode.el: Remove spurious or unnecessary leading stars + in docstrings. + (tar-header-block-tokenize): Also obey default-file-name-coding-system. + (tar-parse-octal-integer-safe): Use mapc. + (tar-header-block-summarize): Remove unused var `ck'. + (tar-summarize-buffer): Don't clear the modified-p bit if it wasn't + cleared before. Obey default-enable-multibyte-characters. + Use mapconcat. Simplify setting of tar-header-offset. + (tar-mode-map): Move initialization inside delcaration. + (tar-flag-deleted): Use `abs'. + (tar-expunge-internal): Remove unused var `line'. + (tar-expunge-internal): Don't hardcode point-min==1. + (tar-expunge): Widen while doing set-buffer-multibyte. + (tar-rename-entry): Use file-name-coding-system. + (tar-alter-one-field): Don't hardcode point-min==1. + (tar-subfile-save-buffer): string-as-unibyte works on unibyte strings. + (tar-pad-to-blocksize): Don't hardcode point-min==1. Clarify the code. + +2005-11-10 Masatake YAMATO <jet@gyve.org> + + * add-log.el (add-log-current-defun): Handle class::method + notation of c++. Fix incorrect comment. + +2005-11-10 Alan Mackenzie <acm@muc.de> + + * help-fns.el (describe-variable): Make C-h v work when a variable + has variable documentation yet is unbound. + +2005-11-10 Masatake YAMATO <jet@gyve.org> + + * man.el (Man-highlight-references): Set an empty + string to `Man-arguments' if it is nil. + Suggested by Reiner Steib <Reiner.Steib@gmx.de>. + +2005-11-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * Makefile.in (mh-loaddefs.el, loaddefs.el): Better follow the + commenting conventions. + + * cus-dep.el (custom-make-dependencies): Simplify. + Better follow the commenting conventions. + +2005-11-09 Richard M. Stallman <rms@gnu.org> + + * apropos.el (apropos-pattern): Rename from apropos-regexp. + (apropos-orig-pattern): Rename from apropos-orig-regexp. + All uses changed. + (apropos-rewrite-regexp): Doc fix. + (apropos-variable, apropos-command, apropos, apropos-value): + Change prompt; carry through the argument renaming. + +2005-11-09 Luc Teirlinck <teirllm@auburn.edu> + + * find-lisp.el: Require dired. + (find-lisp-find-dired-internal): Do not call + `abbreviate-file-name' on DIR. + +2005-11-10 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gud.el (gdb): Make gud-pp use user-defined command pp1. + +2005-11-09 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gud.el (gud-menu-map): Ensure tool-bar is constant + when using the speedbar. + (gdb): New command gud-pp. + (gud-menu-map, gud-tool-bar-map): Put it on the tool bar. + +2005-11-09 Juri Linkov <juri@jurta.org> + + * replace.el (occur-excluded-properties): New defcustom. + (occur-1, occur-engine, occur-accumulate-lines): Use it. + +2005-11-08 Jay Belanger <belanger@truman.edu> + + * calc/calc-units.el (math-convert-units): Replace any composite + unit by its definition. + +2005-11-08 Lars Hansen <larsh@soem.dk> + + * emacs-lisp/autoload.el (update-directory-autoloads): + Add obsolete function alias. + +2005-11-07 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/lisp-mode.el (lisp-mode-variables): Don't set + comment-indent-function. + (lisp-comment-indent): Replace by an alias for comment-indent-default. + + * reveal.el (reveal-post-command): Rework the handling of + reveal-open-spots, so as to be more reliable. There were several + tricky corner cases where an open spot might be lost, or where + a closed spot might end up on the list of open spots. + Only reveal text that's ellipsised. + +2005-11-07 Carsten Dominik <dominik@science.uva.nl> + + * textmodes/org.el (org-export-as-html): Remove bogus (debug) form. + 2005-11-06 Richard M. Stallman <rms@gnu.org> * progmodes/compile.el (compilation-internal-error-properties): @@ -15,14 +507,14 @@ 2005-11-07 Masatake YAMATO <jet@gyve.org> - * man.el (Man-reference-regexp): Accpet spaces between + * man.el (Man-reference-regexp): Accept spaces between `Man-name-regexp' and `Man-section-regexp'. (Man-apropos-regexp): New variable. (Man-abstract-xref-man-page): Use value for `Man-target-string' if available. - (Man-highlight-references, Man-highlight-references0): Handle - the case when `Man-arguments' includes "-k". - (Man-highlight-references0): Rename the argument `TARGET-POS' to + (Man-highlight-references, Man-highlight-references0): + Handle the case when `Man-arguments' includes "-k". + (Man-highlight-references0): Rename the argument `TARGET-POS' to `TARGET'. `TARGET' can be a number, function or nil. 2005-11-06 Nick Roberts <nickrob@snap.net.nz> @@ -251,7 +743,7 @@ * mail/rmailout.el (rmail-output-to-rmail-file, rmail-output): Doc fix. -2005-11-04 Ken Manheimer <ken.manheimer@gmail.com> +2005-11-04 Ken Manheimer <ken.manheimer@gmail.com> * pgg-pgp.el (pgg-pgp-encrypt-region, pgg-pgp-decrypt-region) (pgg-pgp-encrypt-symmetric-region, pgg-pgp-encrypt-symmetric)
--- a/lisp/Makefile.in Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/Makefile.in Fri Nov 18 13:13:34 2005 +0000 @@ -98,11 +98,11 @@ echo ";;; loaddefs.el --- automatically extracted autoloads" >> $@ echo ";;" >> $@; echo ";;; Code:" >> $@ echo " " >> $@ - echo ";;; Local Variables:" >> $@ - echo ";;; version-control: never" >> $@ - echo ";;; no-byte-compile: t" >> $@ - echo ";;; no-update-autoloads: t" >> $@ - echo ";;; End:" >> $@ + echo ";; Local Variables:" >> $@ + echo ";; version-control: never" >> $@ + echo ";; no-byte-compile: t" >> $@ + echo ";; no-update-autoloads: t" >> $@ + echo ";; End:" >> $@ echo ";;; loaddefs.el ends here" >> $@ autoloads: $(lisp)/loaddefs.el doit wd=$(lisp); $(setwins); \ @@ -231,11 +231,10 @@ $(lisp)/mh-e/mh-loaddefs.el: $(MH-E-SRC) echo ";;; mh-loaddefs.el --- automatically extracted autoloads" > $@ echo ";;" >> $@ - echo ";;; Copyright (C) 2003, 2004, 2005 Free Software Foundation, Inc." >> $@ - echo ";;; Author: Bill Wohler <wohler@newt.com>" >> $@ - echo ";;; Keywords: mail" >> $@ + echo ";; Copyright (C) 2003, 2004, 2005 Free Software Foundation, Inc." >> $@ + echo ";; Author: Bill Wohler <wohler@newt.com>" >> $@ + echo ";; Keywords: mail" >> $@ echo ";;; Commentary:" >> $@ - echo ";;; Change Log:" >> $@ echo ";;; Code:" >> $@ $(EMACS) $(EMACSOPT) \ -l autoload \ @@ -245,11 +244,11 @@ -f batch-update-autoloads $(lisp)/mh-e echo " " >> $@ echo "(provide 'mh-loaddefs)" >> $@ - echo ";;; Local Variables:" >> $@ - echo ";;; version-control: never" >> $@ - echo ";;; no-byte-compile: t" >> $@ - echo ";;; no-update-autoloads: t" >> $@ - echo ";;; End:" >> $@ + echo ";; Local Variables:" >> $@ + echo ";; version-control: never" >> $@ + echo ";; no-byte-compile: t" >> $@ + echo ";; no-update-autoloads: t" >> $@ + echo ";; End:" >> $@ echo ";;; mh-loaddefs.el ends here" >> $@ # Prepare a bootstrap in the lisp subdirectory.
--- a/lisp/add-log.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/add-log.el Fri Nov 18 13:13:34 2005 +0000 @@ -860,7 +860,7 @@ (skip-syntax-backward " ") (point)))) (if (looking-at "^[+-]") - ;; C++. + ;; Objective-C (change-log-get-method-definition) ;; Ordinary C function syntax. (setq beg (point)) @@ -901,6 +901,13 @@ ;; precede the name. (setq middle (point)) (forward-word -1) + ;; Is this C++ method? + (when (and (< 2 middle) + (string= (buffer-substring (- middle 2) + middle) + "::")) + ;; Include "classname::". + (setq middle (point))) ;; Ignore these subparts of a class decl ;; and move back to the class name itself. (while (looking-at "public \\|private ")
--- a/lisp/apropos.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/apropos.el Fri Nov 18 13:13:34 2005 +0000 @@ -100,15 +100,27 @@ (defcustom apropos-match-face 'match "*Face for matching text in Apropos documentation/value, or nil for none. This applies when you look for matches in the documentation or variable value -for the regexp; the part that matches gets displayed in this font." +for the pattern; the part that matches gets displayed in this font." :group 'apropos :type 'face) (defcustom apropos-sort-by-scores nil "*Non-nil means sort matches by scores; best match is shown first. -The computed score is shown for each match." +This applies to all `apropos' commands except `apropos-documentation'. +If value is `verbose', the computed score is shown for each match." :group 'apropos - :type 'boolean) + :type '(choice (const :tag "off" nil) + (const :tag "on" t) + (const :tag "show scores" verbose))) + +(defcustom apropos-documentation-sort-by-scores t + "*Non-nil means sort matches by scores; best match is shown first. +This applies to `apropos-documentation' only. +If value is `verbose', the computed score is shown for each match." + :group 'apropos + :type '(choice (const :tag "off" nil) + (const :tag "on" t) + (const :tag "show scores" verbose))) (defvar apropos-mode-map (let ((map (make-sparse-keymap))) @@ -126,13 +138,22 @@ (defvar apropos-mode-hook nil "*Hook run when mode is turned on.") +(defvar apropos-pattern nil + "Apropos pattern as entered by user.") + +(defvar apropos-pattern-quoted nil + "Apropos pattern passed through `regexp-quoute'.") + +(defvar apropos-words () + "Current list of apropos words extracted from `apropos-pattern'.") + +(defvar apropos-all-words () + "Current list of words and synonyms.") + (defvar apropos-regexp nil "Regexp used in current apropos run.") -(defvar apropos-orig-regexp nil - "Regexp as entered by user.") - -(defvar apropos-all-regexp nil +(defvar apropos-all-words-regexp nil "Regexp matching apropos-all-words.") (defvar apropos-files-scanned () @@ -152,12 +173,6 @@ Each element is a list of words where the first word is the standard emacs term, and the rest of the words are alternative terms.") -(defvar apropos-words () - "Current list of words.") - -(defvar apropos-all-words () - "Current list of words and synonyms.") - ;;; Button types used by apropos @@ -269,18 +284,35 @@ "\\)") ""))) -(defun apropos-rewrite-regexp (regexp) +;;;###autoload +(defun apropos-read-pattern (subject) + "Read an apropos pattern, either a word list or a regexp. +Returns the user pattern, either a list of words which are matched +literally, or a string which is used as a regexp to search for. + +SUBJECT is a string that is included in the prompt to identify what +kind of objects to search." + (let ((pattern + (read-string (concat "Apropos " subject " (word list or regexp): ")))) + (if (string-equal (regexp-quote pattern) pattern) + ;; Split into words + (split-string pattern "[ \t]+") + pattern))) + +(defun apropos-parse-pattern (pattern) "Rewrite a list of words to a regexp matching all permutations. -If REGEXP is already a regexp, don't modify it." - (setq apropos-orig-regexp regexp) - (setq apropos-words () apropos-all-words ()) - (if (string-equal (regexp-quote regexp) regexp) +If PATTERN is a string, that means it is already a regexp." + (setq apropos-words nil + apropos-all-words nil) + (if (consp pattern) ;; We don't actually make a regexp matching all permutations. ;; Instead, for e.g. "a b c", we make a regexp matching ;; any combination of two or more words like this: ;; (a|b|c).*(a|b|c) which may give some false matches, ;; but as long as it also gives the right ones, that's ok. - (let ((words (split-string regexp "[ \t]+"))) + (let ((words pattern)) + (setq apropos-pattern (mapconcat 'identity pattern " ") + apropos-pattern-quoted (regexp-quote apropos-pattern)) (dolist (word words) (let ((syn apropos-synonyms) (s word) (a word)) (while syn @@ -293,30 +325,30 @@ (setq syn (cdr syn)))) (setq apropos-words (cons s apropos-words) apropos-all-words (cons a apropos-all-words)))) - (setq apropos-all-regexp (apropos-words-to-regexp apropos-all-words ".+")) + (setq apropos-all-words-regexp (apropos-words-to-regexp apropos-all-words ".+")) (apropos-words-to-regexp apropos-words ".*?")) - (setq apropos-all-regexp regexp))) + (setq apropos-pattern-quoted (regexp-quote pattern) + apropos-all-words-regexp pattern + apropos-pattern pattern))) + (defun apropos-calc-scores (str words) "Return apropos scores for string STR matching WORDS. Value is a list of offsets of the words into the string." - (let ((scores ()) - i) + (let (scores i) (if words (dolist (word words scores) (if (setq i (string-match word str)) (setq scores (cons i scores)))) ;; Return list of start and end position of regexp - (string-match apropos-regexp str) - (list (match-beginning 0) (match-end 0))))) + (and (string-match apropos-pattern str) + (list (match-beginning 0) (match-end 0)))))) (defun apropos-score-str (str) "Return apropos score for string STR." (if str - (let* ( - (l (length str)) - (score (- (/ l 10))) - i) + (let* ((l (length str)) + (score (- (/ l 10)))) (dolist (s (apropos-calc-scores str apropos-all-words) score) (setq score (+ score 1000 (/ (* (- l s) 1000) l))))) 0)) @@ -325,8 +357,9 @@ "Return apropos score for documentation string DOC." (let ((l (length doc))) (if (> l 0) - (let ((score 0) - i) + (let ((score 0) i) + (when (setq i (string-match apropos-pattern-quoted doc)) + (setq score 10000)) (dolist (s (apropos-calc-scores doc apropos-all-words) score) (setq score (+ score 50 (/ (* (- l s) 50) l))))) 0))) @@ -335,8 +368,7 @@ "Return apropos score for SYMBOL." (setq symbol (symbol-name symbol)) (let ((score 0) - (l (length symbol)) - i) + (l (length symbol))) (dolist (s (apropos-calc-scores symbol apropos-words) (* score (or weight 3))) (setq score (+ score (- 60 l) (/ (* (- l s) 60) l)))))) @@ -367,18 +399,20 @@ \\{apropos-mode-map}") ;;;###autoload -(defun apropos-variable (regexp &optional do-all) - "Show user variables that match REGEXP. -With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also show +(defun apropos-variable (pattern &optional do-all) + "Show user variables that match PATTERN. +PATTERN can be a word, a list of words (separated by spaces), +or a regexp (using some regexp special characters). If it is a word, +search for matches for that word as a substring. If it is a list of words, +search for matches for any two (or more) of those words. + +With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, also show normal variables." - (interactive (list (read-string - (concat "Apropos " - (if (or current-prefix-arg apropos-do-all) - "variable" - "user option") - " (regexp or words): ")) + (interactive (list (apropos-read-pattern + (if (or current-prefix-arg apropos-do-all) + "variable" "user option")) current-prefix-arg)) - (apropos-command regexp nil + (apropos-command pattern nil (if (or do-all apropos-do-all) #'(lambda (symbol) (and (boundp symbol) @@ -389,21 +423,26 @@ ;;;###autoload (defalias 'command-apropos 'apropos-command) ;;;###autoload -(defun apropos-command (apropos-regexp &optional do-all var-predicate) - "Show commands (interactively callable functions) that match APROPOS-REGEXP. -With optional prefix DO-ALL, or if `apropos-do-all' is non-nil, also show +(defun apropos-command (pattern &optional do-all var-predicate) + "Show commands (interactively callable functions) that match PATTERN. +PATTERN can be a word, a list of words (separated by spaces), +or a regexp (using some regexp special characters). If it is a word, +search for matches for that word as a substring. If it is a list of words, +search for matches for any two (or more) of those words. + +With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, also show noninteractive functions. If VAR-PREDICATE is non-nil, show only variables, and only those that -satisfy the predicate VAR-PREDICATE." - (interactive (list (read-string (concat - "Apropos command " - (if (or current-prefix-arg - apropos-do-all) - "or function ") - "(regexp or words): ")) +satisfy the predicate VAR-PREDICATE. + +When called from a Lisp program, a string PATTERN is used as a regexp, +while a list of strings is used as a word list." + (interactive (list (apropos-read-pattern + (if (or current-prefix-arg apropos-do-all) + "command or function" "command")) current-prefix-arg)) - (setq apropos-regexp (apropos-rewrite-regexp apropos-regexp)) + (setq apropos-regexp (apropos-parse-pattern pattern)) (let ((message (let ((standard-output (get-buffer-create "*Apropos*"))) (print-help-return-message 'identity)))) @@ -441,7 +480,7 @@ (string-match "\n" doc))))))) (setcar (cdr (car p)) score) (setq p (cdr p)))) - (and (apropos-print t nil) + (and (apropos-print t nil nil t) message (message "%s" message)))) @@ -457,13 +496,19 @@ ;;;###autoload -(defun apropos (apropos-regexp &optional do-all) - "Show all bound symbols whose names match APROPOS-REGEXP. -With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also +(defun apropos (pattern &optional do-all) + "Show all bound symbols whose names match PATTERN. +PATTERN can be a word, a list of words (separated by spaces), +or a regexp (using some regexp special characters). If it is a word, +search for matches for that word as a substring. If it is a list of words, +search for matches for any two (or more) of those words. + +With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, also show unbound symbols and key bindings, which is a little more time-consuming. Returns list of symbols and documentation found." - (interactive "sApropos symbol (regexp or words): \nP") - (setq apropos-regexp (apropos-rewrite-regexp apropos-regexp)) + (interactive (list (apropos-read-pattern "symbol") + current-prefix-arg)) + (setq apropos-regexp (apropos-parse-pattern pattern)) (apropos-symbols-internal (apropos-internal apropos-regexp (and (not do-all) @@ -520,13 +565,19 @@ ;;;###autoload -(defun apropos-value (apropos-regexp &optional do-all) - "Show all symbols whose value's printed image matches APROPOS-REGEXP. -With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also looks +(defun apropos-value (pattern &optional do-all) + "Show all symbols whose value's printed image matches PATTERN. +PATTERN can be a word, a list of words (separated by spaces), +or a regexp (using some regexp special characters). If it is a word, +search for matches for that word as a substring. If it is a list of words, +search for matches for any two (or more) of those words. + +With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, also looks at the function and at the names and values of properties. Returns list of symbols and values found." - (interactive "sApropos value (regexp or words): \nP") - (setq apropos-regexp (apropos-rewrite-regexp apropos-regexp)) + (interactive (list (apropos-read-pattern "value") + current-prefix-arg)) + (setq apropos-regexp (apropos-parse-pattern pattern)) (or do-all (setq do-all apropos-do-all)) (setq apropos-accumulator ()) (let (f v p) @@ -534,7 +585,7 @@ (lambda (symbol) (setq f nil v nil p nil) (or (memq symbol '(apropos-regexp - apropos-orig-regexp apropos-all-regexp + apropos-pattern apropos-all-words-regexp apropos-words apropos-all-words do-all apropos-accumulator symbol f v p)) @@ -559,17 +610,24 @@ ;;;###autoload -(defun apropos-documentation (apropos-regexp &optional do-all) - "Show symbols whose documentation contain matches for APROPOS-REGEXP. -With optional prefix DO-ALL or if `apropos-do-all' is non-nil, also use +(defun apropos-documentation (pattern &optional do-all) + "Show symbols whose documentation contain matches for PATTERN. +PATTERN can be a word, a list of words (separated by spaces), +or a regexp (using some regexp special characters). If it is a word, +search for matches for that word as a substring. If it is a list of words, +search for matches for any two (or more) of those words. + +With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, also use documentation that is not stored in the documentation file and show key bindings. Returns list of symbols and documentation found." - (interactive "sApropos documentation (regexp or words): \nP") - (setq apropos-regexp (apropos-rewrite-regexp apropos-regexp)) + (interactive (list (apropos-read-pattern "documentation") + current-prefix-arg)) + (setq apropos-regexp (apropos-parse-pattern pattern)) (or do-all (setq do-all apropos-do-all)) (setq apropos-accumulator () apropos-files-scanned ()) (let ((standard-input (get-buffer-create " apropos-temp")) + (apropos-sort-by-scores apropos-documentation-sort-by-scores) f v sf sv) (unwind-protect (save-excursion @@ -602,7 +660,7 @@ (+ (apropos-score-symbol symbol 2) sf sv) f v) apropos-accumulator))))))) - (apropos-print nil "\n----------------\n")) + (apropos-print nil "\n----------------\n" nil t)) (kill-buffer standard-input)))) @@ -621,16 +679,17 @@ (defun apropos-documentation-internal (doc) (if (consp doc) (apropos-documentation-check-elc-file (car doc)) - (and doc - (string-match apropos-all-regexp doc) - (save-match-data (apropos-true-hit-doc doc)) - (progn - (if apropos-match-face - (put-text-property (match-beginning 0) - (match-end 0) - 'face apropos-match-face - (setq doc (copy-sequence doc)))) - doc)))) + (if (and doc + (string-match apropos-all-words-regexp doc) + (apropos-true-hit-doc doc)) + (when apropos-match-face + (setq doc (substitute-command-keys (copy-sequence doc))) + (if (or (string-match apropos-pattern-quoted doc) + (string-match apropos-all-words-regexp doc)) + (put-text-property (match-beginning 0) + (match-end 0) + 'face apropos-match-face doc)) + doc)))) (defun apropos-format-plist (pl sep &optional compare) (setq pl (symbol-plist pl)) @@ -656,7 +715,7 @@ ;; Finds all documentation related to APROPOS-REGEXP in internal-doc-file-name. (defun apropos-documentation-check-doc-file () - (let (type symbol (sepa 2) sepb beg end) + (let (type symbol (sepa 2) sepb) (insert ?\^_) (backward-char) (insert-file-contents (concat doc-directory internal-doc-file-name)) @@ -667,30 +726,31 @@ (beginning-of-line 2) (if (save-restriction (narrow-to-region (point) (1- sepb)) - (re-search-forward apropos-all-regexp nil t)) + (re-search-forward apropos-all-words-regexp nil t)) (progn - (setq beg (match-beginning 0) - end (point)) (goto-char (1+ sepa)) (setq type (if (eq ?F (preceding-char)) 2 ; function documentation 3) ; variable documentation symbol (read) - beg (- beg (point) 1) - end (- end (point) 1) doc (buffer-substring (1+ (point)) (1- sepb))) (when (apropos-true-hit-doc doc) (or (and (setq apropos-item (assq symbol apropos-accumulator)) (setcar (cdr apropos-item) - (+ (cadr apropos-item) (apropos-score-doc doc)))) + (apropos-score-doc doc))) (setq apropos-item (list symbol (+ (apropos-score-symbol symbol 2) (apropos-score-doc doc)) nil nil) apropos-accumulator (cons apropos-item apropos-accumulator))) - (if apropos-match-face - (put-text-property beg end 'face apropos-match-face doc)) + (when apropos-match-face + (setq doc (substitute-command-keys doc)) + (if (or (string-match apropos-pattern-quoted doc) + (string-match apropos-all-words-regexp doc)) + (put-text-property (match-beginning 0) + (match-end 0) + 'face apropos-match-face doc))) (setcar (nthcdr type apropos-item) doc)))) (setq sepa (goto-char sepb))))) @@ -710,7 +770,7 @@ (if (save-restriction ;; match ^ and $ relative to doc string (narrow-to-region beg end) - (re-search-forward apropos-all-regexp nil t)) + (re-search-forward apropos-all-words-regexp nil t)) (progn (goto-char (+ end 2)) (setq doc (buffer-substring beg end) @@ -738,9 +798,13 @@ nil nil) apropos-accumulator (cons apropos-item apropos-accumulator))) - (if apropos-match-face - (put-text-property beg end 'face apropos-match-face - doc)) + (when apropos-match-face + (setq doc (substitute-command-keys doc)) + (if (or (string-match apropos-pattern-quoted doc) + (string-match apropos-all-words-regexp doc)) + (put-text-property (match-beginning 0) + (match-end 0) + 'face apropos-match-face doc))) (setcar (nthcdr (if this-is-a-variable 3 2) apropos-item) doc)))))))))) @@ -770,7 +834,7 @@ function)) -(defun apropos-print (do-keys spacing &optional text) +(defun apropos-print (do-keys spacing &optional text nosubst) "Output result of apropos searching into buffer `*Apropos*'. The value of `apropos-accumulator' is the list of items to output. Each element should have the format @@ -782,7 +846,7 @@ If SPACING is non-nil, it should be a string; separate items with that string. If non-nil TEXT is a string that will be printed as a heading." (if (null apropos-accumulator) - (message "No apropos matches for `%s'" apropos-orig-regexp) + (message "No apropos matches for `%s'" apropos-pattern) (setq apropos-accumulator (sort apropos-accumulator (lambda (a b) @@ -816,13 +880,20 @@ (setq apropos-item (car p) symbol (car apropos-item) p (cdr p)) + ;; Insert dummy score element for backwards compatibility with 21.x + ;; apropos-item format. + (if (not (numberp (cadr apropos-item))) + (setq apropos-item + (cons (car apropos-item) + (cons nil (cdr apropos-item))))) (insert-text-button (symbol-name symbol) 'type 'apropos-symbol ;; Can't use default, since user may have ;; changed the variable! ;; Just say `no' to variables containing faces! 'face apropos-symbol-face) - (if apropos-sort-by-scores + (if (and (eq apropos-sort-by-scores 'verbose) + (cadr apropos-item)) (insert " (" (number-to-string (cadr apropos-item)) ") ")) ;; Calculate key-bindings if we want them. (and do-keys @@ -874,8 +945,8 @@ (if (apropos-macrop symbol) 'apropos-macro 'apropos-function)) - t) - (apropos-print-doc 3 'apropos-variable t) + (not nosubst)) + (apropos-print-doc 3 'apropos-variable (not nosubst)) (apropos-print-doc 7 'apropos-group t) (apropos-print-doc 6 'apropos-face t) (apropos-print-doc 5 'apropos-widget t)
--- a/lisp/bookmark.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/bookmark.el Fri Nov 18 13:13:34 2005 +0000 @@ -717,6 +717,14 @@ ;;; end file-format stuff +;;; Generic helpers. + +(defun bookmark-maybe-message (fmt &rest args) + "Apply `message' to FMT and ARGS, but only if the display is fast enough." + (if (>= baud-rate 9600) + (apply 'message fmt args))) + + ;;; Core code: ;;;###autoload @@ -1350,14 +1358,12 @@ (defun bookmark-write-file (file) (save-excursion (save-window-excursion - (if (>= baud-rate 9600) - (message "Saving bookmarks to file %s..." file)) - (set-buffer (let ((enable-local-variables nil)) - (find-file-noselect file))) + (bookmark-maybe-message "Saving bookmarks to file %s..." file) + (set-buffer (get-buffer-create " *Bookmarks*")) (goto-char (point-min)) + (delete-region (point-min) (point-max)) (let ((print-length nil) (print-level nil)) - (delete-region (point-min) (point-max)) (bookmark-insert-file-format-version-stamp) (pp bookmark-alist (current-buffer)) (let ((version-control @@ -1368,11 +1374,11 @@ (t t)))) (condition-case nil - (write-file file) + (write-region (point-min) (point-max) file) (file-error (message "Can't write %s" file))) (kill-buffer (current-buffer)) - (if (>= baud-rate 9600) - (message "Saving bookmarks to file %s...done" file))))))) + (bookmark-maybe-message + "Saving bookmarks to file %s...done" file)))))) (defun bookmark-import-new-list (new-list) @@ -1438,8 +1444,8 @@ (if (file-readable-p file) (save-excursion (save-window-excursion - (if (and (null no-msg) (>= baud-rate 9600)) - (message "Loading bookmarks from %s..." file)) + (if (null no-msg) + (bookmark-maybe-message "Loading bookmarks from %s..." file)) (set-buffer (let ((enable-local-variables nil)) (find-file-noselect file))) (goto-char (point-min)) @@ -1462,8 +1468,8 @@ (bookmark-bmenu-surreptitiously-rebuild-list)) (error "Invalid bookmark list in %s" file))) (kill-buffer (current-buffer))) - (if (and (null no-msg) (>= baud-rate 9600)) - (message "Loading bookmarks from %s...done" file))) + (if (null no-msg) + (bookmark-maybe-message "Loading bookmarks from %s...done" file))) (error "Cannot read bookmark file %s" file)))
--- a/lisp/calc/calc-alg.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/calc/calc-alg.el Fri Nov 18 13:13:34 2005 +0000 @@ -92,30 +92,39 @@ (and n (list (prefix-numeric-value n))))))) ;;; Write out powers (a*b*...)^n as a*b*...*a*b*... -(defun calcFunc-writeoutpower (expr) - (math-normalize (math-map-tree 'math-write-out-power expr))) +(defun calcFunc-powerexpand (expr) + (math-normalize (math-map-tree 'math-powerexpand expr))) -(defun math-write-out-power (expr) +(defun math-powerexpand (expr) (if (eq (car-safe expr) '^) - (let ((a (nth 1 expr)) - (n (nth 2 expr)) - (prod (nth 1 expr)) - (i 1)) - (if (and (integerp n) - (> n 0)) - (progn - (while (< i n) - (setq prod (math-mul prod a)) - (setq i (1+ i))) - prod) - expr)) + (let ((n (nth 2 expr))) + (cond ((and (integerp n) + (> n 0)) + (let ((i 1) + (a (nth 1 expr)) + (prod (nth 1 expr))) + (while (< i n) + (setq prod (math-mul prod a)) + (setq i (1+ i))) + prod)) + ((and (integerp n) + (< n 0)) + (let ((i -1) + (a (math-pow (nth 1 expr) -1)) + (prod (math-pow (nth 1 expr) -1))) + (while (> i n) + (setq prod (math-mul a prod)) + (setq i (1- i))) + prod)) + (t + expr))) expr)) -(defun calc-writeoutpower () +(defun calc-powerexpand () (interactive) (calc-slow-wrapper - (calc-enter-result 1 "expp" - (calcFunc-writeoutpower (calc-top-n 1))))) + (calc-enter-result 1 "pexp" + (calcFunc-powerexpand (calc-top-n 1))))) (defun calc-collect (&optional var) (interactive "sCollect terms involving: ")
--- a/lisp/calc/calc-arith.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/calc/calc-arith.el Fri Nov 18 13:13:34 2005 +0000 @@ -374,6 +374,13 @@ t) ((eq (car-safe a) '^) (math-check-known-square-matrixp (nth 1 a))) + ((or + (eq (car-safe a) '*) + (eq (car-safe a) '+) + (eq (car-safe a) '-)) + (and + (math-check-known-square-matrixp (nth 1 a)) + (math-check-known-square-matrixp (nth 2 a)))) (t (let ((decl (if (eq (car a) 'var) (or (assq (nth 2 a) math-decls-cache) @@ -1847,6 +1854,11 @@ (math-mul-zero b a)))) (list '/ a b))) +;;; Division from the left. +(defun calcFunc-ldiv (a b) + (if (math-known-scalarp a) + (math-div b a) + (math-mul (math-pow a -1) b))) (defun calcFunc-mod (a b) (math-normalize (list '% a b))) @@ -1960,7 +1972,8 @@ (if (and (= b -1) (math-known-square-matrixp (nth 1 a)) (math-known-square-matrixp (nth 2 a))) - (list '* (list '^ (nth 2 a) -1) (list '^ (nth 1 a) -1)) + (math-mul (math-pow-fancy (nth 2 a) -1) + (math-pow-fancy (nth 1 a) -1)) (list '^ a b))) ((and (eq (car-safe a) '*) (or (math-known-num-integerp b)
--- a/lisp/calc/calc-ext.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/calc/calc-ext.el Fri Nov 18 13:13:34 2005 +0000 @@ -659,7 +659,7 @@ ("calc-alg" calc-has-rules math-defsimplify calc-modify-simplify-mode calcFunc-collect calcFunc-esimplify calcFunc-islin calcFunc-islinnt calcFunc-lin calcFunc-linnt -calcFunc-simplify calcFunc-subst calcFunc-writeoutpower math-beforep +calcFunc-simplify calcFunc-subst calcFunc-powerexpand math-beforep math-build-polynomial-expr math-expand-formula math-expr-contains math-expr-contains-count math-expr-depends math-expr-height math-expr-subst math-expr-weight math-integer-plus math-is-linear @@ -694,7 +694,7 @@ calcFunc-dpos calcFunc-drange calcFunc-drat calcFunc-dreal calcFunc-dscalar calcFunc-fceil calcFunc-ffloor calcFunc-float calcFunc-fround calcFunc-frounde calcFunc-froundu calcFunc-ftrunc -calcFunc-idiv calcFunc-incr calcFunc-mant calcFunc-max calcFunc-min +calcFunc-idiv calcFunc-incr calcFunc-ldiv calcFunc-mant calcFunc-max calcFunc-min calcFunc-mod calcFunc-mul calcFunc-neg calcFunc-percent calcFunc-pow calcFunc-relch calcFunc-round calcFunc-rounde calcFunc-roundu calcFunc-scf calcFunc-sub calcFunc-xpon math-abs math-abs-approx @@ -923,7 +923,7 @@ ("calc-alg" calc-alg-evaluate calc-apart calc-collect calc-expand calc-expand-formula calc-factor calc-normalize-rat calc-poly-div calc-poly-div-rem calc-poly-gcd calc-poly-rem calc-simplify -calc-simplify-extended calc-substitute calc-writeoutpower) +calc-simplify-extended calc-substitute calc-powerexpand) ("calcalg2" calc-alt-summation calc-derivative calc-dump-integral-cache calc-integral calc-num-integral
--- a/lisp/calc/calc-units.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/calc/calc-units.el Fri Nov 18 13:13:34 2005 +0000 @@ -911,6 +911,11 @@ (defvar math-cu-pure) (defun math-convert-units (expr math-cu-new-units &optional math-cu-pure) + (if (eq (car-safe math-cu-new-units) 'var) + (let ((unew (assq (nth 1 math-cu-new-units) + (math-build-units-table)))) + (if (eq (car-safe (nth 1 unew)) '+) + (setq math-cu-new-units (nth 1 unew))))) (math-with-extra-prec 2 (let ((compat (and (not math-cu-pure) (math-find-compatible-unit expr math-cu-new-units)))
--- a/lisp/calc/calc.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/calc/calc.el Fri Nov 18 13:13:34 2005 +0000 @@ -2027,6 +2027,10 @@ (calc-slow-wrapper (calc-binary-op "/" 'calcFunc-div arg 0 'calcFunc-inv '/))) +(defun calc-left-divide (arg) + (interactive "P") + (calc-slow-wrapper + (calc-binary-op "ldiv" 'calcFunc-ldiv arg 0 nil nil))) (defun calc-change-sign (arg) (interactive "P")
--- a/lisp/calendar/diary-lib.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/calendar/diary-lib.el Fri Nov 18 13:13:34 2005 +0000 @@ -378,7 +378,7 @@ (or (verify-visited-file-modtime diary-buffer) (revert-buffer t t)))) ;; Setup things like the header-line-format and invisibility-spec. - (when (eq major-mode 'fundamental-mode) (diary-mode)) + (when (eq major-mode default-major-mode) (diary-mode)) ;; d-s-p is passed to the diary display function. (let ((diary-saved-point (point))) (save-excursion @@ -452,7 +452,8 @@ 2)) (while (looking-at " \\|\^I") (re-search-forward "\^M\\|\n" nil 'move)) - (unless (eobp) (backward-char 1)) + (unless (and (eobp) (not (bolp))) + (backward-char 1)) (unless list-only (remove-overlays date-start (point) 'invisible 'diary)) @@ -773,7 +774,7 @@ (pop-up-frames (window-dedicated-p (selected-window)))) (with-current-buffer (or (find-buffer-visiting d-file) (find-file-noselect d-file t)) - (when (eq major-mode 'fundamental-mode) (diary-mode)) + (when (eq major-mode default-major-mode) (diary-mode)) (diary-unhide-everything) (display-buffer (current-buffer))))) @@ -876,7 +877,7 @@ file-glob-attrs marks) (with-current-buffer (find-file-noselect (diary-check-diary-file) t) (save-excursion - (when (eq major-mode 'fundamental-mode) (diary-mode)) + (when (eq major-mode default-major-mode) (diary-mode)) (setq mark-diary-entries-in-calendar t) (message "Marking diary entries...") (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) @@ -1671,7 +1672,7 @@ `diary-file'." (let ((pop-up-frames (window-dedicated-p (selected-window)))) (find-file-other-window (substitute-in-file-name (or file diary-file)))) - (when (eq major-mode 'fundamental-mode) (diary-mode)) + (when (eq major-mode default-major-mode) (diary-mode)) (widen) (diary-unhide-everything) (goto-char (point-max))
--- a/lisp/cus-dep.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/cus-dep.el Fri Nov 18 13:13:34 2005 +0000 @@ -79,54 +79,46 @@ (message "Generating %s..." generated-custom-dependencies-file) (set-buffer (find-file-noselect generated-custom-dependencies-file)) (erase-buffer) - (insert "\ -;;; " (file-name-nondirectory generated-custom-dependencies-file) + (insert ";;; " (file-name-nondirectory generated-custom-dependencies-file) " --- automatically extracted custom dependencies -;; -;;; Code: +;;\n;;; Code: ") (mapatoms (lambda (symbol) (let ((members (get symbol 'custom-group)) - item where found) + where found) (when members - ;; So x and no-x builds won't differ. - (setq members - (sort (copy-sequence members) - (lambda (x y) (string< (car x) (car y))))) - (while members - (setq item (car (car members)) - members (cdr members) - where (get item 'custom-where)) + (dolist (member + ;; So x and no-x builds won't differ. + (sort (mapcar 'car members) 'string<)) + (setq where (get member 'custom-where)) (unless (or (null where) (member where found)) - (if found - (insert " ") - (insert "(put '" (symbol-name symbol) - " 'custom-loads '(")) - (prin1 where (current-buffer)) (push where found))) (when found - (insert "))\n")))))) + (insert "(put '" (symbol-name symbol) + " 'custom-loads '") + (prin1 (nreverse found) (current-buffer)) + (insert ")\n")))))) (insert "\ -;;; These are for handling :version. We need to have a minimum of -;;; information so `customize-changed-options' could do its job. +;; These are for handling :version. We need to have a minimum of +;; information so `customize-changed-options' could do its job. -;;; For groups we set `custom-version', `group-documentation' and -;;; `custom-tag' (which are shown in the customize buffer), so we -;;; don't have to load the file containing the group. +;; For groups we set `custom-version', `group-documentation' and +;; `custom-tag' (which are shown in the customize buffer), so we +;; don't have to load the file containing the group. -;;; `custom-versions-load-alist' is an alist that has as car a version -;;; number and as elts the files that have variables or faces that -;;; contain that version. These files should be loaded before showing -;;; the customization buffer that `customize-changed-options' -;;; generates. +;; `custom-versions-load-alist' is an alist that has as car a version +;; number and as elts the files that have variables or faces that +;; contain that version. These files should be loaded before showing +;; the customization buffer that `customize-changed-options' +;; generates. -;;; This macro is used so we don't modify the information about -;;; variables and groups if it's already set. (We don't know when -;;; " (file-name-nondirectory generated-custom-dependencies-file) +;; This macro is used so we don't modify the information about +;; variables and groups if it's already set. (We don't know when +;; " (file-name-nondirectory generated-custom-dependencies-file) " is going to be loaded and at that time some of the -;;; files might be loaded and some others might not). +;; files might be loaded and some others might not). \(defmacro custom-put-if-not (symbol propname value) `(unless (get ,symbol ,propname) (put ,symbol ,propname ,value))) @@ -175,12 +167,13 @@ \(provide '" (file-name-sans-extension (file-name-nondirectory generated-custom-dependencies-file)) ") -;;; Local Variables: -;;; version-control: never -;;; no-byte-compile: t -;;; no-update-autoloads: t -;;; End: -;;; " (file-name-nondirectory generated-custom-dependencies-file) " ends here\n") +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End:\n;;; " + (file-name-nondirectory generated-custom-dependencies-file) + " ends here\n") (let ((kept-new-versions 10000000)) (save-buffer)) (message "Generating %s...done" generated-custom-dependencies-file) @@ -188,5 +181,5 @@ -;;; arch-tag: b7b6421a-bf7a-44fd-a382-6f44976bdf68 +;; arch-tag: b7b6421a-bf7a-44fd-a382-6f44976bdf68 ;;; cus-dep.el ends here
--- a/lisp/cus-edit.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/cus-edit.el Fri Nov 18 13:13:34 2005 +0000 @@ -493,11 +493,12 @@ (let ((v (variable-at-point)) (enable-recursive-minibuffers t) val) - (setq val (completing-read - (if (and (symbolp v) (custom-variable-p v)) - (format "Customize option (default %s): " v) - "Customize option: ") - obarray 'custom-variable-p t)) + (setq val (if (and (symbolp v) (custom-variable-p v)) + (completing-read + (format "Customize option (default %s): " v) obarray + 'custom-variable-p t nil nil (symbol-name v)) + (completing-read "Customize option: " obarray + 'custom-variable-p t))) (list (if (equal val "") (if (symbolp v) v nil) (intern val))))) @@ -798,7 +799,8 @@ (interactive) (let ((children custom-options)) (mapc (lambda (widget) - (and (widget-apply widget :custom-standard-value) + (and (widget-get widget :custom-standard-value) + (widget-apply widget :custom-standard-value) (if (memq (widget-get widget :custom-state) '(modified set changed saved rogue)) (widget-apply widget :custom-reset-standard)))) @@ -2123,7 +2125,7 @@ (defun custom-add-parent-links (widget &optional initial-string) "Add \"Parent groups: ...\" to WIDGET if the group has parents. -The value if non-nil if any parents were found. +The value is non-nil if any parents were found. If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." (let ((name (widget-value widget)) (type (widget-type widget)) @@ -2132,15 +2134,14 @@ (parents nil)) (insert (or initial-string "Parent groups:")) (mapatoms (lambda (symbol) - (let ((entry (assq name (get symbol 'custom-group)))) - (when (eq (nth 1 entry) type) - (insert " ") - (push (widget-create-child-and-convert - widget 'custom-group-link - :tag (custom-unlispify-tag-name symbol) - symbol) - buttons) - (setq parents (cons symbol parents)))))) + (when (member (list name type) (get symbol 'custom-group)) + (insert " ") + (push (widget-create-child-and-convert + widget 'custom-group-link + :tag (custom-unlispify-tag-name symbol) + symbol) + buttons) + (setq parents (cons symbol parents))))) (and (null (get name 'custom-links)) ;No links of its own. (= (length parents) 1) ;A single parent. (let* ((links (get (car parents) 'custom-links)) @@ -3397,7 +3398,7 @@ (define-widget 'face 'symbol "A Lisp face name (with sample)." - :format "%t: (%{sample%}) %v" + :format "%{%t%}: (%{sample%}) %v" :tag "Face" :value 'default :sample-face-get 'widget-face-sample-face-get
--- a/lisp/dired-x.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/dired-x.el Fri Nov 18 13:13:34 2005 +0000 @@ -112,6 +112,7 @@ (require 'dired-aux) (defvar vm-folder-directory) +(eval-when-compile (require 'man)) ;;; User-defined variables. @@ -1411,9 +1412,11 @@ ;;; Run mail on mail folders. -;;; (and (not (fboundp 'vm-visit-folder)) -;;; (defun vm-visit-folder (file &optional arg) -;;; nil)) +;; Avoid compiler warning. +(eval-when-compile + (when (not (fboundp 'vm-visit-folder)) + (defun vm-visit-folder (file &optional arg) + nil))) (defun dired-vm (&optional read-only) "Run VM on this file.
--- a/lisp/disp-table.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/disp-table.el Fri Nov 18 13:13:34 2005 +0000 @@ -229,7 +229,7 @@ ;; unless some other has been specified. (if (equal current-language-environment "English") (set-language-environment "latin-1")) - (unless (or noninteractive (memq window-system '(x w32))) + (unless (or noninteractive (memq window-system '(x w32 mac))) ;; Send those codes literally to a character-based terminal. ;; If we are using single-byte characters, ;; it doesn't matter which coding system we use.
--- a/lisp/ediff-util.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/ediff-util.el Fri Nov 18 13:13:34 2005 +0000 @@ -3173,7 +3173,7 @@ (setq f (concat ediff-temp-file-prefix p) short-f (concat ediff-temp-file-prefix short-p) f (cond (given-file) - ((find-file-name-handler f 'find-file-noselect) + ((find-file-name-handler f 'insert-file-contents) ;; to thwart file handlers in write-region, e.g., if file ;; name ends with .Z or .gz ;; This is needed so that patches produced by ediff will
--- a/lisp/emacs-lisp/autoload.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/emacs-lisp/autoload.el Fri Nov 18 13:13:34 2005 +0000 @@ -568,6 +568,9 @@ (save-buffer)))) +(define-obsolete-function-alias 'update-autoloads-from-directories + 'update-directory-autoloads "22.1") + ;;;###autoload (defun batch-update-autoloads () "Update loaddefs.el autoloads in batch mode.
--- a/lisp/emacs-lisp/byte-opt.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/emacs-lisp/byte-opt.el Fri Nov 18 13:13:34 2005 +0000 @@ -545,7 +545,7 @@ (eq (car-safe (nth 2 last)) 'cdr) (eq (cadr (nth 2 last)) var)))) (progn - (byte-compile-warn "`%s' called for effect" + (byte-compile-warn "value returned by `%s' is not used" (prin1-to-string (car form))) nil))) (byte-compile-log " %s called for effect; deleted" fn)
--- a/lisp/emacs-lisp/derived.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/emacs-lisp/derived.el Fri Nov 18 13:13:34 2005 +0000 @@ -194,7 +194,12 @@ parent child docstring syntax abbrev)) `(progn - (defvar ,hook nil ,(format "Hook run when entering %s mode." name)) + (unless (get ',hook 'variable-documentation) + (put ',hook 'variable-documentation + ,(format "Hook run when entering %s mode. +No problems result if this variable is not bound. +`add-hook' automatically binds it. (This is true for all hook variables.)" + name))) (defvar ,map (make-sparse-keymap)) ,(if declare-syntax `(defvar ,syntax (make-syntax-table)))
--- a/lisp/emacs-lisp/lisp-mode.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/emacs-lisp/lisp-mode.el Fri Nov 18 13:13:34 2005 +0000 @@ -233,8 +233,6 @@ (setq comment-column 40) ;; Don't get confused by `;' in doc strings when paragraph-filling. (set (make-local-variable 'comment-use-global-state) t) - (make-local-variable 'comment-indent-function) - (setq comment-indent-function 'lisp-comment-indent) (make-local-variable 'imenu-generic-expression) (setq imenu-generic-expression lisp-imenu-generic-expression) (make-local-variable 'multibyte-syntax-as-symbol) @@ -746,17 +744,9 @@ (unless (eq old-value new-value) (setq debug-on-error new-value)) value))))) - -;; Used for comment-indent-function in Lisp modes. -(defun lisp-comment-indent () - (if (looking-at "\\s<\\s<\\s<") - (current-column) - (if (looking-at "\\s<\\s<") - (let ((tem (or (calculate-lisp-indent) (current-column)))) - (if (listp tem) (car tem) tem)) - (skip-chars-backward " \t") - (max (if (bolp) 0 (1+ (current-column))) - comment-column)))) + +;; May still be used by some external Lisp-mode variant. +(define-obsolete-function-alias 'lisp-comment-indent 'comment-indent-default) ;; This function just forces a more costly detection of comments (using ;; parse-partial-sexp from beginning-of-defun). I.e. It avoids the problem of
--- a/lisp/emulation/viper-util.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/emulation/viper-util.el Fri Nov 18 13:13:34 2005 +0000 @@ -1242,8 +1242,12 @@ ;; Characters that should not be considered as part of the word, in reformed-vi ;; syntax mode. +;; Note: \\ (quoted \) must appear before `-' because this string is listified +;; into characters at some point and then put back to string. The result is +;; used in skip-chars-forward, which treats - specially. Here we achieve the +;; effect of quoting - and preventing it from being special. (defconst viper-non-word-characters-reformed-vi - "!@#$%^&*()-+=|\\~`{}[];:'\",<.>/?") + "!@#$%^&*()\\-+=|\\~`{}[];:'\",<.>/?") ;; These are characters that are not to be considered as parts of a word in ;; Viper. ;; Set each time state changes and at loading time
--- a/lisp/emulation/viper.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/emulation/viper.el Fri Nov 18 13:13:34 2005 +0000 @@ -440,6 +440,8 @@ Buffer-menu-mode compilation-mode + rcirc-mode + view-mode vm-mode vm-summary-mode)
--- a/lisp/files.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/files.el Fri Nov 18 13:13:34 2005 +0000 @@ -2717,7 +2717,10 @@ (and buffer-file-name (file-writable-p buffer-file-name) (setq buffer-read-only nil)) - (save-buffer)) + (save-buffer) + ;; It's likely that the VC status at the new location is different from + ;; the one at the old location. + (vc-find-file-hook)) (defun backup-buffer () "Make a backup of the disk file visited by the current buffer, if appropriate.
--- a/lisp/find-lisp.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/find-lisp.el Fri Nov 18 13:13:34 2005 +0000 @@ -3,7 +3,7 @@ ;; Author: Peter Breton ;; Created: Fri Mar 26 1999 ;; Keywords: unix -;; Time-stamp: <2001-07-16 12:42:35 pavel> +;; Time-stamp: <2005-11-11 20:37:50 teirllm> ;; Copyright (C) 1999, 2000, 2002, 2003, 2004, ;; 2005 Free Software Foundation, Inc. @@ -46,6 +46,8 @@ ;;; Code: +(require 'dired) + (defvar dired-buffers) (defvar dired-subdir-alist) @@ -198,8 +200,7 @@ (regexp find-lisp-regexp)) ;; Expand DIR ("" means default-directory), and make sure it has a ;; trailing slash. - (setq dir (abbreviate-file-name - (file-name-as-directory (expand-file-name dir)))) + (setq dir (file-name-as-directory (expand-file-name dir))) ;; Check that it's really a directory. (or (file-directory-p dir) (error "find-dired needs a directory: %s" dir)) @@ -292,7 +293,7 @@ (defun find-lisp-find-dired-insert-file (file buffer) (set-buffer buffer) (insert find-lisp-line-indent - (find-lisp-format file (file-attributes file) (list "") + (find-lisp-format file (file-attributes file 'string) (list "") (current-time)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -308,18 +309,16 @@ (if (memq ?s switches) ; size in K (format "%4d " (1+ (/ (nth 7 file-attr) 1024)))) (nth 8 file-attr) ; permission bits - ;; numeric uid/gid are more confusing than helpful - ;; Emacs should be able to make strings of them. - ;; user-login-name and user-full-name could take an - ;; optional arg. (format " %3d %-8s %-8s %8d " (nth 1 file-attr) ; no. of links - (if (= (user-uid) (nth 2 file-attr)) - (user-login-name) - (int-to-string (nth 2 file-attr))) ; uid + (if (numberp (nth 2 file-attr)) + (int-to-string (nth 2 file-attr)) + (nth 2 file-attr)) ; uid (if (eq system-type 'ms-dos) "root" ; everything is root on MSDOS. - (int-to-string (nth 3 file-attr))) ; gid + (if (numberp (nth 3 file-attr)) + (int-to-string (nth 3 file-attr)) + (nth 3 file-attr))) ; gid (nth 7 file-attr) ; size in bytes ) (find-lisp-format-time file-attr switches now)
--- a/lisp/font-core.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/font-core.el Fri Nov 18 13:13:34 2005 +0000 @@ -295,7 +295,8 @@ global-font-lock-mode font-lock-mode turn-on-font-lock-if-enabled :extra-args (dummy) :initialize 'custom-initialize-safe-default - :init-value (not (or noninteractive emacs-basic-display))) + :init-value (not (or noninteractive emacs-basic-display)) + :version "22.1") ;;; End of Global Font Lock mode.
--- a/lisp/gnus/ChangeLog Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/gnus/ChangeLog Fri Nov 18 13:13:34 2005 +0000 @@ -1,3 +1,23 @@ +2005-11-09 Katsumi Yamaoka <yamaoka@jpl.org> + + * message.el (message-generate-headers): Downcase the argument + given to message-check-element. + +2005-11-01 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus.el (gnus-parameters-case-fold-search): New variable. + (gnus-parameters-get-parameter): Use it. + + * gnus-score.el (gnus-home-score-file): Doc fix. + +2005-11-01 Xavier Maillard <zedek@gnu-rox.org> (tiny change) + + * gnus-score.el (gnus-update-score-entry-dates): Doc fix. + +2005-10-31 Katsumi Yamaoka <yamaoka@jpl.org> + + * mml.el (mml-preview): Doc fix. + 2005-10-27 Reiner Steib <Reiner.Steib@gmx.de> * flow-fill.el (fill-flowed-encode-tests): Restore trailing @@ -391,38 +411,6 @@ (gnus-decode-header-function, gnus-newsgroup-name): * spam-stat.el (gnus-original-article-buffer): Add defvars. -2005-08-31 Juanma Barranquero <lekktu@gmail.com> - - * gnus-art.el (w3m-minor-mode-map): - * gnus-spec.el (gnus-newsrc-file-version): - * gnus-util.el (nnmail-active-file-coding-system) - (gnus-original-article-buffer, gnus-user-agent): - * gnus.el (gnus-ham-process-destinations) - (gnus-parameter-ham-marks-alist) - (gnus-parameter-spam-marks-alist, gnus-spam-autodetect) - (gnus-spam-autodetect-methods, gnus-spam-newsgroup-contents) - (gnus-spam-process-destinations, gnus-spam-process-newsgroups): - * mm-decode.el (gnus-current-window-configuration): - * mm-extern.el (gnus-article-mime-handles): - * mm-url.el (url-current-object, url-package-name) - (url-package-version): - * mm-view.el (gnus-article-mime-handles, gnus-newsgroup-charset) - (smime-keys, w3m-cid-retrieve-function-alist) - (w3m-current-buffer, w3m-display-inline-images) - (w3m-minor-mode-map): - * mml-smime.el (gnus-extract-address-components): - * mml.el (gnus-article-mime-handles, gnus-mouse-2) - (gnus-newsrc-hashtb, message-default-charset) - (message-deletable-headers, message-options) - (message-posting-charset, message-required-mail-headers) - (message-required-news-headers): - * mml1991.el (mc-pgp-always-sign): - * mml2015.el (mc-pgp-always-sign): - * nnheader.el (nnmail-extra-headers): - * rfc1843.el (gnus-decode-encoded-word-function) - (gnus-decode-header-function, gnus-newsgroup-name): - * spam-stat.el (gnus-original-article-buffer): Add defvars. - 2005-08-22 Karl Chen <quarl@cs.berkeley.edu> (tiny change) * gnus-art.el (gnus-treatment-function-alist): Move date-lapsed to
--- a/lisp/gnus/gnus-score.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/gnus/gnus-score.el Fri Nov 18 13:13:34 2005 +0000 @@ -142,7 +142,7 @@ number)) (defcustom gnus-update-score-entry-dates t - "*In non-nil, update matching score entry dates. + "*If non-nil, update matching score entry dates. If this variable is nil, then score entries that provide matches will be expired along with non-matching score entries." :group 'gnus-score-expire @@ -175,7 +175,7 @@ It can be: * A string - This file file will be used as the home score file. + This file will be used as the home score file. * A function The result of this function will be used as the home score file. @@ -186,7 +186,7 @@ The elements in this list can be: * `(regexp file-name ...)' - If the `regexp' matches the group name, the first `file-name' will + If the `regexp' matches the group name, the first `file-name' will be used as the home score file. (Multiple filenames are allowed so that one may use gnus-score-file-single-match-alist to set this variable.)
--- a/lisp/gnus/gnus.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/gnus/gnus.el Fri Nov 18 13:13:34 2005 +0000 @@ -1104,6 +1104,17 @@ :type '(repeat (cons regexp (repeat sexp)))) +(defcustom gnus-parameters-case-fold-search 'default + "If it is t, ignore case of group names specified in `gnus-parameters'. +If it is nil, don't ignore case. If it is `default', which is for the +backward compatibility, use the value of `case-fold-search'." + :version "22.1" + :group 'gnus-group-various + :type '(choice :format "%{%t%}:\n %[Value Menu%] %v" + (const :tag "Use `case-fold-search'" default) + (const nil) + (const t))) + (defvar gnus-group-parameters-more nil) (defmacro gnus-define-group-parameter (param &rest rest) @@ -3722,7 +3733,10 @@ (defun gnus-parameters-get-parameter (group) "Return the group parameters for GROUP from `gnus-parameters'." - (let (params-list) + (let ((case-fold-search (if (eq gnus-parameters-case-fold-search 'default) + case-fold-search + gnus-parameters-case-fold-search)) + params-list) (dolist (elem gnus-parameters) (when (string-match (car elem) group) (setq params-list
--- a/lisp/gnus/message.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/gnus/message.el Fri Nov 18 13:13:34 2005 +0000 @@ -5077,7 +5077,8 @@ ;; The element is a symbol. We insert the value ;; of this symbol, if any. (symbol-value header)) - ((not (message-check-element header)) + ((not (message-check-element + (intern (downcase (symbol-name header))))) ;; We couldn't generate a value for this header, ;; so we just ask the user. (read-from-minibuffer
--- a/lisp/gnus/mml.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/gnus/mml.el Fri Nov 18 13:13:34 2005 +0000 @@ -1102,7 +1102,7 @@ (defun mml-preview (&optional raw) "Display current buffer with Gnus, in a new buffer. -If RAW, don't highlight the article." +If RAW, display a raw encoded MIME message." (interactive "P") (save-excursion (let* ((buf (current-buffer))
--- a/lisp/help-fns.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/help-fns.el Fri Nov 18 13:13:34 2005 +0000 @@ -497,7 +497,11 @@ (format "Describe variable (default %s): " v) "Describe variable: ") - obarray 'boundp t nil nil + obarray + '(lambda (vv) + (or (boundp vv) + (get vv 'variable-documentation))) + t nil nil (if (symbolp v) (symbol-name v)))) (list (if (equal val "") v (intern val)))))
--- a/lisp/help-mode.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/help-mode.el Fri Nov 18 13:13:34 2005 +0000 @@ -384,8 +384,9 @@ (if sym (cond ((match-string 3) ; `variable' &c - (and (boundp sym) ; `variable' doesn't ensure + (and (or (boundp sym) ; `variable' doesn't ensure ; it's actually bound + (get sym 'variable-documentation)) (help-xref-button 8 'help-variable sym))) ((match-string 4) ; `function' &c (and (fboundp sym) ; similarly @@ -406,12 +407,15 @@ (facep sym) (save-match-data (looking-at "[ \t\n]+face\\W"))) (help-xref-button 8 'help-face sym)) - ((and (boundp sym) (fboundp sym)) + ((and (or (boundp sym) + (get sym 'variable-documentation)) + (fboundp sym)) ;; We can't intuit whether to use the ;; variable or function doc -- supply both. (help-xref-button 8 'help-symbol sym)) ((and - (boundp sym) + (or (boundp sym) + (get sym 'variable-documentation)) (or (documentation-property sym 'variable-documentation) @@ -518,7 +522,10 @@ ((or (memq sym '(t nil)) (keywordp sym)) nil) - ((and sym (boundp sym)) + ((and sym + (or (boundp sym) + (get sym + 'variable-documentation))) 'help-variable)))) (when type (help-xref-button 1 type sym))) (goto-char (match-end 1))) @@ -542,7 +549,8 @@ ;; Don't record the current entry in the stack. (setq help-xref-stack-item nil) (describe-function symbol))) - (sdoc (when (boundp symbol) + (sdoc (when (or (boundp symbol) + (get symbol 'variable-documentation)) ;; Don't record the current entry in the stack. (setq help-xref-stack-item nil) (describe-variable symbol)))) @@ -639,7 +647,9 @@ (buffer-substring (point) (progn (skip-syntax-forward "w_") (point))))))) - (when (or (boundp sym) (fboundp sym) (facep sym)) + (when (or (boundp sym) + (get sym 'variable-documentation) + (fboundp sym) (facep sym)) (help-do-xref pos #'help-xref-interned (list sym))))))
--- a/lisp/help.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/help.el Fri Nov 18 13:13:34 2005 +0000 @@ -78,6 +78,8 @@ (define-key help-map "c" 'describe-key-briefly) +(define-key help-map "d" 'apropos-documentation) + (define-key help-map "e" 'view-echo-area-messages) (define-key help-map "f" 'describe-function) @@ -188,15 +190,18 @@ "You have typed %THIS-KEY%, the help character. Type a Help option: \(Use SPC or DEL to scroll through this text. Type \\<help-map>\\[help-quit] to exit the Help command.) -a command-apropos. Give a substring, and see a list of commands - (functions that are interactively callable) that contain - that substring. See also the apropos command. +a command-apropos. Give a list of words or a regexp, to get a list of + commands whose names match (they contain two or more of the words, + or a match for the regexp). See also the apropos command. b describe-bindings. Display table of all key bindings. c describe-key-briefly. Type a command key sequence; it prints the function name that sequence runs. C describe-coding-system. This describes either a specific coding system (if you type its name) or the coding systems currently in use (if you type just RET). +d apropos-documentation. Give a pattern (a list or words or a regexp), and + see a list of functions, variables, and other items whose built-in + doucmentation string matches that pattern. See also the apropos command. e view-echo-area-messages. Show the buffer where the echo-area messages are stored. f describe-function. Type a function name and get its documentation. @@ -606,13 +611,15 @@ (defun describe-key (key &optional untranslated up-event) "Display documentation of the function invoked by KEY. -KEY should be a key sequence--when calling from a program, -pass a string or a vector. -If non-nil UNTRANSLATED is a vector of the untranslated events. -It can also be a number in which case the untranslated events from -the last key hit are used." +KEY can be any kind of a key sequence; it can include keyboard events, +mouse events, and/or menu events. When calling from a program, +pass KEY as a string or a vector. + +If non-nil, UNTRANSLATED is a vector of the correspondinguntranslated events. +It can also be a number, in which case the untranslated events from +the last key sequence entered are used." ;; UP-EVENT is the up-event that was discarded by reading KEY, or nil. - (interactive "kDescribe key: \np\nU") + (interactive "kDescribe key (or click or menu item): \np\nU") (if (numberp untranslated) (setq untranslated (this-single-command-raw-keys))) (save-excursion
--- a/lisp/hi-lock.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/hi-lock.el Fri Nov 18 13:13:34 2005 +0000 @@ -304,8 +304,10 @@ (when (and (not hi-lock-mode-prev) hi-lock-mode) (add-hook 'find-file-hook 'hi-lock-find-file-hook) (add-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook) - (when (eq nil font-lock-defaults) - (setq font-lock-defaults '(nil))) + (if (null (default-value 'font-lock-defaults)) + (setq-default font-lock-defaults '(nil))) + (if (null font-lock-defaults) + (setq font-lock-defaults '(nil))) (unless font-lock-mode (font-lock-mode 1)) (define-key-after menu-bar-edit-menu [hi-lock] @@ -322,6 +324,10 @@ (setq hi-lock-interactive-patterns nil hi-lock-file-patterns nil) (when font-lock-mode (hi-lock-refontify))))) + + (let ((fld (default-value 'font-lock-defaults))) + (if (and fld (listp fld) (null (car fld))) + (setq-default font-lock-defaults (cdr fld)))) (define-key-after menu-bar-edit-menu [hi-lock] nil) (remove-hook 'find-file-hook 'hi-lock-find-file-hook) (remove-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook))))
--- a/lisp/international/ucs-tables.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/international/ucs-tables.el Fri Nov 18 13:13:34 2005 +0000 @@ -2523,9 +2523,9 @@ (when (char-table-p table) (if buffer (with-current-buffer buffer - (set (make-variable-buffer-local 'translation-table-for-input) + (set (make-local-variable 'translation-table-for-input) table)) - (set (make-variable-buffer-local 'translation-table-for-input) + (set (make-local-variable 'translation-table-for-input) table))))))) ;; The minibuffer needs to acquire a `buffer-file-coding-system' for
--- a/lisp/jka-cmpr-hook.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/jka-cmpr-hook.el Fri Nov 18 13:13:34 2005 +0000 @@ -40,8 +40,8 @@ "jka-compr customization." :group 'compression) -;;; I have this defined so that .Z files are assumed to be in unix -;;; compress format; and .gz files, in gzip format, and .bz2 files in bzip fmt. +;; I have this defined so that .Z files are assumed to be in unix +;; compress format; and .gz files, in gzip format, and .bz2 files in bzip fmt. (defcustom jka-compr-compression-info-list ;;[regexp ;; compr-message compr-prog compr-args @@ -158,7 +158,7 @@ jka-compr-compression-info-list "\\|")) -;;; Functions for accessing the return value of jka-compr-get-compression-info +;; Functions for accessing the return value of jka-compr-get-compression-info (defun jka-compr-info-regexp (info) (aref info 0)) (defun jka-compr-info-compress-message (info) (aref info 1)) (defun jka-compr-info-compress-program (info) (aref info 2)) @@ -192,48 +192,38 @@ (setq jka-compr-file-name-handler-entry (cons (jka-compr-build-file-regexp) 'jka-compr-handler)) - (setq file-name-handler-alist (cons jka-compr-file-name-handler-entry - file-name-handler-alist)) - - (setq jka-compr-added-to-file-coding-system-alist nil) + (push jka-compr-file-name-handler-entry file-name-handler-alist) - (mapcar - (function (lambda (x) - ;; Don't do multibyte encoding on the compressed files. - (let ((elt (cons (jka-compr-info-regexp x) - '(no-conversion . no-conversion)))) - (setq file-coding-system-alist - (cons elt file-coding-system-alist)) - (setq jka-compr-added-to-file-coding-system-alist - (cons elt jka-compr-added-to-file-coding-system-alist))) + (dolist (x jka-compr-compression-info-list) + ;; Don't do multibyte encoding on the compressed files. + (let ((elt (cons (jka-compr-info-regexp x) + '(no-conversion . no-conversion)))) + (push elt file-coding-system-alist) + (push elt jka-compr-added-to-file-coding-system-alist)) - (and (jka-compr-info-strip-extension x) - ;; Make entries in auto-mode-alist so that modes - ;; are chosen right according to the file names - ;; sans `.gz'. - (setq auto-mode-alist - (cons (list (jka-compr-info-regexp x) - nil 'jka-compr) - auto-mode-alist)) - ;; Also add these regexps to - ;; inhibit-first-line-modes-suffixes, so that a - ;; -*- line in the first file of a compressed tar - ;; file doesn't override tar-mode. - (setq inhibit-first-line-modes-suffixes - (cons (jka-compr-info-regexp x) - inhibit-first-line-modes-suffixes))))) - jka-compr-compression-info-list) + (and (jka-compr-info-strip-extension x) + ;; Make entries in auto-mode-alist so that modes + ;; are chosen right according to the file names + ;; sans `.gz'. + (push (list (jka-compr-info-regexp x) nil 'jka-compr) auto-mode-alist) + ;; Also add these regexps to + ;; inhibit-first-line-modes-suffixes, so that a + ;; -*- line in the first file of a compressed tar + ;; file doesn't override tar-mode. + (push (jka-compr-info-regexp x) + inhibit-first-line-modes-suffixes))) (setq auto-mode-alist (append auto-mode-alist jka-compr-mode-alist-additions)) ;; Make sure that (load "foo") will find /bla/foo.el.gz. (setq load-suffixes (apply 'append - (mapcar (lambda (suffix) - (cons suffix - (mapcar (lambda (ext) (concat suffix ext)) - jka-compr-load-suffixes))) - load-suffixes)))) + (append (mapcar (lambda (suffix) + (cons suffix + (mapcar (lambda (ext) (concat suffix ext)) + jka-compr-load-suffixes))) + load-suffixes) + (list jka-compr-load-suffixes))))) (defun jka-compr-installed-p () @@ -254,7 +244,7 @@ "Toggle automatic file compression and uncompression. With prefix argument ARG, turn auto compression on if positive, else off. Returns the new status of auto compression (non-nil means on)." - :global t :group 'jka-compr + :global t :init-value t :group 'jka-compr :version "22.1" (let* ((installed (jka-compr-installed-p)) (flag auto-compression-mode)) (cond @@ -277,16 +267,16 @@ (put 'with-auto-compression-mode 'lisp-indent-function 0) -;;; This is what we need to know about jka-compr-handler -;;; in order to decide when to call it. +;; This is what we need to know about jka-compr-handler +;; in order to decide when to call it. (put 'jka-compr-handler 'safe-magic t) (put 'jka-compr-handler 'operations '(byte-compiler-base-file-name write-region insert-file-contents file-local-copy load)) -;;; Turn on the mode. -(auto-compression-mode 1) +;; Turn on the mode. +(when auto-compression-mode (auto-compression-mode 1)) (provide 'jka-cmpr-hook)
--- a/lisp/jka-compr.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/jka-compr.el Fri Nov 18 13:13:34 2005 +0000 @@ -101,6 +101,8 @@ ;;; Code: +(require 'jka-cmpr-hook) + (defcustom jka-compr-shell "sh" "*Shell to be used for calling compression programs. The value of this variable only matters if you want to discard the @@ -119,32 +121,6 @@ (make-variable-buffer-local 'jka-compr-really-do-compress) (put 'jka-compr-really-do-compress 'permanent-local t) -;;; Functions for accessing the return value of jka-compr-get-compression-info -(defun jka-compr-info-regexp (info) (aref info 0)) -(defun jka-compr-info-compress-message (info) (aref info 1)) -(defun jka-compr-info-compress-program (info) (aref info 2)) -(defun jka-compr-info-compress-args (info) (aref info 3)) -(defun jka-compr-info-uncompress-message (info) (aref info 4)) -(defun jka-compr-info-uncompress-program (info) (aref info 5)) -(defun jka-compr-info-uncompress-args (info) (aref info 6)) -(defun jka-compr-info-can-append (info) (aref info 7)) -(defun jka-compr-info-strip-extension (info) (aref info 8)) -(defun jka-compr-info-file-magic-bytes (info) (aref info 9)) - - -(defun jka-compr-get-compression-info (filename) - "Return information about the compression scheme of FILENAME. -The determination as to which compression scheme, if any, to use is -based on the filename itself and `jka-compr-compression-info-list'." - (catch 'compression-info - (let ((case-fold-search nil)) - (mapcar - (function (lambda (x) - (and (string-match (jka-compr-info-regexp x) filename) - (throw 'compression-info x)))) - jka-compr-compression-info-list) - nil))) - (put 'compression-error 'error-conditions '(compression-error file-error error)) @@ -154,8 +130,7 @@ (defun jka-compr-error (prog args infile message &optional errfile) - (let ((errbuf (get-buffer-create " *jka-compr-error*")) - (curbuf (current-buffer))) + (let ((errbuf (get-buffer-create " *jka-compr-error*"))) (with-current-buffer errbuf (widen) (erase-buffer) (insert (format "Error while executing \"%s %s < %s\"\n\n" @@ -270,8 +245,8 @@ (erase-buffer))))) -;;; Support for temp files. Much of this was inspired if not lifted -;;; from ange-ftp. +;; Support for temp files. Much of this was inspired if not lifted +;; from ange-ftp. (defcustom jka-compr-temp-name-template (expand-file-name "jka-com" temporary-file-directory) @@ -563,7 +538,6 @@ (jka-compr-run-real-handler 'file-local-copy (list filename))) (temp-file (jka-compr-make-temp-name t)) (temp-buffer (get-buffer-create " *jka-compr-flc-temp*")) - (notfound nil) local-file) (setq local-file (or local-copy filename)) @@ -611,7 +585,7 @@ (jka-compr-run-real-handler 'file-local-copy (list filename))))) -;;; Support for loading compressed files. +;; Support for loading compressed files. (defun jka-compr-load (file &optional noerror nomessage nosuffix) "Documented as original." @@ -720,17 +694,11 @@ (setq auto-mode-alist (cdr ama))) - (let* ((ama (cons nil file-coding-system-alist)) - (last ama) - entry) - - (while (cdr last) - (setq entry (car (cdr last))) - (if (member entry jka-compr-added-to-file-coding-system-alist) - (setcdr last (cdr (cdr last))) - (setq last (cdr last)))) - - (setq file-coding-system-alist (cdr ama))) + (while jka-compr-added-to-file-coding-system-alist + (setq file-coding-system-alist + (delq (car (member (pop jka-compr-added-to-file-coding-system-alist) + file-coding-system-alist)) + file-coding-system-alist))) ;; Remove the suffixes that were added by jka-compr. (let ((suffixes nil) @@ -742,5 +710,5 @@ (provide 'jka-compr) -;;; arch-tag: 3f15b630-e9a7-46c4-a22a-94afdde86ebc +;; arch-tag: 3f15b630-e9a7-46c4-a22a-94afdde86ebc ;;; jka-compr.el ends here
--- a/lisp/loadup.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/loadup.el Fri Nov 18 13:13:34 2005 +0000 @@ -147,6 +147,7 @@ (load "select"))) (load "emacs-lisp/timer") (load "isearch") +(load "rfn-eshadow") (message "%s" (garbage-collect)) (load "menu-bar")
--- a/lisp/mail/smtpmail.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/mail/smtpmail.el Fri Nov 18 13:13:34 2005 +0000 @@ -365,7 +365,7 @@ (make-directory smtpmail-queue-dir t)) (with-current-buffer buffer-data (erase-buffer) - (insert-buffer tembuf) + (insert-buffer-contents tembuf) (write-file file-data) (set-buffer buffer-elisp) (erase-buffer)
--- a/lisp/man.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/man.el Fri Nov 18 13:13:34 2005 +0000 @@ -923,6 +923,10 @@ If XREF-MAN-TYPE is used as the button type for items in SEE ALSO section. If it is nil, default type, `Man-xref-man-page' is used." + ;; `Man-highlight-references' is used from woman.el, too. + ;; woman.el doesn't set `Man-arguments'. + (unless Man-arguments + (setq Man-arguments "")) (if (string-match "-k " Man-arguments) (progn (Man-highlight-references0
--- a/lisp/menu-bar.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/menu-bar.el Fri Nov 18 13:13:34 2005 +0000 @@ -641,8 +641,7 @@ ;; put on a customized-value property. (dolist (elt '(line-number-mode column-number-mode size-indication-mode cua-mode show-paren-mode transient-mark-mode - global-font-lock-mode blink-cursor-mode - display-time-mode display-battery-mode)) + blink-cursor-mode display-time-mode display-battery-mode)) (and (customize-mark-to-save elt) (setq need-save t))) ;; These are set with `customize-set-variable'. @@ -1053,10 +1052,6 @@ "Active Region Highlighting" "Make text in active region stand out in color (Transient Mark mode)" (:enable (not cua-mode)))) -(define-key menu-bar-options-menu [toggle-global-lazy-font-lock-mode] - (menu-bar-make-mm-toggle global-font-lock-mode - "Syntax Highlighting" - "Colorize text based on language syntax (Global Font Lock mode)")) ;; The "Tools" menu items @@ -1365,9 +1360,8 @@ '(menu-item "Getting New Versions" describe-distribution :help "How to get latest versions of Emacs")) (define-key menu-bar-help-menu [more] - '(menu-item "Find Extra Packages" - menu-bar-help-extra-packages - :help "Where to find some extra packages and possible updates")) + '(menu-item "External Packages" menu-bar-help-extra-packages + :help "Lisp packages distributed separately for use in Emacs")) (defun menu-bar-help-extra-packages () "Display help about some additional packages available for Emacs." (interactive)
--- a/lisp/net/eudcb-ph.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/net/eudcb-ph.el Fri Nov 18 13:13:34 2005 +0000 @@ -184,7 +184,7 @@ (setq process (open-network-stream "ph" eudc-ph-process-buffer host port)) (if (null process) (throw 'done nil)) - (process-kill-without-query process) + (set-process-query-on-exit-flag process t) process))) (defun eudc-ph-close-session (process)
--- a/lisp/net/tramp-util.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/net/tramp-util.el Fri Nov 18 13:13:34 2005 +0000 @@ -36,53 +36,59 @@ ;; specific functions, like compilation. ;; The key remapping works since Emacs 22 only. Unknown for XEmacs. -(when (fboundp 'define-minor-mode) +;; Pacify byte-compiler +(eval-when-compile + (unless (fboundp 'define-minor-mode) + (defalias 'define-minor-mode 'identity) + (defvar tramp-minor-mode)) + (unless (featurep 'xemacs) + (defalias 'add-menu-button 'identity))) - (defvar tramp-minor-mode-map (make-sparse-keymap) - "Keymap for Tramp minor mode.") +(defvar tramp-minor-mode-map (make-sparse-keymap) + "Keymap for Tramp minor mode.") - (define-minor-mode tramp-minor-mode "Tramp minor mode for utility functions." - :group 'tramp - :global nil - :init-value nil - :lighter " Tramp" - :keymap tramp-minor-mode-map - (setq tramp-minor-mode - (and tramp-minor-mode (tramp-tramp-file-p default-directory)))) +(define-minor-mode tramp-minor-mode "Tramp minor mode for utility functions." + :group 'tramp + :global nil + :init-value nil + :lighter " Tramp" + :keymap tramp-minor-mode-map + (setq tramp-minor-mode + (and tramp-minor-mode (tramp-tramp-file-p default-directory)))) - (add-hook 'find-file-hooks 'tramp-minor-mode t) - (add-hook 'dired-mode-hook 'tramp-minor-mode t) +(add-hook 'find-file-hooks 'tramp-minor-mode t) +(add-hook 'dired-mode-hook 'tramp-minor-mode t) - (defun tramp-remap-command (old-command new-command) - "Replaces bindings of OLD-COMMAND by NEW-COMMAND. +(defun tramp-remap-command (old-command new-command) + "Replaces bindings of OLD-COMMAND by NEW-COMMAND. If remapping functionality for keymaps is defined, this happens for all bindings. Otherwise, only bindings active during invocation are taken into account. XEmacs menubar bindings are not changed by this." - (if (functionp 'command-remapping) - ;; Emacs 22 - (eval - `(define-key tramp-minor-mode-map [remap ,old-command] new-command)) - ;; previous Emacs versions. - (mapcar - '(lambda (x) - (define-key tramp-minor-mode-map x new-command)) - (where-is-internal old-command)))) + (if (functionp 'command-remapping) + ;; Emacs 22 + (eval + `(define-key tramp-minor-mode-map [remap ,old-command] new-command)) + ;; previous Emacs versions. + (mapcar + '(lambda (x) + (define-key tramp-minor-mode-map x new-command)) + (where-is-internal old-command)))) - (tramp-remap-command 'compile 'tramp-compile) - (tramp-remap-command 'recompile 'tramp-recompile) +(tramp-remap-command 'compile 'tramp-compile) +(tramp-remap-command 'recompile 'tramp-recompile) - ;; XEmacs has an own mimic for menu entries - (when (fboundp 'add-menu-button) - (funcall 'add-menu-button - '("Tools" "Compile") - ["Compile..." - (command-execute (if tramp-minor-mode 'tramp-compile 'compile)) - :active (fboundp 'compile)]) - (funcall 'add-menu-button - '("Tools" "Compile") - ["Repeat Compilation" - (command-execute (if tramp-minor-mode 'tramp-recompile 'recompile)) - :active (fboundp 'compile)]))) +;; XEmacs has an own mimic for menu entries +(when (fboundp 'add-menu-button) + (funcall 'add-menu-button + '("Tools" "Compile") + ["Compile..." + (command-execute (if tramp-minor-mode 'tramp-compile 'compile)) + :active (fboundp 'compile)]) + (funcall 'add-menu-button + '("Tools" "Compile") + ["Repeat Compilation" + (command-execute (if tramp-minor-mode 'tramp-recompile 'recompile)) + :active (fboundp 'compile)])) ;; Utility functions.
--- a/lisp/printing.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/printing.el Fri Nov 18 13:13:34 2005 +0000 @@ -1042,12 +1042,6 @@ ;; To avoid compilation gripes -(or (fboundp 'easy-menu-intern) ; hacked from easymenu.el - (defsubst easy-menu-intern (s) - (if (stringp s) (intern s) s))) - - - (or (fboundp 'subst-char-in-string) ; hacked from subr.el (defun subst-char-in-string (fromchar tochar string &optional inplace) "Replace FROMCHAR with TOCHAR in STRING each time it occurs. @@ -2803,8 +2797,10 @@ (and pr-print-using-ghostscript (not pr-spool-p))) -(defun pr-get-symbol (name) - (easy-menu-intern name)) +(defalias 'pr-get-symbol + (if (fboundp 'easy-menu-intern) + 'easy-menu-intern + (lambda (s) (if (stringp s) (intern s) s)))) (cond ((featurep 'xemacs) ; XEmacs
--- a/lisp/progmodes/gdb-ui.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/progmodes/gdb-ui.el Fri Nov 18 13:13:34 2005 +0000 @@ -358,13 +358,16 @@ (gud-call "clear *%a" arg))) "\C-d" "Remove breakpoint at current line or address.") ;; - (gud-def gud-until (if (not (string-match "Machine" mode-name)) + (gud-def gud-until (if (not (string-match "Machine" mode-name)) (gud-call "until %f:%l" arg) (save-excursion (beginning-of-line) (forward-char 2) (gud-call "until *%a" arg))) "\C-u" "Continue to current line or address.") + ;; + (gud-def gud-go (gud-call (if gdb-active-process "continue" "run") arg) + nil "Start or continue execution.") (define-key gud-minor-mode-map [left-margin mouse-1] 'gdb-mouse-set-clear-breakpoint) @@ -491,7 +494,9 @@ (unless (string-equal speedbar-initial-expansion-list-name "GUD") (speedbar-change-initial-expansion-list "GUD")) - (if (equal (nth 2 var) "0") + (if (or (equal (nth 2 var) "0") + (and (equal (nth 2 var) "1") + (string-match "char \\*" (nth 3 var)))) (gdb-enqueue-input (list (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) @@ -509,14 +514,14 @@ (defun gdb-var-evaluate-expression-handler (varnum changed) (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) (goto-char (point-min)) - (re-search-forward ".*value=\"\\(.*?\\)\"" nil t) + (re-search-forward ".*value=\\(\".*\"\\)" nil t) (catch 'var-found (let ((num 0)) (dolist (var gdb-var-list) (if (string-equal varnum (cadr var)) (progn (if changed (setcar (nthcdr 5 var) t)) - (setcar (nthcdr 4 var) (match-string 1)) + (setcar (nthcdr 4 var) (read (match-string 1))) (setcar (nthcdr num gdb-var-list) var) (throw 'var-found nil))) (setq num (+ num 1)))))) @@ -528,7 +533,8 @@ `(lambda () (gdb-var-list-children-handler ,varnum))))) (defconst gdb-var-list-children-regexp - "name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\"") + "name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",\ +type=\"\\(.*?\\)\"") (defun gdb-var-list-children-handler (varnum) (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) @@ -543,14 +549,15 @@ (let ((varchild (list (match-string 2) (match-string 1) (match-string 3) - nil nil nil))) - (if (looking-at ",type=\"\\(.*?\\)\"") - (setcar (nthcdr 3 varchild) (match-string 1))) + (match-string 4) + nil nil))) (dolist (var1 gdb-var-list) (if (string-equal (cadr var1) (cadr varchild)) (throw 'child-already-watched nil))) (push varchild var-list) - (if (equal (nth 2 varchild) "0") + (if (or (equal (nth 2 varchild) "0") + (and (equal (nth 2 varchild) "1") + (string-match "char \\*" (nth 3 varchild)))) (gdb-enqueue-input (list (concat @@ -574,12 +581,19 @@ (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) (goto-char (point-min)) (while (re-search-forward gdb-var-update-regexp nil t) + (catch 'var-found-1 (let ((varnum (match-string 1))) - (gdb-enqueue-input - (list - (concat "server interpreter mi \"-var-evaluate-expression " - varnum "\"\n") - `(lambda () (gdb-var-evaluate-expression-handler ,varnum t))))))) + (dolist (var gdb-var-list) + (when (and (string-equal varnum (cadr var)) + (or (equal (nth 2 var) "0") + (and (equal (nth 2 var) "1") + (string-match "char \\*" (nth 3 var))))) + (gdb-enqueue-input + (list + (concat "server interpreter mi \"-var-evaluate-expression " + varnum "\"\n") + `(lambda () (gdb-var-evaluate-expression-handler ,varnum t)))) + (throw 'var-found-1 nil))))))) (setq gdb-pending-triggers (delq 'gdb-var-update gdb-pending-triggers)) (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) @@ -1365,8 +1379,6 @@ :weight bold)) "Face for enabled breakpoint icon in fringe." :group 'gud) -;; Compatibility alias for old name. -(put 'breakpoint-enabled-bitmap-face 'face-alias 'breakpoint-enabled) (defface breakpoint-disabled ;; We use different values of grey for different background types, @@ -2347,11 +2359,13 @@ (define-key menu [breakpoints] '("Breakpoints" . gdb-frame-breakpoints-buffer))) -(let ((menu (make-sparse-keymap "GDB-UI"))) +(let ((menu (make-sparse-keymap "GDB-UI/MI"))) (define-key gud-menu-map [ui] - `(menu-item "GDB-UI" ,menu :visible (eq gud-minor-mode 'gdba))) + `(menu-item (if (eq gud-minor-mode 'gdba) "GDB-UI" "GDB-MI") + ,menu :visible (memq gud-minor-mode '(gdbmi gdba)))) (define-key menu [gdb-use-inferior-io] '(menu-item "Separate inferior IO" gdb-use-inferior-io-buffer + :visible (eq gud-minor-mode 'gdba) :help "Toggle separate IO for inferior." :button (:toggle . gdb-use-inferior-io-buffer))) (define-key menu [gdb-many-windows] @@ -2691,7 +2705,8 @@ (if (re-search-forward address nil t) (gdb-put-breakpoint-icon (eq flag ?y) bptno)))))))) (if (not (equal gdb-frame-address "main")) - (set-window-point (get-buffer-window buffer 0) pos)))) + (with-current-buffer buffer + (set-window-point (get-buffer-window buffer 0) pos))))) (defvar gdb-assembler-mode-map (let ((map (make-sparse-keymap)))
--- a/lisp/progmodes/gud.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/progmodes/gud.el Fri Nov 18 13:13:34 2005 +0000 @@ -122,33 +122,50 @@ (info "(emacs)GDB Graphical Interface") (info "(emacs)Debuggers")))) +(defun gud-tool-bar-item-visible-no-fringe () + (not (or (eq (buffer-local-value 'major-mode (window-buffer)) 'speedbar-mode) + (and (memq gud-minor-mode '(gdbmi gdba)) + (> (car (window-fringes)) 0))))) + +(defun gud-stop-subjob () + (interactive) + (if (string-equal + (buffer-local-value 'gud-target-name gud-comint-buffer) "emacs") + (comint-stop-subjob) + (comint-interrupt-subjob))) + (easy-mmode-defmap gud-menu-map '(([help] "Info" . gud-goto-info) ([tooltips] menu-item "Toggle GUD tooltips" gud-tooltip-mode - :enable (and (not emacs-basic-display) - (display-graphic-p) - (fboundp 'x-show-tip)) + :enable (and (not emacs-basic-display) + (display-graphic-p) + (fboundp 'x-show-tip)) :button (:toggle . gud-tooltip-mode)) ([refresh] "Refresh" . gud-refresh) ([run] menu-item "Run" gud-run :enable (and (not gud-running) - (memq gud-minor-mode '(gdbmi gdba gdb dbx jdb)))) + (memq gud-minor-mode '(gdbmi gdb dbx jdb))) + :visible (not (eq gud-minor-mode 'gdba))) + ([go] menu-item "Run/Continue" gud-go + :visible (and (not gud-running) + (eq gud-minor-mode 'gdba))) + ([stop] menu-item "Stop" gud-stop-subjob + :visible (or (not (eq gud-minor-mode 'gdba)) + (and gud-running + (eq gud-minor-mode 'gdba)))) ([until] menu-item "Continue to selection" gud-until :enable (and (not gud-running) (memq gud-minor-mode '(gdbmi gdba gdb perldb))) - :visible (not (and (memq gud-minor-mode '(gdbmi gdba)) - (> (car (window-fringes)) 0)))) + :visible (gud-tool-bar-item-visible-no-fringe)) ([remove] menu-item "Remove Breakpoint" gud-remove :enable (not gud-running) - :visible (not (and (memq gud-minor-mode '(gdbmi gdba)) - (> (car (window-fringes)) 0)))) + :visible (gud-tool-bar-item-visible-no-fringe)) ([tbreak] menu-item "Temporary Breakpoint" gud-tbreak :enable (memq gud-minor-mode '(gdbmi gdba gdb sdb xdb bashdb))) ([break] menu-item "Set Breakpoint" gud-break :enable (not gud-running) - :visible (not (and (memq gud-minor-mode '(gdbmi gdba)) - (> (car (window-fringes)) 0)))) + :visible (gud-tool-bar-item-visible-no-fringe)) ([up] menu-item "Up Stack" gud-up :enable (and (not gud-running) (memq gud-minor-mode @@ -157,30 +174,35 @@ :enable (and (not gud-running) (memq gud-minor-mode '(gdbmi gdba gdb dbx xdb jdb pdb bashdb)))) + ([pp] menu-item "Print the emacs s-expression" gud-pp + :enable (and (not gud-running) + gdb-active-process) + :visible (and (string-equal + (buffer-local-value + 'gud-target-name gud-comint-buffer) "emacs") + (eq gud-minor-mode 'gdba))) ([print*] menu-item "Print Dereference" gud-pstar - :enable (and (not gud-running) - (memq gud-minor-mode '(gdbmi gdba gdb)))) + :enable (and (not gud-running) + (memq gud-minor-mode '(gdbmi gdba gdb)))) ([print] menu-item "Print Expression" gud-print - :enable (not gud-running)) + :enable (not gud-running)) ([watch] menu-item "Watch Expression" gud-watch - :enable (and (not gud-running) - (memq gud-minor-mode '(gdbmi gdba)))) - ([finish] menu-item "Finish Function" gud-finish - :enable (and (not gud-running) - (memq gud-minor-mode - '(gdbmi gdba gdb xdb jdb pdb bashdb)))) + :enable (and (not gud-running) + (memq gud-minor-mode + '(gdbmi gdba gdb xdb jdb pdb bashdb)))) ([stepi] menu-item "Step Instruction" gud-stepi - :enable (and (not gud-running) - (memq gud-minor-mode '(gdbmi gdba gdb dbx)))) + :enable (and (not gud-running) + (memq gud-minor-mode '(gdbmi gdba gdb dbx)))) ([nexti] menu-item "Next Instruction" gud-nexti - :enable (and (not gud-running) - (memq gud-minor-mode '(gdbmi gdba gdb dbx)))) + :enable (and (not gud-running) + (memq gud-minor-mode '(gdbmi gdba gdb dbx)))) ([step] menu-item "Step Line" gud-step - :enable (not gud-running)) + :enable (not gud-running)) ([next] menu-item "Next Line" gud-next - :enable (not gud-running)) + :enable (not gud-running)) ([cont] menu-item "Continue" gud-cont - :enable (not gud-running))) + :enable (not gud-running) + :visible (not (eq gud-minor-mode 'gdba)))) "Menu for `gud-mode'." :name "Gud") @@ -204,16 +226,19 @@ (gud-remove . "gud/remove") (gud-print . "gud/print") (gud-pstar . "gud/pstar") + (gud-pp . "gud/pp") (gud-watch . "gud/watch") - (gud-cont . "gud/cont") - (gud-until . "gud/until") - (gud-finish . "gud/finish") (gud-run . "gud/run") + (gud-go . "gud/go") + (gud-stop-subjob . "gud/stop") ;; gud-s, gud-si etc. instead of gud-step, ;; gud-stepi, to avoid file-name clashes on DOS ;; 8+3 filesystems. + (gud-cont . "gud/cont") + (gud-until . "gud/until") (gud-next . "gud/next") (gud-step . "gud/step") + (gud-finish . "gud/finish") (gud-nexti . "gud/nexti") (gud-stepi . "gud/stepi") (gud-up . "gud/up") @@ -346,6 +371,12 @@ (defvar gud-speedbar-key-map nil "Keymap used when in the buffers display mode.") +(defun gud-speedbar-item-info () + "Display the data type of the watch expression element." + (let ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list))) + (if (nth 4 var) + (speedbar-message "%s" (nth 3 var))))) + (defun gud-install-speedbar-variables () "Install those variables used by speedbar to enhance gud/gdb." (if gud-speedbar-key-map @@ -362,7 +393,12 @@ (speedbar-add-expansion-list '("GUD" gud-speedbar-menu-items gud-speedbar-key-map - gud-expansion-speedbar-buttons))) + gud-expansion-speedbar-buttons)) + + (add-to-list + 'speedbar-mode-functions-list + '("GUD" (speedbar-item-info . gud-speedbar-item-info) + (speedbar-line-directory . ignore)))) (defvar gud-speedbar-menu-items '(["Jump to stack frame" speedbar-edit-line @@ -414,7 +450,9 @@ (while (string-match "\\." varnum start) (setq depth (1+ depth) start (1+ (match-beginning 0)))) - (if (equal (nth 2 var) "0") + (if (or (equal (nth 2 var) "0") + (and (equal (nth 2 var) "1") + (string-match "char \\*" (nth 3 var)))) (speedbar-make-tag-line 'bracket ?? nil nil (concat (car var) "\t" (nth 4 var)) 'gdb-edit-value @@ -596,25 +634,31 @@ (set (make-local-variable 'gud-minor-mode) 'gdb) (gud-def gud-break "break %f:%l" "\C-b" "Set breakpoint at current line.") - (gud-def gud-tbreak "tbreak %f:%l" "\C-t" "Set temporary breakpoint at current line.") - (gud-def gud-remove "clear %f:%l" "\C-d" "Remove breakpoint at current line") - (gud-def gud-step "step %p" "\C-s" "Step one source line with display.") - (gud-def gud-stepi "stepi %p" "\C-i" "Step one instruction with display.") - (gud-def gud-next "next %p" "\C-n" "Step one line (skip functions).") - (gud-def gud-nexti "nexti %p" nil "Step one instruction (skip functions).") - (gud-def gud-cont "cont" "\C-r" "Continue with display.") - (gud-def gud-finish "finish" "\C-f" "Finish executing current function.") + (gud-def gud-tbreak "tbreak %f:%l" "\C-t" + "Set temporary breakpoint at current line.") + (gud-def gud-remove "clear %f:%l" "\C-d" "Remove breakpoint at current line") + (gud-def gud-step "step %p" "\C-s" "Step one source line with display.") + (gud-def gud-stepi "stepi %p" "\C-i" "Step one instruction with display.") + (gud-def gud-next "next %p" "\C-n" "Step one line (skip functions).") + (gud-def gud-nexti "nexti %p" nil "Step one instruction (skip functions).") + (gud-def gud-cont "cont" "\C-r" "Continue with display.") + (gud-def gud-finish "finish" "\C-f" "Finish executing current function.") (gud-def gud-jump (progn (gud-call "tbreak %f:%l") (gud-call "jump %f:%l")) "\C-j" "Set execution address to current line.") - (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).") - (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).") - (gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.") - (gud-def gud-pstar "print* %e" nil + (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).") + (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).") + (gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.") + (gud-def gud-pstar "print* %e" nil "Evaluate C dereferenced pointer expression at point.") - (gud-def gud-until "until %l" "\C-u" "Continue to current line.") - (gud-def gud-run "run" nil "Run the program.") + + ;; For debugging Emacs only. + (gud-def gud-pp "pp1 %e" nil "Print the emacs s-expression.") + (gud-def gud-pv "pv1 %e" "\C-v" "Print the value of the lisp variable.") + + (gud-def gud-until "until %l" "\C-u" "Continue to current line.") + (gud-def gud-run "run" nil "Run the program.") (local-set-key "\C-i" 'gud-gdb-complete-command) (setq comint-prompt-regexp "^(.*gdb[+]?) *")
--- a/lisp/replace.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/replace.el Fri Nov 18 13:13:34 2005 +0000 @@ -878,6 +878,16 @@ :type 'face :group 'matching) +(defcustom occur-excluded-properties + '(read-only invisible intangible field mouse-face help-echo local-map keymap + yank-handler follow-link) + "*Text properties to discard when copying lines to the *Occur* buffer. +The value should be a list of text properties to discard or t, +which means to discard all text properties." + :type '(choice (const :tag "All" t) (repeat symbol)) + :group 'matching + :version "22.1") + (defun occur-accumulate-lines (count &optional keep-props) (save-excursion (let ((forwardp (> count 0)) @@ -894,10 +904,12 @@ (if (fboundp 'jit-lock-fontify-now) (jit-lock-fontify-now beg end))) (push - (funcall (if keep-props - #'buffer-substring - #'buffer-substring-no-properties) - beg end) + (if (and keep-props (not (eq occur-excluded-properties t))) + (let ((str (buffer-substring beg end))) + (remove-list-of-text-properties + 0 (length str) occur-excluded-properties str) + str) + (buffer-substring-no-properties beg end)) result) (forward-line (if forwardp 1 -1))) (nreverse result)))) @@ -1033,7 +1045,8 @@ (and case-fold-search (isearch-no-upper-case-p regexp t)) list-matching-lines-buffer-name-face - nil list-matching-lines-face t))) + nil list-matching-lines-face + (not (eq occur-excluded-properties t))))) (let* ((bufcount (length active-bufs)) (diff (- (length bufs) bufcount))) (message "Searched %d buffer%s%s; %s match%s for `%s'" @@ -1102,13 +1115,15 @@ (text-property-not-all begpt endpt 'fontified t)) (if (fboundp 'jit-lock-fontify-now) (jit-lock-fontify-now begpt endpt))) - (setq curstring (buffer-substring begpt endpt)) - ;; Depropertize the string, and maybe - ;; highlight the matches + (if (and keep-props (not (eq occur-excluded-properties t))) + (progn + (setq curstring (buffer-substring begpt endpt)) + (remove-list-of-text-properties + 0 (length curstring) occur-excluded-properties curstring)) + (setq curstring (buffer-substring-no-properties begpt endpt))) + ;; Highlight the matches (let ((len (length curstring)) (start 0)) - (unless keep-props - (set-text-properties 0 len nil curstring)) (while (and (< start len) (string-match regexp curstring start)) (add-text-properties
--- a/lisp/reveal.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/reveal.el Fri Nov 18 13:13:34 2005 +0000 @@ -44,11 +44,11 @@ ;;; Todo: ;; - find other hysteresis features. +;; - don't hide after a scroll command +;; - delay hiding by a couple seconds (i.e. hide in the background) ;;; Code: -(require 'pcvs-util) - (defgroup reveal nil "Reveal hidden text on the fly." :group 'editing) @@ -58,7 +58,9 @@ :type 'boolean :group 'reveal) -(defvar reveal-open-spots nil) +(defvar reveal-open-spots nil + "List of spots in the buffer which are open. +Each element has the form (WINDOW . OVERLAY).") (make-variable-buffer-local 'reveal-open-spots) (defvar reveal-last-tick nil) @@ -74,35 +76,34 @@ ;; FIXME: do we actually know that (current-buffer) = (window-buffer) ? (with-local-quit (condition-case err - (let* ((spots (cvs-partition - (lambda (x) - ;; We refresh any spot in the current window as well - ;; as any spots associated with a dead window or a window - ;; which does not show this buffer any more. - (or (eq (car x) (selected-window)) - (not (window-live-p (car x))) - (not (eq (window-buffer (car x)) - (current-buffer))))) - reveal-open-spots)) - (old-ols (mapcar 'cdr (car spots))) - (repeat t)) - (setq reveal-open-spots (cdr spots)) + (let ((old-ols (delq nil + (mapcar + (lambda (x) + ;; We refresh any spot in the current window as + ;; well as any spots associated with a dead + ;; window or a window which does not show this + ;; buffer any more. + (if (or (eq (car x) (selected-window)) + (not (window-live-p (car x))) + (not (eq (window-buffer (car x)) + (current-buffer)))) + (cdr x))) + reveal-open-spots))) + (repeat t)) ;; Open new overlays. (while repeat (setq repeat nil) (dolist (ol (nconc (when (and reveal-around-mark mark-active) (overlays-at (mark))) (overlays-at (point)))) - (push (cons (selected-window) ol) reveal-open-spots) (setq old-ols (delq ol old-ols)) (let ((inv (overlay-get ol 'invisible)) open) (when (and inv ;; There's an `invisible' property. Make sure it's - ;; actually invisible. - (or (not (listp buffer-invisibility-spec)) - (memq inv buffer-invisibility-spec) - (assq inv buffer-invisibility-spec)) - (or (setq open + ;; actually invisible, and ellipsised. + (and (consp buffer-invisibility-spec) + (cdr (assq inv buffer-invisibility-spec))) + (or (setq open (or (overlay-get ol 'reveal-toggle-invisible) (and (symbolp inv) (get inv 'reveal-toggle-invisible)) @@ -111,8 +112,10 @@ (and (consp buffer-invisibility-spec) (cdr (assq inv buffer-invisibility-spec)))) (overlay-put ol 'reveal-invisible inv)) + (push (cons (selected-window) ol) reveal-open-spots) (if (null open) - (overlay-put ol 'invisible nil) + (progn ;; (debug) + (overlay-put ol 'invisible nil)) ;; Use the provided opening function and repeat (since the ;; opening function might have hidden a subpart around point). (setq repeat t) @@ -133,32 +136,37 @@ ;; should be rear-advance when it's open, but things like ;; outline-minor-mode make it non-rear-advance because it's ;; a better choice when it's closed). - (dolist (ol old-ols) - (push (cons (selected-window) ol) reveal-open-spots)) + nil ;; The last command was only a point motion or some such ;; non-buffer-modifying command. Let's close whatever can be closed. (dolist (ol old-ols) - (when (and (eq (current-buffer) (overlay-buffer ol)) - (not (rassq ol reveal-open-spots))) - (if (and (>= (point) (save-excursion - (goto-char (overlay-start ol)) - (line-beginning-position 1))) - (<= (point) (save-excursion - (goto-char (overlay-end ol)) - (line-beginning-position 2)))) - ;; Still near the overlay: keep it open. - (push (cons (selected-window) ol) reveal-open-spots) - ;; Really close it. - (let ((open (overlay-get ol 'reveal-toggle-invisible)) inv) - (if (or open - (and (setq inv (overlay-get ol 'reveal-invisible)) - (setq open (or (get inv 'reveal-toggle-invisible) - (overlay-get ol 'isearch-open-invisible-temporary))))) - (condition-case err - (funcall open ol t) - (error (message "!!Reveal-hide (funcall %s %s t): %s !!" - open ol err))) - (overlay-put ol 'invisible inv)))))))) + (if (and (>= (point) (save-excursion + (goto-char (overlay-start ol)) + (line-beginning-position 1))) + (<= (point) (save-excursion + (goto-char (overlay-end ol)) + (line-beginning-position 2))) + ;; If the application has moved the overlay to some other + ;; buffer, we'd better reset the buffer to its + ;; original state. + (eq (current-buffer) (overlay-buffer ol))) + ;; Still near the overlay: keep it open. + nil + ;; Really close it. + (let ((open (overlay-get ol 'reveal-toggle-invisible)) inv) + (if (or open + (and (setq inv (overlay-get ol 'reveal-invisible)) + (setq open (or (get inv 'reveal-toggle-invisible) + (overlay-get ol 'isearch-open-invisible-temporary))))) + (condition-case err + (funcall open ol t) + (error (message "!!Reveal-hide (funcall %s %s t): %s !!" + open ol err))) + (overlay-put ol 'invisible inv)) + ;; Remove the olverlay from the list of open spots. + (setq reveal-open-spots + (delq (rassoc ol reveal-open-spots) + reveal-open-spots))))))) (error (message "Reveal: %s" err))))) (defvar reveal-mode-map
--- a/lisp/rfn-eshadow.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/rfn-eshadow.el Fri Nov 18 13:13:34 2005 +0000 @@ -93,17 +93,16 @@ (symbol :tag "Property") (sexp :tag "Value"))))) -;;;###autoload (defcustom file-name-shadow-properties '(face file-name-shadow field shadow) "Properties given to the `shadowed' part of a filename in the minibuffer. Only used when `file-name-shadow-mode' is active. -If emacs is not running under a window system, +If Emacs is not running under a window system, `file-name-shadow-tty-properties' is used instead." :type file-name-shadow-properties-custom-type - :group 'minibuffer) + :group 'minibuffer + :version "22.1") -;;;###autoload (defcustom file-name-shadow-tty-properties '(before-string "{" after-string "} " field shadow) "Properties given to the `shadowed' part of a filename in the minibuffer. @@ -111,30 +110,18 @@ is not running under a window-system; if emacs is running under a window system, `file-name-shadow-properties' is used instead." :type file-name-shadow-properties-custom-type - :group 'minibuffer) + :group 'minibuffer + :version "22.1") (defface file-name-shadow '((t :inherit shadow)) "Face used by `file-name-shadow-mode' for the shadow." - :group 'minibuffer) + :group 'minibuffer + :version "22.1") ;;; Internal variables -;; Regexp to locate dividing point between shadow and real pathname -(defconst rfn-eshadow-regexp - (cond ((memq system-type '(ms-dos windows-nt)) - ;; This horrible regexp considers the following patterns as - ;; starting an absolute pathname, when following a `/' or an `\': - ;; L: / // ~ $ \\ \\\\ - "\\(.*[^/]+/+?\\|/*?\\|\\)\\(~\\|$[^$]\\|$\\'\\|[][\\^a-z]:\\|//?\\([^][\\^a-z/$~]\\|[^/$~][^:]\\|[^/$~]?\\'\\)\\)") - (t - ;; default is for unix-style filenames - "\\(.*/\\)\\([/~]\\|$[^$]\\|$\\'\\)")) - "Regular expression used to match shadowed filenames. -There should be at least one regexp group; the end of the first one -is used as the end of the shadowed portion of the filename.") - ;; A list of minibuffers to which we've added a post-command-hook. (defvar rfn-eshadow-frobbed-minibufs nil) @@ -168,32 +155,48 @@ (add-to-list 'rfn-eshadow-frobbed-minibufs (current-buffer)) (add-hook 'post-command-hook #'rfn-eshadow-update-overlay nil t))) +(defsubst rfn-eshadow-sifn-equal (goal pos) + (equal goal (condition-case nil + (substitute-in-file-name + (buffer-substring-no-properties pos (point-max))) + ;; `substitute-in-file-name' can fail on partial input. + (error nil)))) + ;; post-command-hook to update overlay (defun rfn-eshadow-update-overlay () "Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input. -This is intended to be used as a minibuffer post-command-hook for +This is intended to be used as a minibuffer `post-command-hook' for `file-name-shadow-mode'; the minibuffer should have already been set up by `rfn-eshadow-setup-minibuffer'." - ;; This is not really a correct implementation; it won't always do the - ;; right thing in the presence of environment variables that - ;; substitute-in-file-name would expand; currently it just assumes any - ;; environment variable contains an absolute filename. - (save-excursion - (let ((inhibit-point-motion-hooks t)) - (goto-char (minibuffer-prompt-end)) - ;; Update the overlay (which will evaporate if it's empty). - (move-overlay rfn-eshadow-overlay - (point) - (if (looking-at rfn-eshadow-regexp) - (match-end 1) - (point)))))) - + (condition-case nil + (let ((goal (substitute-in-file-name (minibuffer-contents))) + (mid (overlay-end rfn-eshadow-overlay)) + (start (minibuffer-prompt-end)) + (end (point-max))) + (unless + ;; Catch the common case where the shadow does not need to move. + (and mid + (or (eq mid end) + (not (rfn-eshadow-sifn-equal goal (1+ mid)))) + (or (eq mid start) + (rfn-eshadow-sifn-equal goal mid))) + ;; Binary search for the greatest position still equivalent to + ;; the whole. + (while (or (< (1+ start) end) + (if (and (< (1+ end) (point-max)) + (rfn-eshadow-sifn-equal goal (1+ end))) + ;; (SIFN end) != goal, but (SIFN (1+end)) == goal, + ;; We've reached a discontinuity: this can happen + ;; e.g. if `end' point to "/:...". + (setq start (1+ end) end (point-max)))) + (setq mid (/ (+ start end) 2)) + (if (rfn-eshadow-sifn-equal goal mid) + (setq start mid) + (setq end mid))) + (move-overlay rfn-eshadow-overlay (minibuffer-prompt-end) start))) + ;; `substitute-in-file-name' can fail on partial input. + (error nil))) -;;; Note this definition must be at the end of the file, because -;;; `define-minor-mode' actually calls the mode-function if the -;;; associated variable is non-nil, which requires that all needed -;;; functions be already defined. [This is arguably a bug in d-m-m] -;;;###autoload (define-minor-mode file-name-shadow-mode "Toggle File-Name Shadow mode. When active, any part of a filename being read in the minibuffer @@ -205,7 +208,9 @@ With prefix argument ARG, turn on if positive, otherwise off. Returns non-nil if the new state is enabled." :global t + :init-value t :group 'minibuffer + :version "22.1" (if file-name-shadow-mode ;; Enable the mode (add-hook 'minibuffer-setup-hook 'rfn-eshadow-setup-minibuffer) @@ -220,5 +225,5 @@ (provide 'rfn-eshadow) -;;; arch-tag: dcf70a52-0115-4ec2-b1e3-4f8d3541a888 +;; arch-tag: dcf70a52-0115-4ec2-b1e3-4f8d3541a888 ;;; rfn-eshadow.el ends here
--- a/lisp/savehist.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/savehist.el Fri Nov 18 13:13:34 2005 +0000 @@ -4,7 +4,7 @@ ;; Author: Hrvoje Niksic <hniksic@xemacs.org> ;; Keywords: minibuffer -;; Version: 19 +;; Version: 24 ;; This file is part of GNU Emacs. @@ -64,9 +64,7 @@ Set this by calling the `savehist-mode' function or using the customize interface." :type 'boolean - :set (if (fboundp 'custom-set-minor-mode) - 'custom-set-minor-mode - (lambda (symbol value) (funcall symbol (or value 0)))) + :set (lambda (symbol value) (savehist-mode (or value 0))) :initialize 'custom-initialize-default :require 'savehist :group 'savehist) @@ -129,18 +127,25 @@ :type 'integer :group 'savehist) +(defcustom savehist-mode-hook nil + "Hook called when `savehist-mode' is turned on." + :type 'hook) + (defcustom savehist-save-hook nil "Hook called by `savehist-save' before saving the variables. You can use this hook to influence choice and content of variables to save." - :type 'hook) + :type 'hook + :group 'savehist) -(defvar savehist-coding-system - ;; UTF-8 is usually preferable to ISO-2022-8 when available, but under - ;; XEmacs, UTF-8 is provided by external packages, and may not always be - ;; available, so even if it currently is available, we prefer not to - ;; use is. - (if (featurep 'xemacs) 'iso-2022-8 'utf-8) +;; This should be capable of representing characters used by Emacs. +;; We prefer UTF-8 over ISO 2022 because it is well-known outside +;; Mule. XEmacs prir to 21.5 had UTF-8 provided by an external +;; package which may not be loaded, which is why we check for version. +(defvar savehist-coding-system (if (and (featurep 'xemacs) + (<= emacs-major-version 21) + (< emacs-minor-version 5)) + 'iso-2022-8 'utf-8) "The coding system savehist uses for saving the minibuffer history. Changing this value while Emacs is running is supported, but considered unwise, unless you know what you are doing.") @@ -158,20 +163,20 @@ `savehist-save-hook' to influence which variables are saved.") (defconst savehist-no-conversion (if (featurep 'xemacs) 'binary 'no-conversion) - "Coding system without conversion, used for calculating internal checksums. -Should be as fast as possible, ideally simply exposing the internal -representation of buffer text.") + "Coding system without any conversion. +This is used for calculating an internal checksum. Should be as fast +as possible, ideally simply exposing the internal representation of +buffer text.") (defvar savehist-loaded nil "Whether the history has already been loaded. -This prevents toggling `savehist-mode' from destroying existing +This prevents toggling savehist-mode from destroying existing minibuffer history.") -(eval-when-compile - (when (featurep 'xemacs) - ;; Must declare this under XEmacs, which doesn't have built-in - ;; minibuffer history truncation. - (defvar history-length 100))) +(when (featurep 'xemacs) + ;; Must declare this under XEmacs, which doesn't have built-in + ;; minibuffer history truncation. + (defvar history-length 100)) ;; Functions. @@ -209,16 +214,8 @@ (setq savehist-mode nil) (savehist-uninstall) (signal (car errvar) (cdr errvar))))) - (savehist-install)) - - ;; End with the usual minor-mode conventions normally provided - ;; transparently by define-minor-mode. - (run-hooks 'savehist-mode-hook) - (if (interactive-p) - (progn - (customize-mark-as-set 'savehist-mode) - (unless (current-message) - (message "Savehist mode %sabled" (if savehist-mode "en" "dis"))))) + (savehist-install) + (run-hooks 'savehist-mode-hook)) ;; Return the new setting. savehist-mode) (add-minor-mode 'savehist-mode "") @@ -340,9 +337,9 @@ (savehist-save t))) (defun savehist-trim-history (value) - ;; Retain only the first history-length items in VALUE. Only used - ;; under XEmacs, which doesn't (yet) implement automatic trimming of - ;; history lists to history-length items. + "Retain only the first history-length items in VALUE. +Only used under XEmacs, which doesn't (yet) implement automatic +trimming of history lists to history-length items." (if (and (featurep 'xemacs) (natnump history-length) (> (length value) history-length)) @@ -373,8 +370,11 @@ (error nil)))))) (defun savehist-minibuffer-hook () - (add-to-list 'savehist-minibuffer-history-variables - minibuffer-history-variable)) + ;; XEmacs sets minibuffer-history-variable to t to mean "no history + ;; is being recorded". + (unless (eq minibuffer-history-variable t) + (add-to-list 'savehist-minibuffer-history-variables + minibuffer-history-variable))) (provide 'savehist)
--- a/lisp/simple.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/simple.el Fri Nov 18 13:13:34 2005 +0000 @@ -893,8 +893,8 @@ (if (or (/= beg 1) (/= end (1+ total))) (message "point=%d of %d (%d%%) <%d - %d> column %d %s" pos total percent beg end col hscroll) - (message "point=%d of %d (%d%%) column %d %s" - pos total percent col hscroll)) + (message "point=%d of %d (EOB) column %d %s" + pos total col hscroll)) (let ((coding buffer-file-coding-system) encoded encoding-msg display-prop under-display) (if (or (not coding) @@ -3722,11 +3722,11 @@ ;;"Goal column %d (use \\[set-goal-column] with an arg to unset it)") ;;goal-column) (message "%s" - (concat + (concat (format "Goal column %d " goal-column) (substitute-command-keys "(use \\[set-goal-column] with an arg to unset it)"))) - + ) nil) @@ -4318,9 +4318,7 @@ (eq (syntax-class syntax) 4) (cdr syntax))))) (cond - ((or (null matching-paren) - (/= (char-before oldpos) - matching-paren)) + ((not (eq matching-paren (char-before oldpos))) (message "Mismatched parentheses")) ((not blinkpos) (if (not blink-matching-paren-distance) @@ -4864,7 +4862,7 @@ When this hook is run, the current buffer is the one in which the command to display the completion list buffer was run. The completion list buffer is available as the value of `standard-output'. -The common prefix substring for completion may be available as the +The common prefix substring for completion may be available as the value of `completion-common-substring'. See also `display-completion-list'.") @@ -4893,9 +4891,9 @@ "Common prefix substring to use in `completion-setup-function' to put faces. The value is set by `display-completion-list' during running `completion-setup-hook'. -To put faces, `completions-first-difference' and `completions-common-part' +To put faces, `completions-first-difference' and `completions-common-part' into \"*Completions*\* buffer, the common prefix substring in completions is -needed as a hint. (Minibuffer is a special case. The content of minibuffer itself +needed as a hint. (Minibuffer is a special case. The content of minibuffer itself is the substring.)") ;; This function goes in completion-setup-hook, so that it is called @@ -4912,37 +4910,49 @@ (setq default-directory (file-name-directory mbuf-contents)))) ;; If partial-completion-mode is on, point might not be after the ;; last character in the minibuffer. - ;; FIXME: This still doesn't work if the text to be completed - ;; starts with a `-'. - (when (and partial-completion-mode (not (eobp))) + ;; FIXME: This hack should be moved to complete.el where we call + ;; display-completion-list. + (when partial-completion-mode (setq common-string-length - (- common-string-length (- (point) (point-max))))) + (if (eq (char-after (field-beginning)) ?-) + ;; If the text to be completed starts with a `-', there is no + ;; common prefix. + ;; FIXME: this probably still doesn't do the right thing + ;; when completing file names. It's not even clear what + ;; is TRT. + 0 + (- common-string-length (- (point) (point-max)))))) (with-current-buffer standard-output (completion-list-mode) (set (make-local-variable 'completion-reference-buffer) mainbuf) - (if minibuffer-completing-file-name - ;; For file name completion, - ;; use the number of chars before the start of the - ;; last file name component. - (setq completion-base-size + (setq completion-base-size + (if minibuffer-completing-file-name + ;; For file name completion, use the number of chars before + ;; the start of the last file name component. (with-current-buffer mainbuf (save-excursion (goto-char (point-max)) (skip-chars-backward completion-root-regexp) - (- (point) (minibuffer-prompt-end))))) - ;; Otherwise, in minibuffer, the whole input is being completed. - (if (minibufferp mainbuf) - (if (and (symbolp minibuffer-completion-table) - (get minibuffer-completion-table 'completion-base-size-function)) - (setq completion-base-size - (funcall (get minibuffer-completion-table 'completion-base-size-function))) - (setq completion-base-size 0)))) + (- (point) (minibuffer-prompt-end)))) + ;; Otherwise, in minibuffer, the whole input is being completed. + (if (minibufferp mainbuf) 0))) + (if (and (symbolp minibuffer-completion-table) + (get minibuffer-completion-table 'completion-base-size-function)) + (setq completion-base-size + ;; FIXME: without any extra arg, how is this function + ;; expected to return anything else than a constant unless + ;; it redoes part of the work of all-completions? + ;; In most cases this value would better be computed and + ;; returned at the same time as the list of all-completions + ;; is computed. --Stef + (funcall (get minibuffer-completion-table + 'completion-base-size-function)))) ;; Put faces on first uncommon characters and common parts. (when (or completion-common-substring completion-base-size) (setq common-string-length - (if completion-common-substring - (length completion-common-substring) - (- common-string-length completion-base-size))) + (if completion-common-substring + (length completion-common-substring) + (- common-string-length completion-base-size))) (let ((element-start (point-min)) (maxp (point-max)) element-common-end)
--- a/lisp/startup.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/startup.el Fri Nov 18 13:13:34 2005 +0000 @@ -773,6 +773,7 @@ (custom-reevaluate-setting 'global-font-lock-mode) (custom-reevaluate-setting 'mouse-wheel-down-event) (custom-reevaluate-setting 'mouse-wheel-up-event) + (custom-reevaluate-setting 'file-name-shadow-mode) (normal-erase-is-backspace-setup-frame)
--- a/lisp/tar-mode.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/tar-mode.el Fri Nov 18 13:13:34 2005 +0000 @@ -101,7 +101,7 @@ :group 'data) (defcustom tar-anal-blocksize 20 - "*The blocksize of tar files written by Emacs, or nil, meaning don't care. + "The blocksize of tar files written by Emacs, or nil, meaning don't care. The blocksize of a tar file is not really the size of the blocks; rather, it is the number of blocks written with one system call. When tarring to a tape, this is the size of the *tape* blocks, but when writing to a file, it doesn't @@ -112,7 +112,7 @@ :group 'tar) (defcustom tar-update-datestamp nil - "*Non-nil means Tar mode should play fast and loose with sub-file datestamps. + "Non-nil means Tar mode should play fast and loose with sub-file datestamps. If this is true, then editing and saving a tar file entry back into its tar file will update its datestamp. If false, the datestamp is unchanged. You may or may not want this - it is good in that you can tell when a file @@ -123,7 +123,7 @@ :group 'tar) (defcustom tar-mode-show-date nil - "*Non-nil means Tar mode should show the date/time of each subfile. + "Non-nil means Tar mode should show the date/time of each subfile. This information is useful, but it takes screen space away from file names." :type 'boolean :group 'tar) @@ -231,12 +231,16 @@ (setq linkname (substring string tar-link-offset link-end)) (if default-enable-multibyte-characters (setq name - (decode-coding-string name (or file-name-coding-system - 'undecided)) + (decode-coding-string name + (or file-name-coding-system + default-file-name-coding-system + 'undecided)) linkname - (decode-coding-string linkname (or file-name-coding-system - 'undecided)))) - (if (and (null link-p) (string-match "/$" name)) (setq link-p 5)) ; directory + (decode-coding-string linkname + (or file-name-coding-system + default-file-name-coding-system + 'undecided)))) + (if (and (null link-p) (string-match "/\\'" name)) (setq link-p 5)) ; directory (make-tar-header name (tar-parse-octal-integer string tar-mode-offset tar-uid-offset) @@ -284,12 +288,11 @@ (list hi lo)))) (defun tar-parse-octal-integer-safe (string) - (let ((L (length string))) - (if (= L 0) (error "empty string")) - (dotimes (i L) - (if (or (< (aref string i) ?0) - (> (aref string i) ?7)) - (error "`%c' is not an octal digit" (aref string i))))) + (if (zerop (length string)) (error "empty string")) + (mapc (lambda (c) + (if (or (< c ?0) (> c ?7)) + (error "`%c' is not an octal digit" c))) + string) (tar-parse-octal-integer string)) @@ -343,7 +346,7 @@ (gname (tar-header-gname tar-hblock)) (size (tar-header-size tar-hblock)) (time (tar-header-date tar-hblock)) - (ck (tar-header-checksum tar-hblock)) + ;; (ck (tar-header-checksum tar-hblock)) (type (tar-header-link-type tar-hblock)) (link-name (tar-header-link-name tar-hblock))) (format "%c%c%s%8s/%-8s%7s%s %s%s" @@ -403,147 +406,143 @@ Place a dired-like listing on the front; then narrow to it, so that only that listing is visible (and the real data of the buffer is hidden)." - (set-buffer-multibyte nil) - (let* ((result '()) - (pos (point-min)) - (progress-reporter - (make-progress-reporter "Parsing tar file..." - (point-min) (max 1 (- (buffer-size) 1024)))) - tokens) - (while (and (<= (+ pos 512) (point-max)) - (not (eq 'empty-tar-block - (setq tokens - (tar-header-block-tokenize - (buffer-substring pos (+ pos 512))))))) - (setq pos (+ pos 512)) - (progress-reporter-update progress-reporter pos) - (if (eq (tar-header-link-type tokens) 20) - ;; Foo. There's an extra empty block after these. - (setq pos (+ pos 512))) - (let ((size (tar-header-size tokens))) - (if (< size 0) - (error "%s has size %s - corrupted" - (tar-header-name tokens) size)) - ; - ; This is just too slow. Don't really need it anyway.... - ;(tar-header-block-check-checksum - ; hblock (tar-header-block-checksum hblock) - ; (tar-header-name tokens)) + (let ((modified (buffer-modified-p))) + (set-buffer-multibyte nil) + (let* ((result '()) + (pos (point-min)) + (progress-reporter + (make-progress-reporter "Parsing tar file..." + (point-min) (max 1 (- (buffer-size) 1024)))) + tokens) + (while (and (<= (+ pos 512) (point-max)) + (not (eq 'empty-tar-block + (setq tokens + (tar-header-block-tokenize + (buffer-substring pos (+ pos 512))))))) + (setq pos (+ pos 512)) + (progress-reporter-update progress-reporter pos) + (if (eq (tar-header-link-type tokens) 20) + ;; Foo. There's an extra empty block after these. + (setq pos (+ pos 512))) + (let ((size (tar-header-size tokens))) + (if (< size 0) + (error "%s has size %s - corrupted" + (tar-header-name tokens) size)) + ; + ; This is just too slow. Don't really need it anyway.... + ;(tar-header-block-check-checksum + ; hblock (tar-header-block-checksum hblock) + ; (tar-header-name tokens)) - (setq result (cons (make-tar-desc pos tokens) result)) + (push (make-tar-desc pos tokens) result) - (and (null (tar-header-link-type tokens)) - (> size 0) - (setq pos - (+ pos 512 (ash (ash (1- size) -9) 9)) ; this works - ;(+ pos (+ size (- 512 (rem (1- size) 512)))) ; this doesn't - )))) - (make-local-variable 'tar-parse-info) - (setq tar-parse-info (nreverse result)) - ;; A tar file should end with a block or two of nulls, - ;; but let's not get a fatal error if it doesn't. - (if (eq tokens 'empty-tar-block) - (progress-reporter-done progress-reporter) - (message "Warning: premature EOF parsing tar file"))) - (save-excursion + (and (null (tar-header-link-type tokens)) + (> size 0) + (setq pos + (+ pos 512 (ash (ash (1- size) -9) 9)) ; this works + ;(+ pos (+ size (- 512 (rem (1- size) 512)))) ; this doesn't + )))) + (make-local-variable 'tar-parse-info) + (setq tar-parse-info (nreverse result)) + ;; A tar file should end with a block or two of nulls, + ;; but let's not get a fatal error if it doesn't. + (if (eq tokens 'empty-tar-block) + (progress-reporter-done progress-reporter) + (message "Warning: premature EOF parsing tar file"))) + (set-buffer-multibyte default-enable-multibyte-characters) (goto-char (point-min)) - (let ((buffer-read-only nil) - (summaries nil)) + (let ((inhibit-read-only t)) ;; Collect summary lines and insert them all at once since tar files ;; can be pretty big. - (dolist (tar-desc (reverse tar-parse-info)) - (setq summaries - (cons (tar-header-block-summarize (tar-desc-tokens tar-desc)) - (cons "\n" - summaries)))) - (let ((total-summaries (apply 'concat summaries))) - (if (multibyte-string-p total-summaries) - (set-buffer-multibyte t)) - (insert total-summaries)) - (make-local-variable 'tar-header-offset) - (setq tar-header-offset (point)) - (narrow-to-region (point-min) tar-header-offset) - (if enable-multibyte-characters - (setq tar-header-offset (position-bytes tar-header-offset))) - (set-buffer-modified-p nil)))) + (let ((total-summaries + (mapconcat + (lambda (tar-desc) + (tar-header-block-summarize (tar-desc-tokens tar-desc))) + tar-parse-info + "\n"))) + (insert total-summaries "\n")) + (narrow-to-region (point-min) (point)) + (set (make-local-variable 'tar-header-offset) (position-bytes (point))) + (goto-char (point-min)) + (restore-buffer-modified-p modified)))) -(defvar tar-mode-map nil "*Local keymap for Tar mode listings.") +(defvar tar-mode-map + (let ((map (make-keymap))) + (suppress-keymap map) + (define-key map " " 'tar-next-line) + (define-key map "C" 'tar-copy) + (define-key map "d" 'tar-flag-deleted) + (define-key map "\^D" 'tar-flag-deleted) + (define-key map "e" 'tar-extract) + (define-key map "f" 'tar-extract) + (define-key map "\C-m" 'tar-extract) + (define-key map [mouse-2] 'tar-mouse-extract) + (define-key map "g" 'revert-buffer) + (define-key map "h" 'describe-mode) + (define-key map "n" 'tar-next-line) + (define-key map "\^N" 'tar-next-line) + (define-key map [down] 'tar-next-line) + (define-key map "o" 'tar-extract-other-window) + (define-key map "p" 'tar-previous-line) + (define-key map "q" 'quit-window) + (define-key map "\^P" 'tar-previous-line) + (define-key map [up] 'tar-previous-line) + (define-key map "R" 'tar-rename-entry) + (define-key map "u" 'tar-unflag) + (define-key map "v" 'tar-view) + (define-key map "x" 'tar-expunge) + (define-key map "\177" 'tar-unflag-backwards) + (define-key map "E" 'tar-extract-other-window) + (define-key map "M" 'tar-chmod-entry) + (define-key map "G" 'tar-chgrp-entry) + (define-key map "O" 'tar-chown-entry) + + ;; Make menu bar items. -(if tar-mode-map - nil - (setq tar-mode-map (make-keymap)) - (suppress-keymap tar-mode-map) - (define-key tar-mode-map " " 'tar-next-line) - (define-key tar-mode-map "C" 'tar-copy) - (define-key tar-mode-map "d" 'tar-flag-deleted) - (define-key tar-mode-map "\^D" 'tar-flag-deleted) - (define-key tar-mode-map "e" 'tar-extract) - (define-key tar-mode-map "f" 'tar-extract) - (define-key tar-mode-map "\C-m" 'tar-extract) - (define-key tar-mode-map [mouse-2] 'tar-mouse-extract) - (define-key tar-mode-map "g" 'revert-buffer) - (define-key tar-mode-map "h" 'describe-mode) - (define-key tar-mode-map "n" 'tar-next-line) - (define-key tar-mode-map "\^N" 'tar-next-line) - (define-key tar-mode-map [down] 'tar-next-line) - (define-key tar-mode-map "o" 'tar-extract-other-window) - (define-key tar-mode-map "p" 'tar-previous-line) - (define-key tar-mode-map "q" 'quit-window) - (define-key tar-mode-map "\^P" 'tar-previous-line) - (define-key tar-mode-map [up] 'tar-previous-line) - (define-key tar-mode-map "R" 'tar-rename-entry) - (define-key tar-mode-map "u" 'tar-unflag) - (define-key tar-mode-map "v" 'tar-view) - (define-key tar-mode-map "x" 'tar-expunge) - (define-key tar-mode-map "\177" 'tar-unflag-backwards) - (define-key tar-mode-map "E" 'tar-extract-other-window) - (define-key tar-mode-map "M" 'tar-chmod-entry) - (define-key tar-mode-map "G" 'tar-chgrp-entry) - (define-key tar-mode-map "O" 'tar-chown-entry) - ) - -;; Make menu bar items. + ;; Get rid of the Edit menu bar item to save space. + (define-key map [menu-bar edit] 'undefined) + + (define-key map [menu-bar immediate] + (cons "Immediate" (make-sparse-keymap "Immediate"))) -;; Get rid of the Edit menu bar item to save space. -(define-key tar-mode-map [menu-bar edit] 'undefined) + (define-key map [menu-bar immediate view] + '("View This File" . tar-view)) + (define-key map [menu-bar immediate display] + '("Display in Other Window" . tar-display-other-window)) + (define-key map [menu-bar immediate find-file-other-window] + '("Find in Other Window" . tar-extract-other-window)) + (define-key map [menu-bar immediate find-file] + '("Find This File" . tar-extract)) + + (define-key map [menu-bar mark] + (cons "Mark" (make-sparse-keymap "Mark"))) -(define-key tar-mode-map [menu-bar immediate] - (cons "Immediate" (make-sparse-keymap "Immediate"))) + (define-key map [menu-bar mark unmark-all] + '("Unmark All" . tar-clear-modification-flags)) + (define-key map [menu-bar mark deletion] + '("Flag" . tar-flag-deleted)) + (define-key map [menu-bar mark unmark] + '("Unflag" . tar-unflag)) -(define-key tar-mode-map [menu-bar immediate view] - '("View This File" . tar-view)) -(define-key tar-mode-map [menu-bar immediate display] - '("Display in Other Window" . tar-display-other-window)) -(define-key tar-mode-map [menu-bar immediate find-file-other-window] - '("Find in Other Window" . tar-extract-other-window)) -(define-key tar-mode-map [menu-bar immediate find-file] - '("Find This File" . tar-extract)) - -(define-key tar-mode-map [menu-bar mark] - (cons "Mark" (make-sparse-keymap "Mark"))) + (define-key map [menu-bar operate] + (cons "Operate" (make-sparse-keymap "Operate"))) -(define-key tar-mode-map [menu-bar mark unmark-all] - '("Unmark All" . tar-clear-modification-flags)) -(define-key tar-mode-map [menu-bar mark deletion] - '("Flag" . tar-flag-deleted)) -(define-key tar-mode-map [menu-bar mark unmark] - '("Unflag" . tar-unflag)) - -(define-key tar-mode-map [menu-bar operate] - (cons "Operate" (make-sparse-keymap "Operate"))) + (define-key map [menu-bar operate chown] + '("Change Owner..." . tar-chown-entry)) + (define-key map [menu-bar operate chgrp] + '("Change Group..." . tar-chgrp-entry)) + (define-key map [menu-bar operate chmod] + '("Change Mode..." . tar-chmod-entry)) + (define-key map [menu-bar operate rename] + '("Rename to..." . tar-rename-entry)) + (define-key map [menu-bar operate copy] + '("Copy to..." . tar-copy)) + (define-key map [menu-bar operate expunge] + '("Expunge Marked Files" . tar-expunge)) -(define-key tar-mode-map [menu-bar operate chown] - '("Change Owner..." . tar-chown-entry)) -(define-key tar-mode-map [menu-bar operate chgrp] - '("Change Group..." . tar-chgrp-entry)) -(define-key tar-mode-map [menu-bar operate chmod] - '("Change Mode..." . tar-chmod-entry)) -(define-key tar-mode-map [menu-bar operate rename] - '("Rename to..." . tar-rename-entry)) -(define-key tar-mode-map [menu-bar operate copy] - '("Copy to..." . tar-copy)) -(define-key tar-mode-map [menu-bar operate expunge] - '("Expunge Marked Files" . tar-expunge)) + map) + "Local keymap for Tar mode listings.") + ;; tar mode is suitable only for specially formatted data. (put 'tar-mode 'mode-class 'special) @@ -559,7 +558,7 @@ Type `c' to copy an entry from the tar file into another file on disk. If you edit a sub-file of this archive (as with the `e' command) and -save it with Control-x Control-s, the contents of that buffer will be +save it with \\[save-buffer], the contents of that buffer will be saved back into the tar-file buffer; in this way you can edit a file inside of a tar archive without extracting it and re-archiving it. @@ -787,17 +786,17 @@ (defun tar-extract-other-window () - "*In Tar mode, find this entry of the tar file in another window." + "In Tar mode, find this entry of the tar file in another window." (interactive) (tar-extract t)) (defun tar-display-other-window () - "*In Tar mode, display this entry of the tar file in another window." + "In Tar mode, display this entry of the tar file in another window." (interactive) (tar-extract 'display)) (defun tar-view () - "*In Tar mode, view the tar file entry on this line." + "In Tar mode, view the tar file entry on this line." (interactive) (tar-extract 'view)) @@ -823,7 +822,7 @@ (defun tar-copy (&optional to-file) - "*In Tar mode, extract this entry of the tar file into a file on disk. + "In Tar mode, extract this entry of the tar file into a file on disk. If TO-FILE is not supplied, it is prompted for, defaulting to the name of the current tar-entry." (interactive (list (tar-read-file-name))) @@ -856,11 +855,11 @@ (message "Copied tar entry %s to %s" name to-file))) (defun tar-flag-deleted (p &optional unflag) - "*In Tar mode, mark this sub-file to be deleted from the tar file. + "In Tar mode, mark this sub-file to be deleted from the tar file. With a prefix argument, mark that many files." (interactive "p") (beginning-of-line) - (dotimes (i (if (< p 0) (- p) p)) + (dotimes (i (abs p)) (if (tar-current-descriptor unflag) ; barf if we're not on an entry-line. (progn (delete-char 1) @@ -869,13 +868,13 @@ (if (eobp) nil (forward-char 36))) (defun tar-unflag (p) - "*In Tar mode, un-mark this sub-file if it is marked to be deleted. + "In Tar mode, un-mark this sub-file if it is marked to be deleted. With a prefix argument, un-mark that many files forward." (interactive "p") (tar-flag-deleted p t)) (defun tar-unflag-backwards (p) - "*In Tar mode, un-mark this sub-file if it is marked to be deleted. + "In Tar mode, un-mark this sub-file if it is marked to be deleted. With a prefix argument, un-mark that many files backward." (interactive "p") (tar-flag-deleted (- p) t)) @@ -886,7 +885,7 @@ "Expunge the tar-entry specified by the current line." (let* ((descriptor (tar-current-descriptor)) (tokens (tar-desc-tokens descriptor)) - (line (tar-desc-data-start descriptor)) + ;; (line (tar-desc-data-start descriptor)) (name (tar-header-name tokens)) (size (tar-header-size tokens)) (link-p (tar-header-link-type tokens)) @@ -898,18 +897,16 @@ (beginning-of-line) (let ((line-start (point))) (end-of-line) (forward-char) - (let ((line-len (- (point) line-start))) - (delete-region line-start (point)) - ;; - ;; decrement the header-pointer to be in sync... - (setq tar-header-offset (- tar-header-offset line-len)))) + ;; decrement the header-pointer to be in sync... + (setq tar-header-offset (- tar-header-offset (- (point) line-start))) + (delete-region line-start (point))) ;; ;; delete the data pointer... (setq tar-parse-info (delq descriptor tar-parse-info)) ;; ;; delete the data from inside the file... (widen) - (let* ((data-start (+ start tar-header-offset -513)) + (let* ((data-start (+ start (- tar-header-offset (point-min)) -512)) (data-end (+ data-start 512 (ash (ash (+ size 511) -9) 9)))) (delete-region data-start data-end) ;; @@ -927,7 +924,7 @@ (defun tar-expunge (&optional noconfirm) - "*In Tar mode, delete all the archived files flagged for deletion. + "In Tar mode, delete all the archived files flagged for deletion. This does not modify the disk image; you must save the tar file itself for this to be permanent." (interactive) @@ -935,8 +932,9 @@ (y-or-n-p "Expunge files marked for deletion? ")) (let ((n 0) (multibyte enable-multibyte-characters)) - (set-buffer-multibyte nil) (save-excursion + (widen) + (set-buffer-multibyte nil) (goto-char (point-min)) (while (not (eobp)) (if (looking-at "D") @@ -945,8 +943,9 @@ (forward-line 1))) ;; after doing the deletions, add any padding that may be necessary. (tar-pad-to-blocksize) + (widen) + (set-buffer-multibyte multibyte) (narrow-to-region (point-min) tar-header-offset)) - (set-buffer-multibyte multibyte) (if (zerop n) (message "Nothing to expunge.") (message "%s files expunged. Be sure to save this buffer." n))))) @@ -964,7 +963,7 @@ (defun tar-chown-entry (new-uid) - "*Change the user-id associated with this entry in the tar file. + "Change the user-id associated with this entry in the tar file. If this tar file was written by GNU tar, then you will be able to edit the user id as a string; otherwise, you must edit it as a number. You can force editing as a number by calling this with a prefix arg. @@ -992,7 +991,7 @@ (defun tar-chgrp-entry (new-gid) - "*Change the group-id associated with this entry in the tar file. + "Change the group-id associated with this entry in the tar file. If this tar file was written by GNU tar, then you will be able to edit the group id as a string; otherwise, you must edit it as a number. You can force editing as a number by calling this with a prefix arg. @@ -1020,7 +1019,7 @@ (concat (substring (format "%6o" new-gid) 0 6) "\000 "))))) (defun tar-rename-entry (new-name) - "*Change the name associated with this entry in the tar file. + "Change the name associated with this entry in the tar file. This does not modify the disk image; you must save the tar file itself for this to be permanent." (interactive @@ -1030,12 +1029,16 @@ (if (> (length new-name) 98) (error "name too long")) (tar-setf (tar-header-name (tar-desc-tokens (tar-current-descriptor))) new-name) + (if (multibyte-string-p new-name) + (setq new-name (encode-coding-string new-name + (or file-name-coding-system + default-file-name-coding-system)))) (tar-alter-one-field 0 (substring (concat new-name (make-string 99 0)) 0 99))) (defun tar-chmod-entry (new-mode) - "*Change the protection bits associated with this entry in the tar file. + "Change the protection bits associated with this entry in the tar file. This does not modify the disk image; you must save the tar file itself for this to be permanent." (interactive (list (tar-parse-octal-integer-safe @@ -1063,7 +1066,9 @@ (widen) (set-buffer-multibyte nil) - (let* ((start (+ (tar-desc-data-start descriptor) tar-header-offset -513))) + (let* ((start (+ (tar-desc-data-start descriptor) + (- tar-header-offset (point-min)) + -512))) ;; ;; delete the old field and insert a new one. (goto-char (+ start data-position)) @@ -1196,9 +1201,7 @@ ;; Insert the new text after the old, before deleting, ;; to preserve the window start. (let ((line (tar-header-block-summarize tokens t))) - (if (multibyte-string-p line) - (insert-before-markers (string-as-unibyte line) "\n") - (insert-before-markers line "\n"))) + (insert-before-markers (string-as-unibyte line) "\n")) (delete-region p after) (setq tar-header-offset (marker-position m))) ))) @@ -1234,19 +1237,17 @@ (size (if link-p 0 (tar-header-size tokens))) (data-end (+ start size)) (bbytes (ash tar-anal-blocksize 9)) - (pad-to (+ bbytes (* bbytes (/ (1- data-end) bbytes)))) + (pad-to (+ bbytes (* bbytes (/ (- data-end (point-min)) bbytes)))) (inhibit-read-only t) ; ## ) ;; If the padding after the last data is too long, delete some; ;; else insert some until we are padded out to the right number of blocks. ;; - (goto-char (+ (or tar-header-offset 0) data-end)) - (if (> (1+ (buffer-size)) (+ (or tar-header-offset 0) pad-to)) - (delete-region (+ (or tar-header-offset 0) pad-to) (1+ (buffer-size))) - (insert (make-string (- (+ (or tar-header-offset 0) pad-to) - (1+ (buffer-size))) - 0))) - ))) + (let ((goal-end (+ (or tar-header-offset 0) pad-to))) + (if (> (point-max) goal-end) + (delete-region goal-end (point-max)) + (goto-char (point-max)) + (insert (make-string (- goal-end (point-max)) ?\0))))))) ;; Used in write-file-hook to write tar-files out correctly. @@ -1273,5 +1274,5 @@ (provide 'tar-mode) -;;; arch-tag: 8a585a4a-340e-42c2-89e7-d3b1013a4b78 +;; arch-tag: 8a585a4a-340e-42c2-89e7-d3b1013a4b78 ;;; tar-mode.el ends here
--- a/lisp/term.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/term.el Fri Nov 18 13:13:34 2005 +0000 @@ -1406,8 +1406,8 @@ :UP=\\E[%%dA:DO=\\E[%%dB:LE=\\E[%%dD:RI=\\E[%%dC\ :kl=\\EOD:kd=\\EOB:kr=\\EOC:ku=\\EOA:kN=\\E[6~:kP=\\E[5~:@7=\\E[4~:kh=\\E[1~\ :mk=\\E[8m:cb=\\E[1K:op=\\E[39;49m:Co#8:pa#64:AB=\\E[4%%dm:AF=\\E[3%%dm:cr=^M\ -:bl=^G:do=^J:le=^H:ta=^I:se=\E[27m:ue=\E24m\ -:kb=^?:kD=^[[3~:sc=\E7:rc=\E8:r1=\Ec:" +:bl=^G:do=^J:le=^H:ta=^I:se=\\E[27m:ue=\\E24m\ +:kb=^?:kD=^[[3~:sc=\\E7:rc=\\E8:r1=\\Ec:" ;;; : -undefine ic ;;; don't define :te=\\E[2J\\E[?47l\\E8:ti=\\E7\\E[?47h\ "termcap capabilities supported") @@ -3615,21 +3615,32 @@ (defun term-down (down &optional check-for-scroll) "Move down DOWN screen lines vertically." (let ((start-column (term-horizontal-column))) - (if (and check-for-scroll (or term-scroll-with-delete term-pager-count)) - (setq down (term-handle-scroll down))) - (term-adjust-current-row-cache down) - (if (or (/= (point) (point-max)) (< down 0)) - (setq down (- down (term-vertical-motion down)))) - ;; Extend buffer with extra blank lines if needed. + (when (and check-for-scroll (or term-scroll-with-delete term-pager-count)) + (setq down (term-handle-scroll down))) + (unless (and (= term-current-row 0) (< down 0)) + (term-adjust-current-row-cache down) + (when (or (/= (point) (point-max)) (< down 0)) + (setq down (- down (term-vertical-motion down))))) (cond ((> down 0) + ;; Extend buffer with extra blank lines if needed. (term-insert-char ?\n down) (setq term-current-column 0) (setq term-start-line-column 0)) (t - (setq term-current-column nil) + (when (= term-current-row 0) + ;; Insert lines if at the beginning. + (save-excursion (term-insert-char ?\n (- down))) + (save-excursion + (let (p) + ;; Delete lines from the end. + (forward-line term-height) + (setq p (point)) + (forward-line (- down)) + (delete-region p (point))))) + (setq term-current-column 0) (setq term-start-line-column (current-column)))) - (if start-column - (term-move-columns start-column)))) + (when start-column + (term-move-columns start-column)))) ;; Assuming point is at the beginning of a screen line, ;; if the line above point wraps around, add a ?\n to undo the wrapping. @@ -3695,7 +3706,7 @@ ;;; Insert COUNT spaces after point, but do not change any of ;;; following screen lines. Hence we may have to delete characters -;;; at teh end of this screen line to make room. +;;; at the end of this screen line to make room. (defun term-insert-spaces (count) (let ((save-point (point)) (save-eol) (point-at-eol))
--- a/lisp/textmodes/flyspell.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/textmodes/flyspell.el Fri Nov 18 13:13:34 2005 +0000 @@ -46,9 +46,9 @@ (require 'ispell) -;*---------------------------------------------------------------------*/ -;* Group ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* Group ... */ +;;*---------------------------------------------------------------------*/ (defgroup flyspell nil "Spell checking on the fly." :tag "FlySpell" @@ -56,41 +56,30 @@ :group 'ispell :group 'processes) -;*---------------------------------------------------------------------*/ -;* Which emacs are we currently running */ -;*---------------------------------------------------------------------*/ -(defvar flyspell-emacs - (cond - ((string-match "XEmacs" emacs-version) - 'xemacs) - (t - 'emacs)) - "The type of Emacs we are currently running.") - -;*---------------------------------------------------------------------*/ -;* User configuration ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* User configuration ... */ +;;*---------------------------------------------------------------------*/ (defcustom flyspell-highlight-flag t - "*How Flyspell should indicate misspelled words. + "How Flyspell should indicate misspelled words. Non-nil means use highlight, nil means use minibuffer messages." :group 'flyspell :type 'boolean) (defcustom flyspell-mark-duplications-flag t - "*Non-nil means Flyspell reports a repeated word as an error. + "Non-nil means Flyspell reports a repeated word as an error. Detection of repeated words is not implemented in \"large\" regions; see `flyspell-large-region'." :group 'flyspell :type 'boolean) (defcustom flyspell-sort-corrections nil - "*Non-nil means, sort the corrections alphabetically before popping them." + "Non-nil means, sort the corrections alphabetically before popping them." :group 'flyspell :version "21.1" :type 'boolean) (defcustom flyspell-duplicate-distance -1 - "*The maximum distance for finding duplicates of unrecognized words. + "The maximum distance for finding duplicates of unrecognized words. This applies to the feature that when a word is not found in the dictionary, if the same spelling occurs elsewhere in the buffer, Flyspell uses a different face (`flyspell-duplicate') to highlight it. @@ -102,19 +91,19 @@ :type 'number) (defcustom flyspell-delay 3 - "*The number of seconds to wait before checking, after a \"delayed\" command." + "The number of seconds to wait before checking, after a \"delayed\" command." :group 'flyspell :type 'number) (defcustom flyspell-persistent-highlight t - "*Non-nil means misspelled words remain highlighted until corrected. + "Non-nil means misspelled words remain highlighted until corrected. If this variable is nil, only the most recently detected misspelled word is highlighted." :group 'flyspell :type 'boolean) (defcustom flyspell-highlight-properties t - "*Non-nil means highlight incorrect words even if a property exists for this word." + "Non-nil means highlight incorrect words even if a property exists for this word." :group 'flyspell :type 'boolean) @@ -158,17 +147,17 @@ :type '(repeat (symbol))) (defcustom flyspell-issue-welcome-flag t - "*Non-nil means that Flyspell should display a welcome message when started." + "Non-nil means that Flyspell should display a welcome message when started." :group 'flyspell :type 'boolean) (defcustom flyspell-issue-message-flag t - "*Non-nil means that Flyspell emits messages when checking words." + "Non-nil means that Flyspell emits messages when checking words." :group 'flyspell :type 'boolean) (defcustom flyspell-incorrect-hook nil - "*List of functions to be called when incorrect words are encountered. + "List of functions to be called when incorrect words are encountered. Each function is given three arguments. The first two arguments are the beginning and the end of the incorrect region. The third is either the symbol `doublon' or the list @@ -200,7 +189,7 @@ :type 'string) (defcustom flyspell-check-tex-math-command nil - "*Non nil means check even inside TeX math environment. + "Non nil means check even inside TeX math environment. TeX math environments are discovered by the TEXMATHP that implemented inside the texmathp.el Emacs package. That package may be found at: http://strw.leidenuniv.nl/~dominik/Tools" @@ -216,26 +205,26 @@ (defcustom flyspell-abbrev-p nil - "*If non-nil, add correction to abbreviation table." + "If non-nil, add correction to abbreviation table." :group 'flyspell :version "21.1" :type 'boolean) (defcustom flyspell-use-global-abbrev-table-p nil - "*If non-nil, prefer global abbrev table to local abbrev table." + "If non-nil, prefer global abbrev table to local abbrev table." :group 'flyspell :version "21.1" :type 'boolean) (defcustom flyspell-mode-line-string " Fly" - "*String displayed on the modeline when flyspell is active. + "String displayed on the modeline when flyspell is active. Set this to nil if you don't want a modeline indicator." :group 'flyspell :type '(choice string (const :tag "None" nil))) (defcustom flyspell-large-region 1000 - "*The threshold that determines if a region is small. + "The threshold that determines if a region is small. If the region is smaller than this number of characters, `flyspell-region' checks the words sequentially using regular flyspell methods. Else, if the region is large, a new Ispell process is @@ -250,7 +239,7 @@ :type '(choice number (const :tag "All small" nil))) (defcustom flyspell-insert-function (function insert) - "*Function for inserting word by flyspell upon correction." + "Function for inserting word by flyspell upon correction." :group 'flyspell :type 'function) @@ -265,7 +254,7 @@ :type '(choice string (const nil))) (defcustom flyspell-use-meta-tab t - "*Non-nil means that flyspell uses META-TAB to correct word." + "Non-nil means that flyspell uses M-TAB to correct word." :group 'flyspell :type 'boolean) @@ -274,17 +263,17 @@ "The key binding for flyspell auto correction." :group 'flyspell) -;*---------------------------------------------------------------------*/ -;* Mode specific options */ -;* ------------------------------------------------------------- */ -;* Mode specific options enable users to disable flyspell on */ -;* certain word depending of the emacs mode. For instance, when */ -;* using flyspell with mail-mode add the following expression */ -;* in your .emacs file: */ -;* (add-hook 'mail-mode */ -;* '(lambda () (setq flyspell-generic-check-word-p */ -;* 'mail-mode-flyspell-verify))) */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* Mode specific options */ +;;* ------------------------------------------------------------- */ +;;* Mode specific options enable users to disable flyspell on */ +;;* certain word depending of the emacs mode. For instance, when */ +;;* using flyspell with mail-mode add the following expression */ +;;* in your .emacs file: */ +;;* (add-hook 'mail-mode */ +;;* '(lambda () (setq flyspell-generic-check-word-p */ +;;* 'mail-mode-flyspell-verify))) */ +;;*---------------------------------------------------------------------*/ (defvar flyspell-generic-check-word-p nil "Function providing per-mode customization over which words are flyspelled. Returns t to continue checking, nil otherwise. @@ -292,7 +281,7 @@ property of the major mode name.") (make-variable-buffer-local 'flyspell-generic-check-word-p) -;*--- mail mode -------------------------------------------------------*/ +;;*--- mail mode -------------------------------------------------------*/ (put 'mail-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify) (put 'message-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify) (defun mail-mode-flyspell-verify () @@ -321,7 +310,7 @@ (beginning-of-line) (not (looking-at "[>}|]\\|To:"))))))) -;*--- texinfo mode ----------------------------------------------------*/ +;;*--- texinfo mode ----------------------------------------------------*/ (put 'texinfo-mode 'flyspell-mode-predicate 'texinfo-mode-flyspell-verify) (defun texinfo-mode-flyspell-verify () "This function is used for `flyspell-generic-check-word-p' in Texinfo mode." @@ -329,7 +318,7 @@ (forward-word -1) (not (looking-at "@")))) -;*--- tex mode --------------------------------------------------------*/ +;;*--- tex mode --------------------------------------------------------*/ (put 'tex-mode 'flyspell-mode-predicate 'tex-mode-flyspell-verify) (defun tex-mode-flyspell-verify () "This function is used for `flyspell-generic-check-word-p' in LaTeX mode." @@ -344,7 +333,7 @@ (and (>= this (match-beginning 0)) (<= this (match-end 0)) ))))))) -;*--- sgml mode -------------------------------------------------------*/ +;;*--- sgml mode -------------------------------------------------------*/ (put 'sgml-mode 'flyspell-mode-predicate 'sgml-mode-flyspell-verify) (put 'html-mode 'flyspell-mode-predicate 'sgml-mode-flyspell-verify) @@ -371,9 +360,9 @@ (and (re-search-backward "&[^;]*" s t) (= (match-end 0) this))))))))) -;*---------------------------------------------------------------------*/ -;* Programming mode */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* Programming mode */ +;;*---------------------------------------------------------------------*/ (defvar flyspell-prog-text-faces '(font-lock-string-face font-lock-comment-face font-lock-doc-face) "Faces corresponding to text in programming-mode buffers.") @@ -391,9 +380,9 @@ (flyspell-mode 1) (run-hooks 'flyspell-prog-mode-hook)) -;*---------------------------------------------------------------------*/ -;* Overlay compatibility */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* Overlay compatibility */ +;;*---------------------------------------------------------------------*/ (autoload 'make-overlay "overlay" "Overlay compatibility kit." t) (autoload 'overlayp "overlay" "Overlay compatibility kit." t) (autoload 'overlays-in "overlay" "Overlay compatibility kit." t) @@ -403,9 +392,9 @@ (autoload 'overlay-get "overlay" "Overlay compatibility kit." t) (autoload 'previous-overlay-change "overlay" "Overlay compatibility kit." t) -;*---------------------------------------------------------------------*/ -;* The minor mode declaration. */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* The minor mode declaration. */ +;;*---------------------------------------------------------------------*/ (defvar flyspell-mouse-map (let ((map (make-sparse-keymap))) (define-key map (if (featurep 'xemacs) [button2] [down-mouse-2]) @@ -432,9 +421,9 @@ (defvar flyspell-dash-local-dictionary nil) (make-variable-buffer-local 'flyspell-dash-local-dictionary) -;*---------------------------------------------------------------------*/ -;* Highlighting */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* Highlighting */ +;;*---------------------------------------------------------------------*/ (defface flyspell-incorrect '((((class color)) (:foreground "OrangeRed" :bold t :underline t)) (t (:bold t))) @@ -454,9 +443,9 @@ (defvar flyspell-overlay nil) -;*---------------------------------------------------------------------*/ -;* flyspell-mode ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-mode ... */ +;;*---------------------------------------------------------------------*/ ;;;###autoload(defvar flyspell-mode nil) ;;;###autoload (define-minor-mode flyspell-mode @@ -494,32 +483,31 @@ (flyspell-mode-on) (flyspell-mode-off))) -;*---------------------------------------------------------------------*/ -;* flyspell-buffers ... */ -;* ------------------------------------------------------------- */ -;* For remembering buffers running flyspell */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-buffers ... */ +;;* ------------------------------------------------------------- */ +;;* For remembering buffers running flyspell */ +;;*---------------------------------------------------------------------*/ (defvar flyspell-buffers nil) -;*---------------------------------------------------------------------*/ -;* flyspell-minibuffer-p ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-minibuffer-p ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-minibuffer-p (buffer) "Is BUFFER a minibuffer?" (let ((ws (get-buffer-window-list buffer t))) (and (consp ws) (window-minibuffer-p (car ws))))) -;*---------------------------------------------------------------------*/ -;* flyspell-accept-buffer-local-defs ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-accept-buffer-local-defs ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-accept-buffer-local-defs () ;; strange problem. If buffer in current window has font-lock turned on, ;; but SET-BUFFER was called to point to an invisible buffer, this ispell ;; call will reset the buffer to the buffer in the current window. However, ;; it only happens at startup (fix by Albert L. Ting). - (let ((buf (current-buffer))) - (ispell-accept-buffer-local-defs) - (set-buffer buf)) + (save-current-buffer + (ispell-accept-buffer-local-defs)) (if (not (and (eq flyspell-dash-dictionary ispell-dictionary) (eq flyspell-dash-local-dictionary ispell-local-dictionary))) ;; The dictionary has changed @@ -531,9 +519,9 @@ (setq flyspell-consider-dash-as-word-delimiter-flag t) (setq flyspell-consider-dash-as-word-delimiter-flag nil))))) -;*---------------------------------------------------------------------*/ -;* flyspell-mode-on ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-mode-on ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-mode-on () "Turn Flyspell mode on. Do not use this; use `flyspell-mode' instead." (ispell-maybe-find-aspell-dictionaries) @@ -576,17 +564,17 @@ ;; we end with the flyspell hooks (run-hooks 'flyspell-mode-hook)) -;*---------------------------------------------------------------------*/ -;* flyspell-delay-commands ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-delay-commands ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-delay-commands () "Install the standard set of Flyspell delayed commands." (mapcar 'flyspell-delay-command flyspell-default-delayed-commands) (mapcar 'flyspell-delay-command flyspell-delayed-commands)) -;*---------------------------------------------------------------------*/ -;* flyspell-delay-command ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-delay-command ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-delay-command (command) "Set COMMAND to be delayed, for Flyspell. When flyspell `post-command-hook' is invoked because a delayed command @@ -595,17 +583,17 @@ (interactive "SDelay Flyspell after Command: ") (put command 'flyspell-delayed t)) -;*---------------------------------------------------------------------*/ -;* flyspell-deplacement-commands ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-deplacement-commands ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-deplacement-commands () "Install the standard set of Flyspell deplacement commands." (mapcar 'flyspell-deplacement-command flyspell-default-deplacement-commands) (mapcar 'flyspell-deplacement-command flyspell-deplacement-commands)) -;*---------------------------------------------------------------------*/ -;* flyspell-deplacement-command ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-deplacement-command ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-deplacement-command (command) "Set COMMAND that implement cursor movements, for Flyspell. When flyspell `post-command-hook' is invoked because of a deplacement command @@ -614,9 +602,9 @@ (interactive "SDeplacement Flyspell after Command: ") (put command 'flyspell-deplacement t)) -;*---------------------------------------------------------------------*/ -;* flyspell-word-cache ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-word-cache ... */ +;;*---------------------------------------------------------------------*/ (defvar flyspell-word-cache-start nil) (defvar flyspell-word-cache-end nil) (defvar flyspell-word-cache-word nil) @@ -626,26 +614,26 @@ (make-variable-buffer-local 'flyspell-word-cache-word) (make-variable-buffer-local 'flyspell-word-cache-result) -;*---------------------------------------------------------------------*/ -;* The flyspell pre-hook, store the current position. In the */ -;* post command hook, we will check, if the word at this position */ -;* has to be spell checked. */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* The flyspell pre-hook, store the current position. In the */ +;;* post command hook, we will check, if the word at this position */ +;;* has to be spell checked. */ +;;*---------------------------------------------------------------------*/ (defvar flyspell-pre-buffer nil) (defvar flyspell-pre-point nil) (defvar flyspell-pre-column nil) (defvar flyspell-pre-pre-buffer nil) (defvar flyspell-pre-pre-point nil) -;*---------------------------------------------------------------------*/ -;* flyspell-previous-command ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-previous-command ... */ +;;*---------------------------------------------------------------------*/ (defvar flyspell-previous-command nil "The last interactive command checked by Flyspell.") -;*---------------------------------------------------------------------*/ -;* flyspell-pre-command-hook ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-pre-command-hook ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-pre-command-hook () "Save the current buffer and point for Flyspell's post-command hook." (interactive) @@ -653,9 +641,9 @@ (setq flyspell-pre-point (point)) (setq flyspell-pre-column (current-column))) -;*---------------------------------------------------------------------*/ -;* flyspell-mode-off ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-mode-off ... */ +;;*---------------------------------------------------------------------*/ ;;;###autoload (defun flyspell-mode-off () "Turn Flyspell mode off." @@ -672,9 +660,9 @@ ;; we mark the mode as killed (setq flyspell-mode nil)) -;*---------------------------------------------------------------------*/ -;* flyspell-check-pre-word-p ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-check-pre-word-p ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-check-pre-word-p () "Return non-nil if we should check the word before point. More precisely, it applies to the word that was before point @@ -710,24 +698,24 @@ (or (< flyspell-pre-point flyspell-word-cache-start) (> flyspell-pre-point flyspell-word-cache-end))))) -;*---------------------------------------------------------------------*/ -;* The flyspell after-change-hook, store the change position. In */ -;* the post command hook, we will check, if the word at this */ -;* position has to be spell checked. */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* The flyspell after-change-hook, store the change position. In */ +;;* the post command hook, we will check, if the word at this */ +;;* position has to be spell checked. */ +;;*---------------------------------------------------------------------*/ (defvar flyspell-changes nil) -;*---------------------------------------------------------------------*/ -;* flyspell-after-change-function ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-after-change-function ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-after-change-function (start stop len) "Save the current buffer and point for Flyspell's post-command hook." (interactive) (setq flyspell-changes (cons (cons start stop) flyspell-changes))) -;*---------------------------------------------------------------------*/ -;* flyspell-check-changed-word-p ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-check-changed-word-p ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-check-changed-word-p (start stop) "Return t when the changed word has to be checked. The answer depends of several criteria. @@ -745,9 +733,9 @@ (t t))) -;*---------------------------------------------------------------------*/ -;* flyspell-check-word-p ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-check-word-p ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-check-word-p () "Return t when the word at `point' has to be checked. The answer depends of several criteria. @@ -777,67 +765,57 @@ (t t))) (t t))) -;*---------------------------------------------------------------------*/ -;* flyspell-debug-signal-no-check ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-debug-signal-no-check ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-debug-signal-no-check (msg obj) (setq debug-on-error t) - (save-excursion - (let ((buffer (get-buffer-create "*flyspell-debug*"))) - (set-buffer buffer) - (erase-buffer) - (insert "NO-CHECK:\n") - (insert (format " %S : %S\n" msg obj))))) + (with-current-buffer (get-buffer-create "*flyspell-debug*") + (erase-buffer) + (insert "NO-CHECK:\n") + (insert (format " %S : %S\n" msg obj)))) -;*---------------------------------------------------------------------*/ -;* flyspell-debug-signal-pre-word-checked ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-debug-signal-pre-word-checked ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-debug-signal-pre-word-checked () (setq debug-on-error t) - (save-excursion - (let ((buffer (get-buffer-create "*flyspell-debug*"))) - (set-buffer buffer) - (insert "PRE-WORD:\n") - (insert (format " pre-point : %S\n" flyspell-pre-point)) - (insert (format " pre-buffer : %S\n" flyspell-pre-buffer)) - (insert (format " cache-start: %S\n" flyspell-word-cache-start)) - (insert (format " cache-end : %S\n" flyspell-word-cache-end)) - (goto-char (point-max))))) + (with-current-buffer (get-buffer-create "*flyspell-debug*") + (insert "PRE-WORD:\n") + (insert (format " pre-point : %S\n" flyspell-pre-point)) + (insert (format " pre-buffer : %S\n" flyspell-pre-buffer)) + (insert (format " cache-start: %S\n" flyspell-word-cache-start)) + (insert (format " cache-end : %S\n" flyspell-word-cache-end)) + (goto-char (point-max)))) -;*---------------------------------------------------------------------*/ -;* flyspell-debug-signal-word-checked ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-debug-signal-word-checked ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-debug-signal-word-checked () (setq debug-on-error t) - (save-excursion - (let ((oldbuf (current-buffer)) - (buffer (get-buffer-create "*flyspell-debug*")) - (point (point))) - (set-buffer buffer) + (let ((oldbuf (current-buffer)) + (point (point))) + (with-current-buffer (get-buffer-create "*flyspell-debug*") (insert "WORD:\n") (insert (format " this-cmd : %S\n" this-command)) (insert (format " delayed : %S\n" (and (symbolp this-command) (get this-command 'flyspell-delayed)))) (insert (format " point : %S\n" point)) (insert (format " prev-char : [%c] %S\n" - (progn - (set-buffer oldbuf) + (with-current-buffer oldbuf (let ((c (if (> (point) (point-min)) (save-excursion (backward-char 1) (char-after (point))) ? ))) - (set-buffer buffer) c)) - (progn - (set-buffer oldbuf) + (with-current-buffer oldbuf (let ((c (if (> (point) (point-min)) (save-excursion (backward-char 1) (and (and (looking-at (flyspell-get-not-casechars)) 1) (and (or flyspell-consider-dash-as-word-delimiter-flag (not (looking-at "\\-"))) 2)))))) - (set-buffer buffer) c)))) (insert (format " because : %S\n" (cond @@ -846,15 +824,13 @@ ;; the current command is not delayed, that ;; is that we must check the word now 'not-delayed) - ((progn - (set-buffer oldbuf) + ((with-current-buffer oldbuf (let ((c (if (> (point) (point-min)) (save-excursion (backward-char 1) (and (looking-at (flyspell-get-not-casechars)) (or flyspell-consider-dash-as-word-delimiter-flag (not (looking-at "\\-")))))))) - (set-buffer buffer) c)) ;; yes because we have reached or typed a word delimiter. 'separator) @@ -865,33 +841,31 @@ 'sit-for)))) (goto-char (point-max))))) -;*---------------------------------------------------------------------*/ -;* flyspell-debug-signal-changed-checked ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-debug-signal-changed-checked ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-debug-signal-changed-checked () (setq debug-on-error t) - (save-excursion - (let ((buffer (get-buffer-create "*flyspell-debug*")) - (point (point))) - (set-buffer buffer) + (let ((point (point))) + (with-current-buffer (get-buffer-create "*flyspell-debug*") (insert "CHANGED WORD:\n") (insert (format " point : %S\n" point)) (goto-char (point-max))))) -;*---------------------------------------------------------------------*/ -;* flyspell-post-command-hook ... */ -;* ------------------------------------------------------------- */ -;* It is possible that we check several words: */ -;* 1- the current word is checked if the predicate */ -;* FLYSPELL-CHECK-WORD-P is true */ -;* 2- the word that used to be the current word before the */ -;* THIS-COMMAND is checked if: */ -;* a- the previous word is different from the current word */ -;* b- the previous word as not just been checked by the */ -;* previous FLYSPELL-POST-COMMAND-HOOK */ -;* 3- the words changed by the THIS-COMMAND that are neither the */ -;* previous word nor the current word */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-post-command-hook ... */ +;;* ------------------------------------------------------------- */ +;;* It is possible that we check several words: */ +;;* 1- the current word is checked if the predicate */ +;;* FLYSPELL-CHECK-WORD-P is true */ +;;* 2- the word that used to be the current word before the */ +;;* THIS-COMMAND is checked if: */ +;;* a- the previous word is different from the current word */ +;;* b- the previous word as not just been checked by the */ +;;* previous FLYSPELL-POST-COMMAND-HOOK */ +;;* 3- the words changed by the THIS-COMMAND that are neither the */ +;;* previous word nor the current word */ +;;*---------------------------------------------------------------------*/ (defun flyspell-post-command-hook () "The `post-command-hook' used by flyspell to check a word in-the-fly." (interactive) @@ -899,9 +873,8 @@ ;; Prevent anything we do from affecting the mark. deactivate-mark) (if (flyspell-check-pre-word-p) - (save-excursion + (with-current-buffer flyspell-pre-buffer '(flyspell-debug-signal-pre-word-checked) - (set-buffer flyspell-pre-buffer) (save-excursion (goto-char flyspell-pre-point) (flyspell-word)))) @@ -937,21 +910,21 @@ (setq flyspell-changes (cdr flyspell-changes)))) (setq flyspell-previous-command command))) -;*---------------------------------------------------------------------*/ -;* flyspell-notify-misspell ... */ -;*---------------------------------------------------------------------*/ -(defun flyspell-notify-misspell (start end word poss) +;;*---------------------------------------------------------------------*/ +;;* flyspell-notify-misspell ... */ +;;*---------------------------------------------------------------------*/ +(defun flyspell-notify-misspell (word poss) (let ((replacements (if (stringp poss) poss (if flyspell-sort-corrections (sort (car (cdr (cdr poss))) 'string<) (car (cdr (cdr poss))))))) (if flyspell-issue-message-flag - (message "mispelling `%s' %S" word replacements)))) + (message "misspelling `%s' %S" word replacements)))) -;*---------------------------------------------------------------------*/ -;* flyspell-word-search-backward ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-word-search-backward ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-word-search-backward (word bound) (save-excursion (let ((r '()) @@ -963,9 +936,9 @@ (goto-char p)))) r))) -;*---------------------------------------------------------------------*/ -;* flyspell-word-search-forward ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-word-search-forward ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-word-search-forward (word bound) (save-excursion (let ((r '()) @@ -977,9 +950,9 @@ (goto-char (1+ p))))) r))) -;*---------------------------------------------------------------------*/ -;* flyspell-word ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-word ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-word (&optional following) "Spell check a word." (interactive (list ispell-following-word)) @@ -987,8 +960,8 @@ ;; use the correct dictionary (flyspell-accept-buffer-local-defs) (let* ((cursor-location (point)) - (flyspell-word (flyspell-get-word following)) - start end poss word) + (flyspell-word (flyspell-get-word following)) + start end poss word) (if (or (eq flyspell-word nil) (and (fboundp flyspell-generic-check-word-p) (not (funcall flyspell-generic-check-word-p)))) @@ -1031,18 +1004,20 @@ (setq flyspell-word-cache-end end) (setq flyspell-word-cache-word word) ;; now check spelling of word. - (process-send-string ispell-process "%\n") + (ispell-send-string "%\n") ;; put in verbose mode - (process-send-string ispell-process - (concat "^" word "\n")) + (ispell-send-string (concat "^" word "\n")) ;; we mark the ispell process so it can be killed ;; when emacs is exited without query (set-process-query-on-exit-flag ispell-process nil) - ;; wait until ispell has processed word - (while (progn - (accept-process-output ispell-process) - (not (string= "" (car ispell-filter))))) - ;; (process-send-string ispell-process "!\n") + ;; Wait until ispell has processed word. Since this code is often + ;; executed rom post-command-hook but the ispell process may not + ;; be responsive, it's important to make sure we re-enable C-g. + (with-local-quit + (while (progn + (accept-process-output ispell-process) + (not (string= "" (car ispell-filter)))))) + ;; (ispell-send-string "!\n") ;; back to terse mode. (setq ispell-filter (cdr ispell-filter)) (if (consp ispell-filter) @@ -1105,27 +1080,27 @@ (if flyspell-highlight-flag (flyspell-highlight-incorrect-region start end poss) - (flyspell-notify-misspell start end word poss)) + (flyspell-notify-misspell word poss)) nil)))) ;; return to original location (goto-char cursor-location) (if ispell-quit (setq ispell-quit nil)) res)))))))) -;*---------------------------------------------------------------------*/ -;* flyspell-tex-math-initialized ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-tex-math-initialized ... */ +;;*---------------------------------------------------------------------*/ (defvar flyspell-tex-math-initialized nil) -;*---------------------------------------------------------------------*/ -;* flyspell-math-tex-command-p ... */ -;* ------------------------------------------------------------- */ -;* This function uses the texmathp package to check if (point) */ -;* is within a tex command. In order to avoid using */ -;* condition-case each time we use the variable */ -;* flyspell-tex-math-initialized to make a special case the first */ -;* time that function is called. */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-math-tex-command-p ... */ +;;* ------------------------------------------------------------- */ +;;* This function uses the texmathp package to check if (point) */ +;;* is within a tex command. In order to avoid using */ +;;* condition-case each time we use the variable */ +;;* flyspell-tex-math-initialized to make a special case the first */ +;;* time that function is called. */ +;;*---------------------------------------------------------------------*/ (defun flyspell-math-tex-command-p () (when (fboundp 'texmathp) (cond @@ -1143,9 +1118,9 @@ (setq flyspell-tex-math-initialized 'error) nil))))))) -;*---------------------------------------------------------------------*/ -;* flyspell-tex-command-p ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-tex-command-p ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-tex-command-p (word) "Return t if WORD is a TeX command." (or (save-excursion @@ -1157,17 +1132,17 @@ (>= (match-end 0) b)))))) (flyspell-math-tex-command-p))) -;*---------------------------------------------------------------------*/ -;* flyspell-casechars-cache ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-casechars-cache ... */ +;;*---------------------------------------------------------------------*/ (defvar flyspell-casechars-cache nil) (defvar flyspell-ispell-casechars-cache nil) (make-variable-buffer-local 'flyspell-casechars-cache) (make-variable-buffer-local 'flyspell-ispell-casechars-cache) -;*---------------------------------------------------------------------*/ -;* flyspell-get-casechars ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-get-casechars ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-get-casechars () "This function builds a string that is the regexp of word chars. In order to avoid one useless string construction, @@ -1187,17 +1162,17 @@ (setq flyspell-casechars-cache ispell-casechars) flyspell-casechars-cache)))) -;*---------------------------------------------------------------------*/ -;* flyspell-get-not-casechars-cache ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-get-not-casechars-cache ... */ +;;*---------------------------------------------------------------------*/ (defvar flyspell-not-casechars-cache nil) (defvar flyspell-ispell-not-casechars-cache nil) (make-variable-buffer-local 'flyspell-not-casechars-cache) (make-variable-buffer-local 'flyspell-ispell-not-casechars-cache) -;*---------------------------------------------------------------------*/ -;* flyspell-get-not-casechars ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-get-not-casechars ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-get-not-casechars () "This function builds a string that is the regexp of non-word chars." (let ((ispell-not-casechars (ispell-get-not-casechars))) @@ -1215,9 +1190,9 @@ (setq flyspell-not-casechars-cache ispell-not-casechars) flyspell-not-casechars-cache)))) -;*---------------------------------------------------------------------*/ -;* flyspell-get-word ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-get-word ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-get-word (following &optional extra-otherchars) "Return the word for spell-checking according to Ispell syntax. If optional argument FOLLOWING is non-nil or if `flyspell-following-word' @@ -1278,9 +1253,9 @@ word (buffer-substring-no-properties start end)) (list word start end))))) -;*---------------------------------------------------------------------*/ -;* flyspell-small-region ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-small-region ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-small-region (beg end) "Flyspell text between BEG and END." (save-excursion @@ -1307,23 +1282,23 @@ (if flyspell-issue-message-flag (message "Spell Checking completed.")) (flyspell-word))) -;*---------------------------------------------------------------------*/ -;* flyspell-external-ispell-process ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-external-ispell-process ... */ +;;*---------------------------------------------------------------------*/ (defvar flyspell-external-ispell-process '() "The external Flyspell Ispell process.") -;*---------------------------------------------------------------------*/ -;* flyspell-external-ispell-buffer ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-external-ispell-buffer ... */ +;;*---------------------------------------------------------------------*/ (defvar flyspell-external-ispell-buffer '()) (defvar flyspell-large-region-buffer '()) (defvar flyspell-large-region-beg (point-min)) (defvar flyspell-large-region-end (point-max)) -;*---------------------------------------------------------------------*/ -;* flyspell-external-point-words ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-external-point-words ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-external-point-words () "Mark words from a buffer listing incorrect words in order of appearance. The list of incorrect words should be in `flyspell-external-ispell-buffer'. @@ -1374,9 +1349,47 @@ (kill-buffer flyspell-external-ispell-buffer) (setq flyspell-external-ispell-buffer nil)) -;*---------------------------------------------------------------------*/ -;* flyspell-large-region ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-process-localwords ... */ +;;* ------------------------------------------------------------- */ +;;* This function is used to prevent marking of words explicitly */ +;;* declared correct. */ +;;*---------------------------------------------------------------------*/ +(defun flyspell-process-localwords (misspellings-buffer) + (let (localwords + (ispell-casechars (ispell-get-casechars))) + ;; Get localwords from the original buffer + (save-excursion + (goto-char (point-min)) + ;; Localwords parsing copied from ispell.el. + (while (search-forward ispell-words-keyword nil t) + (let ((end (save-excursion (end-of-line) (point))) + string) + ;; buffer-local words separated by a space, and can contain + ;; any character other than a space. Not rigorous enough. + (while (re-search-forward " *\\([^ ]+\\)" end t) + (setq string (buffer-substring-no-properties (match-beginning 1) + (match-end 1))) + ;; This can fail when string contains a word with invalid chars. + ;; Error handling needs to be added between Ispell and Emacs. + (if (and (< 1 (length string)) + (equal 0 (string-match ispell-casechars string))) + (push string localwords)))))) + ;; Remove localwords matches from misspellings-buffer. + ;; The usual mechanism of communicating the local words to ispell + ;; does not affect the special ispell process used by + ;; flyspell-large-region. + (with-current-buffer misspellings-buffer + (save-excursion + (dolist (word localwords) + (goto-char (point-min)) + (let ((regexp (concat "^" word "\n"))) + (while (re-search-forward regexp nil t) + (delete-region (match-beginning 0) (match-end 0))))))))) + +;;*---------------------------------------------------------------------*/ +;;* flyspell-large-region ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-large-region (beg end) (let* ((curbuf (current-buffer)) (buffer (get-buffer-create "*flyspell-region*"))) @@ -1384,6 +1397,7 @@ (setq flyspell-large-region-buffer curbuf) (setq flyspell-large-region-beg beg) (setq flyspell-large-region-end end) + (flyspell-accept-buffer-local-defs) (set-buffer buffer) (erase-buffer) ;; this is done, we can start checking... @@ -1416,18 +1430,22 @@ (setq args (append args ispell-extra-args)) args)))) (if (eq c 0) - (flyspell-external-point-words) + (progn + (flyspell-process-localwords buffer) + (with-current-buffer curbuf + (flyspell-delete-region-overlays beg end)) + (flyspell-external-point-words)) (error "Can't check region..."))))) -;*---------------------------------------------------------------------*/ -;* flyspell-region ... */ -;* ------------------------------------------------------------- */ -;* Because `ispell -a' is too slow, it is not possible to use */ -;* it on large region. Then, when ispell is invoked on a large */ -;* text region, a new `ispell -l' process is spawned. The */ -;* pointed out words are then searched in the region a checked with */ -;* regular flyspell means. */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-region ... */ +;;* ------------------------------------------------------------- */ +;;* Because `ispell -a' is too slow, it is not possible to use */ +;;* it on large region. Then, when ispell is invoked on a large */ +;;* text region, a new `ispell -l' process is spawned. The */ +;;* pointed out words are then searched in the region a checked with */ +;;* regular flyspell means. */ +;;*---------------------------------------------------------------------*/ ;;;###autoload (defun flyspell-region (beg end) "Flyspell text between BEG and END." @@ -1443,24 +1461,24 @@ (flyspell-large-region beg end) (flyspell-small-region beg end))))) -;*---------------------------------------------------------------------*/ -;* flyspell-buffer ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-buffer ... */ +;;*---------------------------------------------------------------------*/ ;;;###autoload (defun flyspell-buffer () "Flyspell whole buffer." (interactive) (flyspell-region (point-min) (point-max))) -;*---------------------------------------------------------------------*/ -;* old next error position ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* old next error position ... */ +;;*---------------------------------------------------------------------*/ (defvar flyspell-old-buffer-error nil) (defvar flyspell-old-pos-error nil) -;*---------------------------------------------------------------------*/ -;* flyspell-goto-next-error ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-goto-next-error ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-goto-next-error () "Go to the next previously detected error. In general FLYSPELL-GOTO-NEXT-ERROR must be used after @@ -1495,30 +1513,30 @@ (if (= pos max) (message "No more miss-spelled word!")))) -;*---------------------------------------------------------------------*/ -;* flyspell-overlay-p ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-overlay-p ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-overlay-p (o) "A predicate that return true iff O is an overlay used by flyspell." (and (overlayp o) (overlay-get o 'flyspell-overlay))) -;*---------------------------------------------------------------------*/ -;* flyspell-delete-all-overlays ... */ -;* ------------------------------------------------------------- */ -;* Remove all the overlays introduced by flyspell. */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-delete-region-overlays, flyspell-delete-all-overlays */ +;;* ------------------------------------------------------------- */ +;;* Remove overlays introduced by flyspell. */ +;;*---------------------------------------------------------------------*/ +(defun flyspell-delete-region-overlays (beg end) + "Delete overlays used by flyspell in a given region." + (remove-overlays beg end 'flyspell-overlay t)) + + (defun flyspell-delete-all-overlays () "Delete all the overlays used by flyspell." - (let ((l (overlays-in (point-min) (point-max)))) - (while (consp l) - (progn - (if (flyspell-overlay-p (car l)) - (delete-overlay (car l))) - (setq l (cdr l)))))) + (flyspell-delete-region-overlays (point-min) (point-max))) -;*---------------------------------------------------------------------*/ -;* flyspell-unhighlight-at ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-unhighlight-at ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-unhighlight-at (pos) "Remove the flyspell overlay that are located at POS." (if flyspell-persistent-highlight @@ -1528,13 +1546,13 @@ (delete-overlay (car overlays))) (setq overlays (cdr overlays)))) (if (flyspell-overlay-p flyspell-overlay) - (delete-overlay flyspell-overlay)))) + (delete-overlay flyspell-overlay)))) -;*---------------------------------------------------------------------*/ -;* flyspell-properties-at-p ... */ -;* ------------------------------------------------------------- */ -;* Is there an highlight properties at position pos? */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-properties-at-p ... */ +;;* ------------------------------------------------------------- */ +;;* Is there an highlight properties at position pos? */ +;;*---------------------------------------------------------------------*/ (defun flyspell-properties-at-p (pos) "Return t if there is a text property at POS, not counting `local-map'. If variable `flyspell-highlight-properties' is set to nil, @@ -1548,33 +1566,33 @@ (setq keep nil))) (consp prop))) -;*---------------------------------------------------------------------*/ -;* make-flyspell-overlay ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* make-flyspell-overlay ... */ +;;*---------------------------------------------------------------------*/ (defun make-flyspell-overlay (beg end face mouse-face) "Allocate an overlay to highlight an incorrect word. BEG and END specify the range in the buffer of that word. FACE and MOUSE-FACE specify the `face' and `mouse-face' properties for the overlay." - (let ((flyspell-overlay (make-overlay beg end nil t nil))) - (overlay-put flyspell-overlay 'face face) - (overlay-put flyspell-overlay 'mouse-face mouse-face) - (overlay-put flyspell-overlay 'flyspell-overlay t) - (overlay-put flyspell-overlay 'evaporate t) - (overlay-put flyspell-overlay 'help-echo "mouse-2: correct word at point") - (overlay-put flyspell-overlay 'keymap flyspell-mouse-map) + (let ((overlay (make-overlay beg end nil t nil))) + (overlay-put overlay 'face face) + (overlay-put overlay 'mouse-face mouse-face) + (overlay-put overlay 'flyspell-overlay t) + (overlay-put overlay 'evaporate t) + (overlay-put overlay 'help-echo "mouse-2: correct word at point") + (overlay-put overlay 'keymap flyspell-mouse-map) (when (eq face 'flyspell-incorrect) (and (stringp flyspell-before-incorrect-word-string) - (overlay-put flyspell-overlay 'before-string + (overlay-put overlay 'before-string flyspell-before-incorrect-word-string)) (and (stringp flyspell-after-incorrect-word-string) - (overlay-put flyspell-overlay 'after-string + (overlay-put overlay 'after-string flyspell-after-incorrect-word-string))) - flyspell-overlay)) + overlay)) -;*---------------------------------------------------------------------*/ -;* flyspell-highlight-incorrect-region ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-highlight-incorrect-region ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-highlight-incorrect-region (beg end poss) "Set up an overlay on a misspelled word, in the buffer from BEG to END. POSS is usually a list of possible spelling/correction lists, @@ -1596,22 +1614,15 @@ (delete-overlay (car os))) (setq os (cdr os))))) ;; we cleanup current overlay at the same position - (if (and (not flyspell-persistent-highlight) - (overlayp flyspell-overlay)) - (delete-overlay flyspell-overlay) - (let ((os (overlays-at beg))) - (while (consp os) - (if (flyspell-overlay-p (car os)) - (delete-overlay (car os))) - (setq os (cdr os))))) + (flyspell-unhighlight-at beg) ;; now we can use a new overlay (setq flyspell-overlay (make-flyspell-overlay beg end 'flyspell-incorrect 'highlight))))))) -;*---------------------------------------------------------------------*/ -;* flyspell-highlight-duplicate-region ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-highlight-duplicate-region ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-highlight-duplicate-region (beg end poss) "Set up an overlay on a duplicate misspelled word, in the buffer from BEG to END. POSS is a list of possible spelling/correction lists, @@ -1623,23 +1634,16 @@ (not (flyspell-properties-at-p beg))) (progn ;; we cleanup current overlay at the same position - (if (and (not flyspell-persistent-highlight) - (overlayp flyspell-overlay)) - (delete-overlay flyspell-overlay) - (let ((overlays (overlays-at beg))) - (while (consp overlays) - (if (flyspell-overlay-p (car overlays)) - (delete-overlay (car overlays))) - (setq overlays (cdr overlays))))) + (flyspell-unhighlight-at beg) ;; now we can use a new overlay (setq flyspell-overlay (make-flyspell-overlay beg end 'flyspell-duplicate 'highlight))))))) -;*---------------------------------------------------------------------*/ -;* flyspell-auto-correct-cache ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-auto-correct-cache ... */ +;;*---------------------------------------------------------------------*/ (defvar flyspell-auto-correct-pos nil) (defvar flyspell-auto-correct-region nil) (defvar flyspell-auto-correct-ring nil) @@ -1649,9 +1653,9 @@ (make-variable-buffer-local 'flyspell-auto-correct-ring) (make-variable-buffer-local 'flyspell-auto-correct-word) -;*---------------------------------------------------------------------*/ -;* flyspell-check-previous-highlighted-word ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-check-previous-highlighted-word ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-check-previous-highlighted-word (&optional arg) "Correct the closer misspelled word. This function scans a mis-spelled word before the cursor. If it finds one @@ -1672,7 +1676,7 @@ (while (consp ovs) (setq ov (car ovs)) (setq ovs (cdr ovs)) - (if (and (overlay-get ov 'flyspell-overlay) + (if (and (flyspell-overlay-p ov) (= 0 (setq arg (1- arg)))) (throw 'exit t))))))) (save-excursion @@ -1680,9 +1684,9 @@ (ispell-word)) (error "No word to correct before point")))) -;*---------------------------------------------------------------------*/ -;* flyspell-display-next-corrections ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-display-next-corrections ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-display-next-corrections (corrections) (let ((string "Corrections:") (l corrections) @@ -1703,25 +1707,25 @@ (display-message 'no-log string) (message "%s" string)))) -;*---------------------------------------------------------------------*/ -;* flyspell-abbrev-table ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-abbrev-table ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-abbrev-table () (if flyspell-use-global-abbrev-table-p global-abbrev-table (or local-abbrev-table global-abbrev-table))) -;*---------------------------------------------------------------------*/ -;* flyspell-define-abbrev ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-define-abbrev ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-define-abbrev (name expansion) (let ((table (flyspell-abbrev-table))) (when table (define-abbrev table name expansion)))) -;*---------------------------------------------------------------------*/ -;* flyspell-auto-correct-word ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-auto-correct-word ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-auto-correct-word () "Correct the current word. This command proposes various successive corrections for the current word." @@ -1763,12 +1767,12 @@ poss) (setq flyspell-auto-correct-word word) ;; now check spelling of word. - (process-send-string ispell-process "%\n") ;put in verbose mode - (process-send-string ispell-process (concat "^" word "\n")) - ;; wait until ispell has processed word - (while (progn - (accept-process-output ispell-process) - (not (string= "" (car ispell-filter))))) + (ispell-send-string "%\n") ;put in verbose mode + (ispell-send-string (concat "^" word "\n")) + ;; wait until ispell has processed word. + (while (progn + (accept-process-output ispell-process) + (not (string= "" (car ispell-filter))))) (setq ispell-filter (cdr ispell-filter)) (if (consp ispell-filter) (setq poss (ispell-parse-output (car ispell-filter)))) @@ -1821,15 +1825,15 @@ (setq flyspell-auto-correct-pos (point)) (ispell-pdict-save t))))))) -;*---------------------------------------------------------------------*/ -;* flyspell-auto-correct-previous-pos ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-auto-correct-previous-pos ... */ +;;*---------------------------------------------------------------------*/ (defvar flyspell-auto-correct-previous-pos nil "Holds the start of the first incorrect word before point.") -;*---------------------------------------------------------------------*/ -;* flyspell-auto-correct-previous-hook ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-auto-correct-previous-hook ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-auto-correct-previous-hook () "Hook to track successive calls to `flyspell-auto-correct-previous-word'. Sets `flyspell-auto-correct-previous-pos' to nil" @@ -1838,11 +1842,11 @@ (unless (eq this-command (function flyspell-auto-correct-previous-word)) (setq flyspell-auto-correct-previous-pos nil))) -;*---------------------------------------------------------------------*/ -;* flyspell-auto-correct-previous-word ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-auto-correct-previous-word ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-auto-correct-previous-word (position) - "*Auto correct the first mispelled word that occurs before point. + "Auto correct the first mispelled word that occurs before point. But don't look beyond what's visible on the screen." (interactive "d") @@ -1892,9 +1896,9 @@ ;; the point may have moved so reset this (setq flyspell-auto-correct-previous-pos (point)))))))) -;*---------------------------------------------------------------------*/ -;* flyspell-correct-word ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-correct-word ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-correct-word (event) "Pop up a menu of possible corrections for a misspelled word. The word checked is the word at the mouse position." @@ -1912,12 +1916,12 @@ (word (car word)) poss) ;; now check spelling of word. - (process-send-string ispell-process "%\n") ;put in verbose mode - (process-send-string ispell-process (concat "^" word "\n")) + (ispell-send-string "%\n") ;put in verbose mode + (ispell-send-string (concat "^" word "\n")) ;; wait until ispell has processed word - (while (progn - (accept-process-output ispell-process) - (not (string= "" (car ispell-filter))))) + (while (progn + (accept-process-output ispell-process) + (not (string= "" (car ispell-filter))))) (setq ispell-filter (cdr ispell-filter)) (if (consp ispell-filter) (setq poss (ispell-parse-output (car ispell-filter)))) @@ -1930,16 +1934,16 @@ (error "Ispell: error in Ispell process")) ((featurep 'xemacs) (flyspell-xemacs-popup - event poss word cursor-location start end save)) + poss word cursor-location start end save)) (t ;; The word is incorrect, we have to propose a replacement. (flyspell-do-correct (flyspell-emacs-popup event poss word) poss word cursor-location start end save))) (ispell-pdict-save t)))))) -;*---------------------------------------------------------------------*/ -;* flyspell-do-correct ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-do-correct ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-do-correct (replace poss word cursor-location start end save) "The popup menu callback." ;; Originally, the XEmacs code didn't do the (goto-char save) here and did @@ -1988,9 +1992,9 @@ (goto-char save) nil))) -;*---------------------------------------------------------------------*/ -;* flyspell-ajust-cursor-point ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-ajust-cursor-point ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-ajust-cursor-point (save cursor-location old-max) (if (>= save cursor-location) (let ((new-pos (+ save (- (point-max) old-max)))) @@ -2002,9 +2006,9 @@ (t new-pos)))) (goto-char save))) -;*---------------------------------------------------------------------*/ -;* flyspell-emacs-popup ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-emacs-popup ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-emacs-popup (event poss word) "The Emacs popup menu." (if (not event) @@ -2044,10 +2048,10 @@ ispell-dictionary)) menu))))) -;*---------------------------------------------------------------------*/ -;* flyspell-xemacs-popup ... */ -;*---------------------------------------------------------------------*/ -(defun flyspell-xemacs-popup (event poss word cursor-location start end save) +;;*---------------------------------------------------------------------*/ +;;* flyspell-xemacs-popup ... */ +;;*---------------------------------------------------------------------*/ +(defun flyspell-xemacs-popup (poss word cursor-location start end save) "The XEmacs popup menu." (let* ((corrects (if flyspell-sort-corrections (sort (car (cdr (cdr poss))) 'string<) @@ -2117,9 +2121,9 @@ ispell-dictionary)) menu)))) -;*---------------------------------------------------------------------*/ -;* Some example functions for real autocorrecting */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* Some example functions for real autocorrecting */ +;;*---------------------------------------------------------------------*/ (defun flyspell-maybe-correct-transposition (beg end poss) "Check replacements for transposed characters. @@ -2176,16 +2180,16 @@ (setq i (1+ i)))) nil))) -;*---------------------------------------------------------------------*/ -;* flyspell-already-abbrevp ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-already-abbrevp ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-already-abbrevp (table word) (let ((sym (abbrev-symbol word table))) (and sym (symbolp sym)))) -;*---------------------------------------------------------------------*/ -;* flyspell-change-abbrev ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-change-abbrev ... */ +;;*---------------------------------------------------------------------*/ (defun flyspell-change-abbrev (table old new) (set (abbrev-symbol old table) new))
--- a/lisp/textmodes/org.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/textmodes/org.el Fri Nov 18 13:13:34 2005 +0000 @@ -9103,7 +9103,6 @@ (if org-export-html-with-timestamp (insert org-export-html-html-helper-timestamp)) (insert "</body>\n</html>\n") - (debug) (normal-mode) (save-buffer) (goto-char (point-min)))))
--- a/lisp/textmodes/reftex.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/textmodes/reftex.el Fri Nov 18 13:13:34 2005 +0000 @@ -2262,7 +2262,7 @@ (defun reftex-use-fonts () ;; Return t if we can and want to use fonts. - (and window-system + (and ; window-system reftex-use-fonts (featurep 'font-lock)))
--- a/lisp/url/ChangeLog Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/url/ChangeLog Fri Nov 18 13:13:34 2005 +0000 @@ -1,9 +1,14 @@ +2005-11-16 Juergen Hoetzel <emacs@hoetzel.info> (tiny change) + + * url-handlers.el (url-insert-file-contents): Use the charset info + provided by the HTTP server, if any. + 2005-10-20 CHENG Gao <chenggao@gmail.com> (tiny change) - * url-nfs.el (top level): - * url-handlers.el (directory-files): + * url-nfs.el (top level): + * url-handlers.el (directory-files): * url-file.el (top level): - * url-dired.el (url-dired-minor-mode-map): + * url-dired.el (url-dired-minor-mode-map): * url-http.el (url-http-chunked-encoding-after-change-function): Remove XEmacs support.
--- a/lisp/url/url-handlers.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/url/url-handlers.el Fri Nov 18 13:13:34 2005 +0000 @@ -202,6 +202,7 @@ (defun url-insert-file-contents (url &optional visit beg end replace) (let ((buffer (url-retrieve-synchronously url)) (handle nil) + (charset nil) (data nil)) (if (not buffer) (error "Opening input file: No such file or directory, %s" url)) @@ -215,13 +216,14 @@ (mm-destroy-parts handle) (if replace (delete-region (point-min) (point-max))) (save-excursion + (setq charset (mail-content-type-get (mm-handle-type handle) + 'charset)) (let ((start (point))) - (insert data) - ;; FIXME: for text/plain data, we sometimes receive a `charset' - ;; annotation which we could use as a hint of the locale in use - ;; at the remote site. Not sure how/if that should be done. --Stef - (decode-coding-inserted-region - start (point) url visit beg end replace))) + (if charset + (insert (mm-decode-string data (mm-charset-to-coding-system charset))) + (progn + (insert data) + (decode-coding-inserted-region start (point) url visit beg end replace))))) (list url (length data)))) (defun url-file-name-completion (url directory)
--- a/lisp/vc-svn.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/vc-svn.el Fri Nov 18 13:13:34 2005 +0000 @@ -116,8 +116,11 @@ (cd (file-name-directory file)) (condition-case nil (vc-svn-command t 0 file "status" "-v") - ;; We can't find an `svn' executable. We could also deregister SVN. - (file-error nil)) + ;; Some problem happened. E.g. We can't find an `svn' executable. + ;; We used to only catch `file-error' but when the process is run on + ;; a remote host via Tramp, the error is only reported via the + ;; exit status which is turned into an `error' by vc-do-command. + (error nil)) (vc-svn-parse-status t) (eq 'SVN (vc-file-getprop file 'vc-backend)))))
--- a/lisp/wid-edit.el Mon Nov 07 15:25:27 2005 +0000 +++ b/lisp/wid-edit.el Fri Nov 18 13:13:34 2005 +0000 @@ -3575,7 +3575,7 @@ ;; Fixme: match (define-widget 'color 'editable-field "Choose a color name (with sample)." - :format "%t: %v (%{sample%})\n" + :format "%{%t%}: %v (%{sample%})\n" :size 10 :tag "Color" :value "black"
--- a/lispref/ChangeLog Mon Nov 07 15:25:27 2005 +0000 +++ b/lispref/ChangeLog Fri Nov 18 13:13:34 2005 +0000 @@ -1,3 +1,8 @@ +2005-11-16 Stefan Monnier <monnier@iro.umontreal.ca> + + * modes.texi (Minor Mode Conventions): Use custom-set-minor-mode. + (Minor Mode Conventions): Mention the use of a hook. + 2005-11-06 Richard M. Stallman <rms@gnu.org> * files.texi (Magic File Names): find-file-name-handler checks the @@ -31,9 +36,9 @@ 2005-10-27 Masatake YAMATO <jet@gyve.org> - * minibuf.texi (Completion Commands): + * minibuf.texi (Completion Commands): Write about new optional argument for `display-completion-list'. - + 2005-10-23 Richard M. Stallman <rms@gnu.org> * display.texi (Overlay Arrow): Clarify about local bindings of
--- a/lispref/modes.texi Mon Nov 07 15:25:27 2005 +0000 +++ b/lispref/modes.texi Fri Nov 18 13:13:34 2005 +0000 @@ -1214,8 +1214,8 @@ There are conventions for writing minor modes just as there are for major modes. Several of the major mode conventions apply to minor modes as well: those regarding the name of the mode initialization -function, the names of global symbols, and the use of keymaps and -other tables. +function, the names of global symbols, the use of a hook at the end of +the initialization function, and the use of keymaps and other tables. In addition, there are several conventions that are specific to minor modes. (The easiest way to follow all the conventions is to use @@ -1327,8 +1327,7 @@ "Toggle msb-mode. Setting this variable directly does not take effect; use either \\[customize] or the function `msb-mode'." - :set (lambda (symbol value) - (msb-mode (or value 0))) + :set 'custom-set-minor-mode :initialize 'custom-initialize-default :version "20.4" :type 'boolean
--- a/lispref/windows.texi Mon Nov 07 15:25:27 2005 +0000 +++ b/lispref/windows.texi Fri Nov 18 13:13:34 2005 +0000 @@ -488,7 +488,7 @@ The following functions choose one of the windows on the screen, offering various criteria for the choice. -@defun get-lru-window &optional frame +@defun get-lru-window &optional frame dedicated This function returns the window least recently ``used'' (that is, selected). If any full-width windows are present, it only considers these. The selected window is always the most recently used window. @@ -496,7 +496,8 @@ The selected window can be the least recently used window if it is the only window. A newly created window becomes the least recently used window until it is selected. A minibuffer window is never a -candidate. Dedicated windows are never candidates, and if all +candidate. Dedicated windows are never candidates unless the +@var{dedicated} argument is non-@code{nil}, so if all existing windows are dedicated, the value is @code{nil}. The argument @var{frame} controls which windows are considered. @@ -515,11 +516,12 @@ @end itemize @end defun -@defun get-largest-window &optional frame +@defun get-largest-window &optional frame dedicated This function returns the window with the largest area (height times width). If there are no side-by-side windows, then this is the window with the most lines. A minibuffer window is never a candidate. -Dedicated windows are never candidates, and if all existing windows +Dedicated windows are never candidates unless the +@var{dedicated} argument is non-@code{nil}, so if all existing windows are dedicated, the value is @code{nil}. If there are two candidate windows of the same size, this function
--- a/mac/ChangeLog Mon Nov 07 15:25:27 2005 +0000 +++ b/mac/ChangeLog Fri Nov 18 13:13:34 2005 +0000 @@ -1,3 +1,7 @@ +2005-11-09 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * makefile.MPW (shortlisp): Sync with src/Makefile.in. + 2005-10-24 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> * INSTALL: Replace `Mac OS 8/9' with `Mac OS Classic'. Add
--- a/mac/makefile.MPW Mon Nov 07 15:25:27 2005 +0000 +++ b/mac/makefile.MPW Fri Nov 18 13:13:34 2005 +0000 @@ -1077,6 +1077,9 @@ {Lisp}subr.elc ¶ {Lisp}term:tty-colors.elc ¶ {Lisp}font-core.elc ¶ + {Lisp}emacs-lisp:syntax.elc ¶ + {Lisp}font-lock.elc ¶ + {Lisp}jit-lock.elc ¶ {Lisp}textmodes:fill.elc ¶ {Lisp}textmodes:page.elc ¶ {Lisp}textmodes:paragraphs.elc ¶
--- a/man/ChangeLog Mon Nov 07 15:25:27 2005 +0000 +++ b/man/ChangeLog Fri Nov 18 13:13:34 2005 +0000 @@ -1,3 +1,59 @@ +2005-11-16 Chong Yidong <cyd@stupidchicken.com> + + * ack.texi (Acknowledgments): Acknowledge Andrew Zhilin for Emacs + icons. + +2005-11-12 Kim F. Storm <storm@cua.dk> + + * help.texi (Help): Fix C-h a entry. Add C-h d entry. + (Help Summary): Add C-h d and C-h e. + (Apropos): Clarify that all apropos commands may search for either + list of words or a regexp. Add C-h d for apropos-documentation. + Describe apropos-documentation-sort-by-scores user option. + +2005-11-10 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus.texi (XVarious): Fix description of gnus-use-toolbar; add + new variable gnus-toolbar-thickness. + +2005-11-08 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus.texi (XVarious): Revert description of gnus-use-toolbar. + +2005-11-07 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus.texi (X-Face): Fix description. + (XVarious): Remove gnus-xmas-logo-color-alist and + gnus-xmas-logo-color-style; fix description of gnus-use-toolbar. + +2005-11-01 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus.texi (Group Parameters): Mention new varable + gnus-parameters-case-fold-search. + (Home Score File): Addition. + +2005-11-09 Luc Teirlinck <teirllm@auburn.edu> + + * killing.texi (CUA Bindings): Add @section. + +2005-11-10 Kim F. Storm <storm@cua.dk> + + * emacs.texi (Top): Add CUA Bindings entry to menu. + + * killing.texi (CUA Bindings): New node. Moved here from + misc.texi and extended with info on rectangle commands and + rectangle highlighting, interface to registers, and the global + mark feature. + + * misc.texi (Emulation): Move CUA bindings item to killing.texi. + + * regs.texi: Prev link points to CUA Bindings node. + +2005-11-07 Luc Teirlinck <teirllm@auburn.edu> + + * help.texi (Help Echo): By default, help echos are only shown on + mouse-over, not on point-over. + 2005-11-04 J,bi(Br,bt(Bme Marant <jerome@marant.org> * misc.texi (Shell Mode): Describe how to activate password echoing.
--- a/man/ack.texi Mon Nov 07 15:25:27 2005 +0000 +++ b/man/ack.texi Fri Nov 18 13:13:34 2005 +0000 @@ -1471,6 +1471,9 @@ @end itemize @item +Andrew Zhilin created the Emacs icons used beginning with Emacs 22. + +@item Shenghuo Zhu wrote: @itemize @minus
--- a/man/emacs.texi Mon Nov 07 15:25:27 2005 +0000 +++ b/man/emacs.texi Fri Nov 18 13:13:34 2005 +0000 @@ -285,6 +285,8 @@ syntactic units such as words and sentences. * Graphical Kill:: The kill ring on graphical terminals: yanking between applications. +* CUA Bindings:: Using @kbd{C-x}, @kbd{C-c}, @kbd{C-v} for copy + and paste, with enhanced rectangle support. Yanking
--- a/man/gnus.texi Mon Nov 07 15:25:27 2005 +0000 +++ b/man/gnus.texi Fri Nov 18 13:13:34 2005 +0000 @@ -3060,6 +3060,19 @@ String value of parameters will be subjected to regexp substitution, as the @code{to-group} example shows. +@vindex gnus-parameters-case-fold-search +By default, whether comparing the group name and one of those regexps +specified in @code{gnus-parameters} is done in a case-sensitive manner +or a case-insensitive manner depends on the value of +@code{case-fold-search} at the time when the comparison is done. The +value of @code{case-fold-search} is typically @code{t}; it means, for +example, the element @code{("INBOX\\.FOO" (total-expire . t))} might be +applied to both the @samp{INBOX.FOO} group and the @samp{INBOX.foo} +group. If you want to make those regexps always case-sensitive, set the +value of the @code{gnus-parameters-case-fold-search} variable to +@code{nil}. Otherwise, set it to @code{t} if you want to compare them +always in a case-insensitive manner. + @node Listing Groups @section Listing Groups @@ -19755,7 +19768,8 @@ @item A function. If the function returns non-@code{nil}, the result will -be used as the home score file. +be used as the home score file. The function will be called with the +name of the group as the parameter. @item A string. Use the string as the home score file. @@ -21967,11 +21981,11 @@ If the @code{gnus-article-x-face-too-ugly} (which is a regexp) matches the @code{From} header, the face will not be shown. -The default action under Emacs 20 is to fork off the @code{display} -program@footnote{@code{display} is from the ImageMagick package. For -the @code{uncompface} and @code{icontopbm} programs look for a package -like @code{compface} or @code{faces-xface} on a GNU/Linux system.} to -view the face. +The default action under Emacs without image support is to fork off the +@code{display} program@footnote{@code{display} is from the ImageMagick +package. For the @code{uncompface} and @code{icontopbm} programs look +for a package like @code{compface} or @code{faces-xface} on a GNU/Linux +system.} to view the face. Under XEmacs or Emacs 21+ with suitable image support, the default action is to display the face before the @code{From} header. (It's @@ -22217,18 +22231,6 @@ auto-detect this directory, but you may set it manually if you have an unusual directory structure. -@item gnus-xmas-logo-color-alist -@vindex gnus-xmas-logo-color-alist -This is an alist where the key is a type symbol and the values are the -foreground and background color of the splash page glyph. - -@item gnus-xmas-logo-color-style -@vindex gnus-xmas-logo-color-style -This is the key used to look up the color in the alist described above. -Valid values include @code{flame}, @code{pine}, @code{moss}, -@code{irish}, @code{sky}, @code{tin}, @code{velvet}, @code{grape}, -@code{labia}, @code{berry}, @code{neutral}, and @code{september}. - @item gnus-xmas-modeline-glyph @vindex gnus-xmas-modeline-glyph A glyph displayed in all Gnus mode lines. It is a tiny gnu head by @@ -22242,9 +22244,19 @@ @item gnus-use-toolbar @vindex gnus-use-toolbar -If @code{nil}, don't display toolbars. If non-@code{nil}, it should be -one of @code{default-toolbar}, @code{top-toolbar}, @code{bottom-toolbar}, -@code{right-toolbar}, or @code{left-toolbar}. +This variable specifies the position to display the toolbar. If +@code{nil}, don't display toolbars. If it is non-nil, it should be one +of the symbols @code{default}, @code{top}, @code{bottom}, @code{right}, +and @code{left}. @code{default} means to use the default toolbar, the +rest mean to display the toolbar on the place which those names show. +The default is @code{default}. + +@item gnus-toolbar-thickness +@vindex gnus-toolbar-thickness +Cons of the height and the width specifying the thickness of a toolbar. +The height is used for the toolbar displayed on the top or the bottom, +the width is used for the toolbar displayed on the right or the left. +The default is that of the default toolbar. @item gnus-group-toolbar @vindex gnus-group-toolbar
--- a/man/help.texi Mon Nov 07 15:25:27 2005 +0000 +++ b/man/help.texi Fri Nov 18 13:13:34 2005 +0000 @@ -46,17 +46,19 @@ @table @kbd @item C-h a @var{topic} @key{RET} This searches for commands whose names match @var{topic}, which should -be a regular expression (@pxref{Regexps}). Browse the buffer that this -command displays to find what you are looking for. @xref{Apropos}. +be a list of words or a regular expression (@pxref{Regexps}). Browse +the buffer that this command displays to find what you are looking +for. @xref{Apropos}. @item M-x apropos @key{RET} @var{topic} @key{RET} This works like @kbd{C-h a}, but it also searches for noninteractive functions and for variables. @xref{Apropos}. -@item M-x apropos-documentation @key{RET} @var{topic} @key{RET} +@item C-h d @var{topic} @key{RET} This searches the @emph{documentation strings} (the built-in short descriptions) of all variables and functions (not their names) for a -match for @var{topic}, a regular expression. @xref{Apropos}. +match for @var{topic}, a list or words or a regular expression. +@xref{Apropos}. @item C-h i d m emacs @key{RET} i @var{topic} @key{RET} This looks up @var{topic} in the indices of the Emacs on-line manual. @@ -111,8 +113,8 @@ pre-written file of information. @table @kbd -@item C-h a @var{regexp} @key{RET} -Display a list of commands whose names match @var{regexp} +@item C-h a @var{topic} @key{RET} +Display a list of commands whose names match word list or regexp @var{topic} (@code{apropos-command}). @item C-h b Display a table of all key bindings in effect now, in this order: minor @@ -122,6 +124,13 @@ Show the name of the command that @var{key} runs (@code{describe-key-briefly}). Here @kbd{c} stands for ``character.'' For more extensive information on @var{key}, use @kbd{C-h k}. +@item C-h d @var{topic} @key{RET} +Display a list of commands and variables whose documentation match +word list or regexp @var{topic} +(@code{apropos-documentation}). +@item C-h e +Display the @code{*Messages*} buffer +(@code{view-echo-area-messages}). @item C-h f @var{function} @key{RET} Display documentation on the Lisp function named @var{function} (@code{describe-function}). Since commands are Lisp functions, @@ -304,25 +313,27 @@ @end quotation @findex apropos-variable - To list all user variables that match a regexp, use the command -@kbd{M-x apropos-variable}. By default, this command shows only -variables meant for user customization; if you specify a prefix + To list all user variables that match a word list or regexp, use the +command @kbd{M-x apropos-variable}. By default, this command shows +only variables meant for user customization; if you specify a prefix argument, it checks all variables. @findex apropos - To list all Lisp symbols that contain a match for a regexp, not just -the ones that are defined as commands, use the command @kbd{M-x apropos} -instead of @kbd{C-h a}. This command does not check key bindings by -default; specify a numeric argument if you want it to check them. + To list all Lisp symbols that contain a match for a word list or +regexp, not just the ones that are defined as commands, use the +command @kbd{M-x apropos} instead of @kbd{C-h a}. This command does +not check key bindings by default; specify a numeric argument if you +want it to check them. +@kindex C-h d @findex apropos-documentation The @code{apropos-documentation} command is like @code{apropos} except that it searches documentation strings as well as symbol names for -matches for the specified regular expression. +matches for the specified topic, a word list or regular expression. @findex apropos-value The @code{apropos-value} command is like @code{apropos} except that it -searches symbols' values for matches for the specified regular +searches symbols' values for matches for the specified word list or regular expression. This command does not check function definitions or property lists by default; specify a numeric argument if you want it to check them. @@ -338,6 +349,12 @@ Apropos tries to guess the relevance of each result, and displays the most relevant ones first. +@vindex apropos-documentation-sort-by-scores + By default, Apropos lists the search results for + @code{apropos-documentation} in order of relevance. +If the variable @code{apropos-documentation-sort-by-scores} is @code{nil}, +Apropos will list documentation in alphabetical order. + If you want more information about a function definition, variable or symbol property listed in the Apropos buffer, you can click on it with @kbd{Mouse-1} or @kbd{Mouse-2}, or move there and type @key{RET}. @@ -613,8 +630,10 @@ the mouse or a key like @kbd{RET}, it often has associated help text. Areas of the mode line are examples. On most window systems, the help text is displayed as a ``tooltip'' (sometimes known as ``balloon -help''). @xref{Tooltips}. Otherwise, it is shown in the echo area -when you move point into the active text. +help''), when you move the mouse over the active text. @xref{Tooltips}. +On some systems, it is shown in the echo area. On text-only +terminals, Emacs may not be able to follow the mouse and hence will +not show the help text on mouse-over. @kindex C-h . @findex display-local-help
--- a/man/killing.texi Mon Nov 07 15:25:27 2005 +0000 +++ b/man/killing.texi Fri Nov 18 13:13:34 2005 +0000 @@ -520,7 +520,7 @@ editing in Emacs would change the file behind Emacs's back, which can lead to losing some of your editing. -@node Rectangles, Registers, Accumulating Text, Top +@node Rectangles, CUA Bindings, Accumulating Text, Top @section Rectangles @cindex rectangle @cindex columns (and rectangles) @@ -644,6 +644,52 @@ @code{string-rectangle}, but inserts the string on each line, shifting the original text to the right. +@node CUA Bindings, Registers, Rectangles, Top +@section CUA Bindings +@findex cua-mode +@vindex cua-mode +@cindex CUA key bindings +@vindex cua-enable-cua-keys + The command @kbd{M-x cua-mode} sets up key bindings that are +compatible with the Common User Access (CUA) system used in many other +applications. @kbd{C-x} means cut (kill), @kbd{C-c} copy, @kbd{C-v} +paste (yank), and @kbd{C-z} undo. Standard Emacs commands like +@kbd{C-x C-c} still work, because @kbd{C-x} and @kbd{C-c} only take +effect when the mark is active. However, if you don't want these +bindings at all, set @code{cua-enable-cua-keys} to @code{nil}. + + In CUA mode, using @kbd{Shift} together with the movement keys +activates the region over which they move. The standard (unshifted) +movement keys deactivate the mark, and typed text replaces the active +region as in Delete-Selection mode (@pxref{Graphical Kill}). + +@cindex rectangle highlighting + CUA mode provides enhanced rectangle support with visible +rectangle highlighting. Use @kbd{C-RET} to start a rectangle, +extend it using the movement commands, and cut or copy it using +@kbd{C-x} or @kbd{C-c}. When a rectangle is active, text you type is +automatically inserted before or after each line in the rectangle. + + With CUA you can easily copy text and rectangles into and out of +registers by providing a one-digit numeric prefix the the kill, copy, +and yank commands, e.g. @kbd{C-1 C-c} copies the region into register +@code{1}, and @kbd{C-2 C-v} yanks the contents of register @code{2}. + +@cindex global mark + CUA mode also has a global mark feature which allows easy moving and +copying of text between buffers. Use @kbd{C-S-SPC} to toggle the +global mark on and off. When the global mark is on, all text that you +kill or copy is automatically inserted at the global mark, and text +you type is inserted at the global mark rather than at the current +position. + + For example, to copy words from various buffers into a word list in +a given buffer, set the global mark in the target buffer, then +navigate to each of the words you want in the list, mark it (e.g. with +@kbd{S-M-f}), copy it to the list with @kbd{C-c} or @kbd{M-w}, and +insert a newline after the word in the target list by pressing +@key{RET}. + @ifnottex @lowersections @end ifnottex
--- a/man/mini.texi Mon Nov 07 15:25:27 2005 +0000 +++ b/man/mini.texi Fri Nov 18 13:13:34 2005 +0000 @@ -109,6 +109,9 @@ normally a useful thing to write): it means, ``ignore everything before the second slash in the pair.'' Thus, @samp{/u2/emacs/src/} is ignored in the example above, and you get the file @file{/etc/termcap}. +By default the ignored part of the file name is made dim if the +terminal allows it. This is affected by the +@code{file-name-shadow-mode} minor mode. If you set @code{insert-default-directory} to @code{nil}, the default directory is not inserted in the minibuffer. This way, the minibuffer
--- a/man/misc.texi Mon Nov 07 15:25:27 2005 +0000 +++ b/man/misc.texi Fri Nov 18 13:13:34 2005 +0000 @@ -2136,29 +2136,6 @@ are done in the global keymap, so there is no problem switching buffers or major modes while in EDT emulation. -@item CUA bindings -@findex cua-mode -@vindex cua-mode -@cindex CUA key bindings -@vindex cua-enable-cua-keys -The command @kbd{M-x cua-mode} sets up key bindings that are -compatible with the Common User Access (CUA) system used in many other -applications. @kbd{C-x} means cut (kill), @kbd{C-c} copy, @kbd{C-v} -paste (yank), and @kbd{C-z} undo. Standard Emacs commands like -@kbd{C-x C-c} still work, because @kbd{C-x} and @kbd{C-c} only take -effect when the mark is active. However, if you don't want these -bindings at all, set @code{cua-enable-cua-keys} to @code{nil}. - -In CUA mode, using @kbd{Shift} together with the movement keys -activates the region over which they move. The standard (unshifted) -movement keys deactivate the mark, and typed text replaces the active -region as in Delete-Selection mode (@pxref{Graphical Kill}). - -CUA mode also provides enhanced rectangle support with visible -rectangle highlighting. Use @kbd{Shift-RET} to start a rectangle, -extend it using the movement commands, and cut or copy it using -@kbd{C-x} or @kbd{C-c}. - @item TPU (DEC VMS editor) @findex tpu-edt-on @cindex TPU
--- a/man/regs.texi Mon Nov 07 15:25:27 2005 +0000 +++ b/man/regs.texi Fri Nov 18 13:13:34 2005 +0000 @@ -2,7 +2,7 @@ @c Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1997, 2002, 2003, @c 2004, 2005 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. -@node Registers, Display, Rectangles, Top +@node Registers, Display, CUA Bindings, Top @chapter Registers @cindex registers
--- a/src/.gdbinit Mon Nov 07 15:25:27 2005 +0000 +++ b/src/.gdbinit Fri Nov 18 13:13:34 2005 +0000 @@ -31,6 +31,9 @@ # However, C-z works just as well in that case. handle 2 noprint pass +# Make it work like SIGINT normally does. +handle SIGTSTP nopass + # Don't pass SIGALRM to Emacs. This makes problems when # debugging. handle SIGALRM ignore @@ -66,13 +69,53 @@ # Print out s-expressions define pp set $tmp = $arg0 - set debug_print ($tmp) + set safe_debug_print ($tmp) end document pp Print the argument as an emacs s-expression Works only when an inferior emacs is executing. end +# Print out s-expressions from tool bar +define pp1 + set $tmp = $arg0 + echo $arg0 + printf " = " + set safe_debug_print ($tmp) +end +document pp1 +Print the argument as an emacs s-expression +Works only when an inferior emacs is executing. +For use on tool bar when debugging in Emacs +where the variable name would not otherwise +be recorded in the GUD buffer. +end + +# Print value of lisp variable +define pv + set $tmp = "$arg0" + set safe_debug_print ( find_symbol_value (intern ($tmp))) +end +document pv +Print the value of the lisp variable given as argument. +Works only when an inferior emacs is executing. +end + +# Print value of lisp variable +define pv1 + set $tmp = "$arg0" + echo $arg0 + printf " = " + set safe_debug_print (find_symbol_value (intern ($tmp))) +end +document pv1 +Print the value of the lisp variable given as argument. +Works only when an inferior emacs is executing. +For use on tool bar when debugging in Emacs +where the variable name would not otherwise +be recorded in the GUD buffer. +end + # Print out current buffer point and boundaries define ppt set $b = current_buffer @@ -122,7 +165,7 @@ printf " HL" end if ($it->n_overlay_strings > 0) - printf " nov=%d" + printf " nov=%d", $it->n_overlay_strings end if ($it->sp != 0) printf " sp=%d", $it->sp @@ -672,6 +715,16 @@ an error was signaled. end +# Show Lisp backtrace after normal backtrace. +define hookpost-backtrace + set $bt = backtrace_list + if $bt + echo \n + echo Lisp Backtrace:\n + xbacktrace + end +end + define xreload set $tagmask = (((long)1 << gdb_gctypebits) - 1) set $valmask = gdb_use_lsb ? ~($tagmask) : ((long)1 << gdb_valbits) - 1
--- a/src/ChangeLog Mon Nov 07 15:25:27 2005 +0000 +++ b/src/ChangeLog Fri Nov 18 13:13:34 2005 +0000 @@ -1,3 +1,152 @@ +2005-11-16 Stefan Monnier <monnier@iro.umontreal.ca> + + * lread.c (readevalloop): Add missing GCPROs. + +2005-11-16 Chong Yidong <cyd@stupidchicken.com> + + * xfns.c (xg_set_icon_from_xpm_data): New function. + + * gnu.h (gnu_xpm_bits): Rename from gnu_bits. + (gnu_xbm_bits): Rename from gnu_bits (xbm version). + + * xterm.c (x_bitmap_icon): Use the xpm if available. + + * image.c (x_create_bitmap_from_xpm_data): New function. + (x_create_bitmap_from_xpm_data): Initialize XpmAttributes. + +2005-11-15 Luc Teirlinck <teirllm@auburn.edu> + + * Makefile.in (lisp, shortlisp): Add rfn-eshadow. + +2005-11-16 Nick Roberts <nickrob@snap.net.nz> + + * .gdbinit: Make SIGTSTP work like SIGINT normally does. + +2005-11-15 Andreas Schwab <schwab@suse.de> + + * lisp.h (struct Lisp_Cons): Make cdr a union. + (XCDR_AS_LVALUE): Adjust. + (struct Lisp_Float): Make data a union. + (XFLOAT_DATA): Adjust. + + * alloc.c (free_float): Make free list chaining aliasing-safe. + (make_float): Likewise. + (free_cons): Likewise. + (Fcons): Likewise. + (check_cons_list): Likewise. + (Fmake_symbol): Likewise. + (allocate_misc): Likewise. + (free_misc): Likewise. + (gc_sweep): Likewise. + +2005-11-15 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * mac.c (HASHKEY_QUERY_CACHE): New define. + (xrm_create_database, xrm_q_put_resource): Empty query cache. + (xrm_get_resource): Use query cache. + + * image.c (init_image) [MAC_OS]: Don't call EnterMovies if + inhibit_window_system is set. + +2005-11-13 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * macgui.h (USE_CG_TEXT_DRAWING): New define. + (struct MacFontStruct) [USE_CG_TEXT_DRAWING]: New members cg_font + and cg_glyphs. + + * macterm.c [USE_CG_TEXT_DRAWING] (mac_draw_string_cg): New function. + (x_draw_glyph_string_foreground) [USE_CG_TEXT_DRAWING]: Use it. + (XLoadQueryFont) [USE_CG_TEXT_DRAWING]: Set members cg_font and + cg_glyphs in struct MacFontStruct if synthesized bold or italic is + not used and font substitution never occurs for ASCII and Latin-1 + characters. + (XLoadQueryFont): Maximum and minimum metrics are now those among + ASCII characters. + (XLoadQueryFont) [!MAC_OS8 || USE_ATSUI]: Apply WebKit-style + height adjustments for Courier, Helvetica, and Times. + + * s/darwin.h (LIBS_CARBON) [!HAVE_CARBON]: Remove `-framework Carbon'. + +2005-11-11 David Reitter <david.reitter@gmail.com> + + * macterm.c (syms_of_macterm): Remove macCtrlKey, macShiftKey, + macMetaKey, macAltKey. Introduce Qctrl, Qmeta, + Vmac_control_modifier / mac-control-modifier, + Vmac_option_modifier / mac-option-modifier, + Vmac_command_modifier / mac-command-modifier. + (mac_to_emacs_modifiers): Use the new style modifier + variables. Return UInt32 (modifiers are longs now.) + (backtranslate_modified_keycode): New function (refactoring). + (XTread_socket): Use new modifier variables and refactored function. + (mac_determine_quit_char_modifiers): Remove macMetaKey (there is + no dedicated meta key. Not in use anyway.) + (convert_fn_keycode): Map Fn-keys to their original keycode + using a table (english keyboard only). + +2005-11-11 Kim F. Storm <storm@cua.dk> + + * .gdbinit (pitx): Fix output format if n_overlay_strings > 0. + Add post hook to "backtrace" to always dump lisp call stack to + increase chance of people sending it to us when reporting bugs. + + * doc.c (Fsubstitute_command_keys): Doc fix. + + * dispextern.h (struct it): New member ignore_overlay_strings_at_pos_p. + + * xdisp.c (handle_stop): Skip overlay string handling if + ignore_overlay_strings_at_pos_p is set. + (set_iterator_to_next): At end of display vector, set + ignore_overlay_strings_at_pos_p if dpvec came from an overlay + string, so we skip those overlay strings at current pos. + +2005-11-10 Lars Hansen <larsh@soem.dk> + + * fileio.c (file-regular-p): Doc fix. + +2005-11-10 Kim F. Storm <storm@cua.dk> + + * alloc.c (valid_lisp_object_p): New function to validate that + an object is really a valid Lisp_Object. + + * lisp.h (valid_lisp_object_p): Add prototype. + + * print.c (safe_debug_print): New function to be called from gdb + to print Lisp objects; use valid_lisp_object_p to avoid crashing + if user tries to print something which is not a Lisp object. + + * .gdbinit (pp, pp1): Use safe_debug_print. + (pv, pv1): New commands to print value of a lisp variable. + +2005-11-10 Nick Roberts <nickrob@snap.net.nz> + + * .gdbinit (pp1): New user-defined function. + +2005-11-09 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * image.c [MAC_OSX] (image_load_quartz2d): Fix memory leak. + + * mac.c [MAC_OSX] (init_mac_osx_environment): Reinitialize locale + related variables for dumped executable. + + * unexmacosx.c (unexec_write_zero): New function. + (copy_data_segment): Clear uninitialized local variables in + statically linked libraries. + + * s/darwin.h (C_SWITCH_SYSTEM): Remove -fno-common. + +2005-11-09 Juri Linkov <juri@jurta.org> + + * keymap.c (shadow_lookup): If Flookup_key returns a number, + call it again with a sub-key-sequence, and if its return value + is non-nil (sub-key is bound), return nil. + +2005-11-08 Kim F. Storm <storm@cua.dk> + + * process.c (Fsignal_process): Recognize signal names with and + without SIG prefix, e.g. SIGHUP and HUP. + + * search.c (search_buffer): No need to initialize base_pat. + 2005-11-04 Stefan Monnier <monnier@iro.umontreal.ca> * window.c (Fget_lru_window, Fget_largest_window, window_loop): @@ -179,7 +328,7 @@ from last_mouse_glyph_frame, and update last_mouse_glyph_frame. (XTmouse_position): Set last_mouse_glyph_frame. (XTread_socket): Clear last_mouse_glyph_frame on mouse up/down event. - (mac_draw_string_common) [MAC_OSX && WORDS_BIG_ENDIAN]: Fix typo. + (mac_draw_string_common) [USE_ATSUI && WORDS_BIG_ENDIAN]: Fix typo. Use EndianU16_BtoN. (mac_draw_string_common) [MAC_OSX]: Don't use ATSUClearLayoutControls. (x_per_char_metric, XLoadQueryFont)
--- a/src/Makefile.in Mon Nov 07 15:25:27 2005 +0000 +++ b/src/Makefile.in Fri Nov 18 13:13:34 2005 +0000 @@ -725,6 +725,7 @@ ${lispsource}help.elc \ ${lispsource}indent.elc \ ${lispsource}isearch.elc \ + ${lispsource}rfn-eshadow.elc \ ${lispsource}loadup.el \ ${lispsource}loaddefs.el \ ${lispsource}bindings.elc \ @@ -821,6 +822,7 @@ ../lisp/help.elc \ ../lisp/indent.elc \ ../lisp/isearch.elc \ + ../lisp/rfn-eshadow.elc \ ../lisp/loadup.el \ ../lisp/loaddefs.el \ ../lisp/bindings.elc \
--- a/src/alloc.c Mon Nov 07 15:25:27 2005 +0000 +++ b/src/alloc.c Fri Nov 18 13:13:34 2005 +0000 @@ -2532,7 +2532,7 @@ free_float (ptr) struct Lisp_Float *ptr; { - *(struct Lisp_Float **)&ptr->data = float_free_list; + ptr->u.chain = float_free_list; float_free_list = ptr; } @@ -2550,7 +2550,7 @@ /* We use the data field for chaining the free list so that we won't use the same field that has the mark bit. */ XSETFLOAT (val, float_free_list); - float_free_list = *(struct Lisp_Float **)&float_free_list->data; + float_free_list = float_free_list->u.chain; } else { @@ -2650,7 +2650,7 @@ free_cons (ptr) struct Lisp_Cons *ptr; { - *(struct Lisp_Cons **)&ptr->cdr = cons_free_list; + ptr->u.chain = cons_free_list; #if GC_MARK_STACK ptr->car = Vdead; #endif @@ -2669,7 +2669,7 @@ /* We use the cdr for chaining the free list so that we won't use the same field that has the mark bit. */ XSETCONS (val, cons_free_list); - cons_free_list = *(struct Lisp_Cons **)&cons_free_list->cdr; + cons_free_list = cons_free_list->u.chain; } else { @@ -2704,7 +2704,7 @@ struct Lisp_Cons *tail = cons_free_list; while (tail) - tail = *(struct Lisp_Cons **)&tail->cdr; + tail = tail->u.chain; #endif } @@ -3141,7 +3141,7 @@ if (symbol_free_list) { XSETSYMBOL (val, symbol_free_list); - symbol_free_list = *(struct Lisp_Symbol **)&symbol_free_list->value; + symbol_free_list = symbol_free_list->next; } else { @@ -4485,10 +4485,79 @@ #endif } - #endif /* GC_MARK_STACK != 0 */ + +/* Return 1 if OBJ is a valid lisp object. + Return 0 if OBJ is NOT a valid lisp object. + Return -1 if we cannot validate OBJ. +*/ + +int +valid_lisp_object_p (obj) + Lisp_Object obj; +{ +#if !GC_MARK_STACK + /* Cannot determine this. */ + return -1; +#else + void *p; + struct mem_node *m; + + if (INTEGERP (obj)) + return 1; + + p = (void *) XPNTR (obj); + + if (PURE_POINTER_P (p)) + return 1; + + m = mem_find (p); + + if (m == MEM_NIL) + return 0; + + switch (m->type) + { + case MEM_TYPE_NON_LISP: + return 0; + + case MEM_TYPE_BUFFER: + return live_buffer_p (m, p); + + case MEM_TYPE_CONS: + return live_cons_p (m, p); + + case MEM_TYPE_STRING: + return live_string_p (m, p); + + case MEM_TYPE_MISC: + return live_misc_p (m, p); + + case MEM_TYPE_SYMBOL: + return live_symbol_p (m, p); + + case MEM_TYPE_FLOAT: + return live_float_p (m, p); + + case MEM_TYPE_VECTOR: + case MEM_TYPE_PROCESS: + case MEM_TYPE_HASH_TABLE: + case MEM_TYPE_FRAME: + case MEM_TYPE_WINDOW: + return live_vector_p (m, p); + + default: + break; + } + + return 0; +#endif +} + + + /*********************************************************************** Pure Storage Management @@ -4969,7 +5038,7 @@ total += total_floats * sizeof (struct Lisp_Float); total += total_intervals * sizeof (struct interval); total += total_strings * sizeof (struct Lisp_String); - + gc_relative_threshold = total * XFLOAT_DATA (Vgc_cons_percentage); } else @@ -5496,14 +5565,14 @@ CHECK_ALLOCATED_AND_LIVE (live_cons_p); CONS_MARK (ptr); /* If the cdr is nil, avoid recursion for the car. */ - if (EQ (ptr->cdr, Qnil)) + if (EQ (ptr->u.cdr, Qnil)) { obj = ptr->car; cdr_count = 0; goto loop; } mark_object (ptr->car); - obj = ptr->cdr; + obj = ptr->u.cdr; cdr_count++; if (cdr_count == mark_object_loop_halt) abort (); @@ -5650,7 +5719,7 @@ if (!CONS_MARKED_P (&cblk->conses[i])) { this_free++; - *(struct Lisp_Cons **)&cblk->conses[i].cdr = cons_free_list; + cblk->conses[i].u.chain = cons_free_list; cons_free_list = &cblk->conses[i]; #if GC_MARK_STACK cons_free_list->car = Vdead; @@ -5669,7 +5738,7 @@ { *cprev = cblk->next; /* Unhook from the free list. */ - cons_free_list = *(struct Lisp_Cons **) &cblk->conses[0].cdr; + cons_free_list = cblk->conses[0].u.chain; lisp_align_free (cblk); n_cons_blocks--; } @@ -5700,7 +5769,7 @@ if (!FLOAT_MARKED_P (&fblk->floats[i])) { this_free++; - *(struct Lisp_Float **)&fblk->floats[i].data = float_free_list; + fblk->floats[i].u.chain = float_free_list; float_free_list = &fblk->floats[i]; } else @@ -5716,7 +5785,7 @@ { *fprev = fblk->next; /* Unhook from the free list. */ - float_free_list = *(struct Lisp_Float **) &fblk->floats[0].data; + float_free_list = fblk->floats[0].u.chain; lisp_align_free (fblk); n_float_blocks--; } @@ -5804,7 +5873,7 @@ if (!sym->gcmarkbit && !pure_p) { - *(struct Lisp_Symbol **) &sym->value = symbol_free_list; + sym->next = symbol_free_list; symbol_free_list = sym; #if GC_MARK_STACK symbol_free_list->function = Vdead; @@ -5828,7 +5897,7 @@ { *sprev = sblk->next; /* Unhook from the free list. */ - symbol_free_list = *(struct Lisp_Symbol **)&sblk->symbols[0].value; + symbol_free_list = sblk->symbols[0].next; lisp_free (sblk); n_symbol_blocks--; }
--- a/src/dispextern.h Mon Nov 07 15:25:27 2005 +0000 +++ b/src/dispextern.h Fri Nov 18 13:13:34 2005 +0000 @@ -1974,6 +1974,10 @@ /* 1 means overlay strings at end_charpos have been processed. */ unsigned overlay_strings_at_end_processed_p : 1; + /* 1 means to ignore overlay strings at current pos, as they have + already been processed. */ + unsigned ignore_overlay_strings_at_pos_p : 1; + /* 1 means the actual glyph is not available in the current system. */ unsigned glyph_not_available_p : 1;
--- a/src/doc.c Mon Nov 07 15:25:27 2005 +0000 +++ b/src/doc.c Fri Nov 18 13:13:34 2005 +0000 @@ -735,15 +735,18 @@ DEFUN ("substitute-command-keys", Fsubstitute_command_keys, Ssubstitute_command_keys, 1, 1, 0, doc: /* Substitute key descriptions for command names in STRING. -Return a new string which is STRING with substrings of the form \\=\\[COMMAND] -replaced by either: a keystroke sequence that will invoke COMMAND, -or "M-x COMMAND" if COMMAND is not on any keys. +Substrings of the form \\=\\[COMMAND] replaced by either: a keystroke +sequence that will invoke COMMAND, or "M-x COMMAND" if COMMAND is not +on any keys. Substrings of the form \\=\\{MAPVAR} are replaced by summaries \(made by describe-bindings) of the value of MAPVAR, taken as a keymap. Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR as the keymap for future \\=\\[COMMAND] substrings. \\=\\= quotes the following character and is discarded; -thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output. */) +thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output. + +Returns original STRING if no substitutions were made. Othwerwise, +a new string, without any text properties, is returned. */) (string) Lisp_Object string; {
--- a/src/fileio.c Mon Nov 07 15:25:27 2005 +0000 +++ b/src/fileio.c Fri Nov 18 13:13:34 2005 +0000 @@ -3394,8 +3394,10 @@ } DEFUN ("file-regular-p", Ffile_regular_p, Sfile_regular_p, 1, 1, 0, - doc: /* Return t if file FILENAME is the name of a regular file. -This is the sort of file that holds an ordinary stream of data bytes. */) + doc: /* Return t if FILENAME names a regular file. +This is the sort of file that holds an ordinary stream of data bytes. +Symbolic links to regular files count as regular files. +See `file-symlink-p' to distinguish symlinks. */) (filename) Lisp_Object filename; {
--- a/src/gnu.h Mon Nov 07 15:25:27 2005 +0000 +++ b/src/gnu.h Fri Nov 18 13:13:34 2005 +0000 @@ -1,6 +1,216 @@ -#define gnu_width 50 -#define gnu_height 50 -static unsigned char gnu_bits[] = { +#if defined (HAVE_XPM) && defined (HAVE_X_WINDOWS) +static char * gnu_xpm_bits[] = { +"32 32 173 2", +" c None", +". c #67627D", +"+ c #5F5A76", +"@ c #78748C", +"# c #DCDBE1", +"$ c #CFCED7", +"% c #B8B5C7", +"& c #ADA9C1", +"* c #A6A3B9", +"= c #9995A9", +"- c #878398", +"; c #C2C0CD", +"> c #9591AE", +", c #9B97B3", +"' c #BDBACC", +") c #9C98B3", +"! c #A9A6B9", +"~ c #8D89A0", +"{ c #A9A5BC", +"] c #938FAB", +"^ c #B4B2C5", +"/ c #F8F8FA", +"( c #E4E3EA", +"_ c #BCB9CB", +": c #9390A5", +"< c #5E5A75", +"[ c #8B87A1", +"} c #918DA9", +"| c #BAB7C9", +"1 c #FFFFFF", +"2 c #F1F1F4", +"3 c #B4B1C4", +"4 c #9D99AF", +"5 c #5D5974", +"6 c #8E8AA5", +"7 c #A3A0B6", +"8 c #F8F8F9", +"9 c #9F9CB3", +"0 c #8C88A3", +"a c #938FA9", +"b c #C6C4D1", +"c c #B7B4C5", +"d c #9D99B1", +"e c #5C5873", +"f c #8985A0", +"g c #B5B3C4", +"h c #F0F0F3", +"i c #A6A3B7", +"j c #9B98AE", +"k c #5C5872", +"l c #88849D", +"m c #A6A3B6", +"n c #F8F7F9", +"o c #C3C1CE", +"p c #9996AB", +"q c #5B5772", +"r c #85819A", +"s c #9491A7", +"t c #E0DFE6", +"u c #C2C0CC", +"v c #8C88A0", +"w c #9894A9", +"x c #5A5671", +"y c #838097", +"z c #B2B0BE", +"A c #F7F7F8", +"B c #D8D7DE", +"C c #928FA4", +"D c #9491A5", +"E c #5A5670", +"F c #817D95", +"G c #A9A6B6", +"H c #A8A5B6", +"I c #928FA3", +"J c #59556F", +"K c #7E7B91", +"L c #BEBDC8", +"M c #AEACBA", +"N c #908DA0", +"O c #5B5771", +"P c #58546D", +"Q c #65617A", +"R c #E0DFE4", +"S c #8E8B9E", +"T c #7A778D", +"U c #5A566F", +"V c #57536C", +"W c #58546F", +"X c #A19EAE", +"Y c #EAEAED", +"Z c #F5F4F6", +"` c #A19FAE", +" . c #625F78", +".. c #77748A", +"+. c #59556E", +"@. c #56526B", +"#. c #807D90", +"$. c #D5D4DA", +"%. c #9693A3", +"&. c #767387", +"*. c #55516A", +"=. c #534F68", +"-. c #9491A1", +";. c #F4F4F6", +">. c #9E9CAA", +",. c #5D5971", +"'. c #737084", +"). c #545068", +"!. c #504D64", +"~. c #F4F4F5", +"{. c #DEDDE2", +"]. c #5A576D", +"^. c #716F81", +"/. c #56526A", +"(. c #524F67", +"_. c #4D4A61", +":. c #9A99A6", +"<. c #848292", +"[. c #6F6C7F", +"}. c #545169", +"|. c #514E65", +"1. c #4A475D", +"2. c #6B697B", +"3. c #D2D1D6", +"4. c #F4F3F5", +"5. c #9998A4", +"6. c #6C6A7B", +"7. c #535067", +"8. c #504C64", +"9. c #474459", +"0. c #747282", +"a. c #D1D0D5", +"b. c #E8E8EA", +"c. c #8C8A97", +"d. c #676576", +"e. c #4E4B62", +"f. c #444156", +"g. c #727080", +"h. c #E8E7EA", +"i. c #8A8996", +"j. c #656374", +"k. c #524F66", +"l. c #423F53", +"m. c #B8B7BE", +"n. c #D0CFD4", +"o. c #4E4B5E", +"p. c #636171", +"q. c #4C485E", +"r. c #434054", +"s. c #3F3C4F", +"t. c #575465", +"u. c #CFCED3", +"v. c #646272", +"w. c #504C62", +"x. c #4B475D", +"y. c #3D3A4C", +"z. c #494657", +"A. c #7A7884", +"B. c #B7B6BC", +"C. c #DADADD", +"D. c #4F4B61", +"E. c #49455B", +"F. c #3A3748", +"G. c #5E5C6A", +"H. c #908E98", +"I. c #C1C0C6", +"J. c #F3F2F4", +"K. c #777581", +"L. c #474458", +"M. c #434053", +"N. c #3C3A4A", +"O. c #373544", +"P. c #454256", +" ", +" ", +" . + + + + + + + + + + + + + + + + + + + + + + + ", +" @ # $ % & & & & & & & & & & & & & & & & & & * = @ + ", +" @ - ; > > > > > > > > > > , ' ' ) > > > > > > > > ! . + ", +" @ ~ { ] ] ] ] ] ] ] ] ] ] ] ] ^ / ( _ ] ] ] ] ] ] ] : < ", +" . [ } } } } } } } } } } } } } } | 1 1 2 3 } } } } } 4 < ", +" 5 6 6 6 6 6 6 6 6 6 6 6 6 6 6 7 8 1 1 1 8 6 6 6 6 6 9 5 ", +" 5 0 0 0 0 0 0 0 0 0 0 0 0 a b 8 1 1 1 1 c 0 0 0 0 0 d 5 ", +" e f f f f f f f f f f f g h 1 1 1 1 h i f f f f f f j e ", +" k l l l l l l l l l m h 1 1 1 1 n o l l l l l l l l p k ", +" q r r r r r r r s t 1 1 1 1 1 u v r r r r r r r r r w q ", +" x y y y y y y z A 1 1 1 1 B C y y y y y y y y y y y D e ", +" E F F F F F G 1 1 1 1 A H F F F F F F F F F F F F F I k ", +" J K K K K K L 1 1 1 1 M K K K K K K K K K K K K K K N O ", +" P q q q q q Q R 1 1 1 S q q q q q q q q q q q q q q T U ", +" V W W W W W W W X Y 1 Z ` .W W W W W W W W W W W W ..+. ", +" @.@.@.@.@.@.@.#.$.1 1 1 1 1 %.@.@.@.@.@.@.@.@.@.@.@.&.P ", +" *.=.=.=.=.=.-.1 1 1 1 ;.>.,.=.=.=.=.=.=.=.=.=.=.=.=.'.V ", +" ).!.!.!.!.!.~.1 1 1 {.].!.!.!.!.!.!.!.!.!.!.!.!.!.!.^./. ", +" (._._._._._.:.1 1 1 <._._._._._._._._._._._._._._._.[.}. ", +" |.1.1.1.1.1.1.2.3.1 4.5.1.1.1.1.1.1.1.1.1.1.1.1.1.1.6.7. ", +" 8.9.9.9.9.9.9.9.9.0.a.1 b.c.9.9.9.9.9.9.9.9.9.9.9.9.d.). ", +" e.f.f.f.f.f.f.f.f.f.f.g.h.1 h.i.f.f.f.f.f.f.f.f.f.f.j.k. ", +" _.l.l.l.l.l.l.l.l.l.l.l.l.m.1 1 n.o.l.l.l.l.l.l.l.l.p.|. ", +" q.r.s.s.s.s.s.s.s.s.s.s.s.t.1 1 1 u.s.s.s.s.s.s.s.s.v.w. ", +" x.9.y.y.y.y.y.y.y.y.z.A.B.1 1 1 1 C.y.y.y.y.y.y.y.y.d.D. ", +" E.E.r.F.F.F.F.F.F.F.F.G.H.I.J.I.K.F.F.F.F.F.F.F.F.r.E.E. ", +" L.L.M.N.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.N.M.L.L. ", +" P.P.P.P.P.P.P.P.P.P.P.P.P.P.P.P.P.P.P.P.P.P.P.P. ", +" ", +" "}; +#endif /* defined (HAVE_XPM) && defined (HAVE_X_WINDOWS) */ + +#define gnu_xbm_width 50 +#define gnu_xbm_height 50 +static unsigned char gnu_xbm_bits[] = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x60, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x01, 0x00, 0x00,
--- a/src/image.c Mon Nov 07 15:25:27 2005 +0000 +++ b/src/image.c Fri Nov 18 13:13:34 2005 +0000 @@ -2549,6 +2549,7 @@ if (!check_image_size (f, width, height)) { + CGImageRelease (image); UNGCPRO; image_error ("Invalid image size", Qnil, Qnil); return 0; @@ -3715,6 +3716,45 @@ #endif /* HAVE_XPM || MAC_OS */ +#if defined (HAVE_XPM) && defined (HAVE_X_WINDOWS) +int +x_create_bitmap_from_xpm_data (f, bits) + struct frame *f; + char **bits; +{ + Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + int id, rc; + XpmAttributes attrs; + Pixmap bitmap, mask; + + bzero (&attrs, sizeof attrs); + + attrs.visual = FRAME_X_VISUAL (f); + attrs.colormap = FRAME_X_COLORMAP (f); + attrs.valuemask |= XpmVisual; + attrs.valuemask |= XpmColormap; + + rc = XpmCreatePixmapFromData (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + bits, &bitmap, &mask, &attrs); + if (rc != XpmSuccess) + return -1; + + id = x_allocate_bitmap_record (f); + + dpyinfo->bitmaps[id - 1].pixmap = bitmap; + dpyinfo->bitmaps[id - 1].have_mask = 1; + dpyinfo->bitmaps[id - 1].mask = mask; + dpyinfo->bitmaps[id - 1].file = NULL; + dpyinfo->bitmaps[id - 1].height = attrs.height; + dpyinfo->bitmaps[id - 1].width = attrs.width; + dpyinfo->bitmaps[id - 1].depth = attrs.depth; + dpyinfo->bitmaps[id - 1].refcount = 1; + + XpmFreeAttributes (&attrs); + return id; +} +#endif /* HAVE_X_WINDOWS */ + /* Load image IMG which will be displayed on frame F. Value is non-zero if successful. */ @@ -3762,6 +3802,9 @@ attrs.valuemask |= XpmCloseness; #endif /* not XpmAllocCloseColors */ #endif /* ALLOC_XPM_COLORS */ +#ifdef ALLOC_XPM_COLORS + xpm_init_color_cache (f, &attrs); +#endif /* If image specification contains symbolic color definitions, add these to `attrs'. */ @@ -8457,7 +8500,8 @@ { #ifdef MAC_OS /* Animated gifs use QuickTime Movie Toolbox. So initialize it here. */ - EnterMovies (); + if (!inhibit_window_system) + EnterMovies (); #ifdef MAC_OSX init_image_func_pointer (); #endif
--- a/src/keymap.c Mon Nov 07 15:25:27 2005 +0000 +++ b/src/keymap.c Fri Nov 18 13:13:34 2005 +0000 @@ -2370,7 +2370,13 @@ for (tail = shadow; CONSP (tail); tail = XCDR (tail)) { value = Flookup_key (XCAR (tail), key, flag); - if (!NILP (value) && !NATNUMP (value)) + if (NATNUMP (value)) + { + value = Flookup_key (XCAR (tail), Fsubstring (key, 0, value), flag); + if (!NILP (value)) + return Qnil; + } + else if (!NILP (value)) return value; } return Qnil;
--- a/src/lisp.h Mon Nov 07 15:25:27 2005 +0000 +++ b/src/lisp.h Fri Nov 18 13:13:34 2005 +0000 @@ -600,9 +600,19 @@ /* Please do not use the names of these elements in code other than the core lisp implementation. Use XCAR and XCDR below. */ #ifdef HIDE_LISP_IMPLEMENTATION - Lisp_Object car_, cdr_; + Lisp_Object car_; + union + { + Lisp_Object cdr_; + struct Lisp_Cons *chain; + } u; #else - Lisp_Object car, cdr; + Lisp_Object car; + union + { + Lisp_Object cdr; + struct Lisp_Cons *chain; + } u; #endif }; @@ -615,10 +625,10 @@ invalidated at arbitrary points.) */ #ifdef HIDE_LISP_IMPLEMENTATION #define XCAR_AS_LVALUE(c) (XCONS ((c))->car_) -#define XCDR_AS_LVALUE(c) (XCONS ((c))->cdr_) +#define XCDR_AS_LVALUE(c) (XCONS ((c))->u.cdr_) #else #define XCAR_AS_LVALUE(c) (XCONS ((c))->car) -#define XCDR_AS_LVALUE(c) (XCONS ((c))->cdr) +#define XCDR_AS_LVALUE(c) (XCONS ((c))->u.cdr) #endif /* Use these from normal code. */ @@ -1275,17 +1285,21 @@ /* Lisp floating point type */ struct Lisp_Float { + union + { #ifdef HIDE_LISP_IMPLEMENTATION - double data_; + double data_; #else - double data; + double data; #endif + struct Lisp_Float *chain; + } u; }; #ifdef HIDE_LISP_IMPLEMENTATION -#define XFLOAT_DATA(f) (XFLOAT (f)->data_) +#define XFLOAT_DATA(f) (XFLOAT (f)->u.data_) #else -#define XFLOAT_DATA(f) (XFLOAT (f)->data) +#define XFLOAT_DATA(f) (XFLOAT (f)->u.data) #endif /* A character, declared with the following typedef, is a member @@ -2549,6 +2563,7 @@ extern void init_alloc P_ ((void)); extern void syms_of_alloc P_ ((void)); extern struct buffer * allocate_buffer P_ ((void)); +extern int valid_lisp_object_p P_ ((Lisp_Object)); /* Defined in print.c */ extern Lisp_Object Vprin1_to_string_buffer;
--- a/src/lread.c Mon Nov 07 15:25:27 2005 +0000 +++ b/src/lread.c Fri Nov 18 13:13:34 2005 +0000 @@ -1317,7 +1317,7 @@ register int c; register Lisp_Object val; int count = SPECPDL_INDEX (); - struct gcpro gcpro1; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; struct buffer *b = 0; int continue_reading_p; @@ -1326,14 +1326,14 @@ else if (MARKERP (readcharfun)) b = XMARKER (readcharfun)->buffer; - specbind (Qstandard_input, readcharfun); + specbind (Qstandard_input, readcharfun); /* GCPROs readcharfun. */ specbind (Qcurrent_load_list, Qnil); record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil); load_convert_to_unibyte = !NILP (unibyte); readchar_backlog = -1; - GCPRO1 (sourcename); + GCPRO4 (sourcename, readfun, start, end); LOADHIST_ATTACH (sourcename);
--- a/src/mac.c Mon Nov 07 15:25:27 2005 +0000 +++ b/src/mac.c Fri Nov 18 13:13:34 2005 +0000 @@ -854,9 +854,14 @@ implemented as a hash table that maps a pair (SRC-NODE-ID . EDGE-LABEL) to DEST-NODE-ID. It also holds a maximum node id used in the table as a value for HASHKEY_MAX_NID. A value associated to - a node is recorded as a value for the node id. */ + a node is recorded as a value for the node id. + + A database also has a cache for past queries as a value for + HASHKEY_QUERY_CACHE. It is another hash table that maps + "NAME-STRING\0CLASS-STRING" to the result of the query. */ #define HASHKEY_MAX_NID (make_number (0)) +#define HASHKEY_QUERY_CACHE (make_number (-1)) static XrmDatabase xrm_create_database () @@ -868,6 +873,7 @@ make_float (DEFAULT_REHASH_THRESHOLD), Qnil, Qnil, Qnil); Fputhash (HASHKEY_MAX_NID, make_number (0), database); + Fputhash (HASHKEY_QUERY_CACHE, Qnil, database); return database; } @@ -901,6 +907,7 @@ Fputhash (node_id, value, database); Fputhash (HASHKEY_MAX_NID, make_number (max_nid), database); + Fputhash (HASHKEY_QUERY_CACHE, Qnil, database); } /* Merge multiple resource entries specified by DATA into a resource @@ -989,8 +996,30 @@ XrmDatabase database; char *name, *class; { - Lisp_Object quark_name, quark_class, tmp; - int nn, nc; + Lisp_Object key, query_cache, quark_name, quark_class, tmp; + int i, nn, nc; + struct Lisp_Hash_Table *h; + unsigned hash_code; + + nn = strlen (name); + nc = strlen (class); + key = make_uninit_string (nn + nc + 1); + strcpy (SDATA (key), name); + strncpy (SDATA (key) + nn + 1, class, nc); + + query_cache = Fgethash (HASHKEY_QUERY_CACHE, database, Qnil); + if (NILP (query_cache)) + { + query_cache = make_hash_table (Qequal, make_number (DEFAULT_HASH_SIZE), + make_float (DEFAULT_REHASH_SIZE), + make_float (DEFAULT_REHASH_THRESHOLD), + Qnil, Qnil, Qnil); + Fputhash (HASHKEY_QUERY_CACHE, query_cache, database); + } + h = XHASH_TABLE (query_cache); + i = hash_lookup (h, key, &hash_code); + if (i >= 0) + return HASH_VALUE (h, i); quark_name = parse_resource_name (&name); if (*name != '\0') @@ -1009,7 +1038,11 @@ if (nn != nc) return Qnil; else - return xrm_q_get_resource (database, quark_name, quark_class); + { + tmp = xrm_q_get_resource (database, quark_name, quark_class); + hash_put (h, key, tmp, hash_code); + return tmp; + } } #if TARGET_API_MAC_CARBON @@ -4119,7 +4152,7 @@ The conversion is performed using the converter provided by the system. Each encoding is specified by either a coding system symbol, a mime charset string, or an integer as a CFStringEncoding value. Nil for -encoding means UTF-16 in native byte order, no byte order marker. +encoding means UTF-16 in native byte order, no byte order mark. On Mac OS X 10.2 and later, you can do Unicode Normalization by specifying the optional argument NORMALIZATION-FORM with a symbol NFD, NFKD, NFC, NFKC, HFS+D, or HFS+C. @@ -4192,6 +4225,29 @@ return Qnil; } + +static Lisp_Object +mac_get_system_locale () +{ + OSErr err; + LangCode lang; + RegionCode region; + LocaleRef locale; + Str255 str; + + lang = GetScriptVariable (smSystemScript, smScriptLang); + region = GetScriptManagerVariable (smRegionCode); + err = LocaleRefFromLangOrRegionCode (lang, region, &locale); + if (err == noErr) + err = LocaleRefGetPartString (locale, kLocaleAllPartsMask, + sizeof (str), str); + if (err == noErr) + return build_string (str); + else + return Qnil; +} + + #ifdef MAC_OSX #undef select @@ -4213,7 +4269,7 @@ involved, and timeout is not too short (greater than SELECT_TIMEOUT_THRESHHOLD_RUNLOOP seconds). -> Create CFSocket for each socket and add it into the current - event RunLoop so that an `ready-to-read' event can be posted + event RunLoop so that a `ready-to-read' event can be posted to the event queue that is also used for window events. Then ReceiveNextEvent can wait for both kinds of inputs. 4. Otherwise. @@ -4481,6 +4537,11 @@ char *p, *q; struct stat st; + /* Initialize locale related variables. */ + mac_system_script_code = + (ScriptCode) GetScriptManagerVariable (smSysScript); + Vmac_system_locale = mac_get_system_locale (); + /* Fetch the pathname of the application bundle as a C string into app_bundle_pathname. */ @@ -4600,28 +4661,6 @@ #endif /* MAC_OSX */ -static Lisp_Object -mac_get_system_locale () -{ - OSErr err; - LangCode lang; - RegionCode region; - LocaleRef locale; - Str255 str; - - lang = GetScriptVariable (smSystemScript, smScriptLang); - region = GetScriptManagerVariable (smRegionCode); - err = LocaleRefFromLangOrRegionCode (lang, region, &locale); - if (err == noErr) - err = LocaleRefGetPartString (locale, kLocaleAllPartsMask, - sizeof (str), str); - if (err == noErr) - return build_string (str); - else - return Qnil; -} - - void syms_of_mac () {
--- a/src/macgui.h Mon Nov 07 15:25:27 2005 +0000 +++ b/src/macgui.h Fri Nov 18 13:13:34 2005 +0000 @@ -92,6 +92,12 @@ #endif +#ifndef USE_CG_TEXT_DRAWING +#if USE_ATSUI && MAC_OS_X_VERSION_MAX_ALLOWED >= 1030 +#define USE_CG_TEXT_DRAWING 1 +#endif +#endif + /* Emulate XCharStruct. */ typedef struct _XCharStruct { @@ -127,6 +133,10 @@ #endif #if USE_ATSUI ATSUStyle mac_style; /* NULL if QuickDraw Text is used */ +#if USE_CG_TEXT_DRAWING + CGFontRef cg_font; /* NULL if ATSUI text drawing is used */ + CGGlyph *cg_glyphs; /* Likewise */ +#endif #endif /* from Xlib.h */
--- a/src/macterm.c Mon Nov 07 15:25:27 2005 +0000 +++ b/src/macterm.c Fri Nov 18 13:13:34 2005 +0000 @@ -87,14 +87,6 @@ #include "atimer.h" #include "keymap.h" -/* Set of macros that handle mapping of Mac modifier keys to emacs. */ -#define macCtrlKey (NILP (Vmac_reverse_ctrl_meta) ? controlKey : \ - (NILP (Vmac_command_key_is_meta) ? optionKey : cmdKey)) -#define macShiftKey (shiftKey) -#define macMetaKey (NILP (Vmac_reverse_ctrl_meta) ? \ - (NILP (Vmac_command_key_is_meta) ? optionKey : cmdKey) \ - : controlKey) -#define macAltKey (NILP (Vmac_command_key_is_meta) ? cmdKey : optionKey) /* Non-nil means Emacs uses toolkit scroll bars. */ @@ -207,7 +199,8 @@ /* The keysyms to use for the various modifiers. */ -static Lisp_Object Qalt, Qhyper, Qsuper, Qmodifier_value; +static Lisp_Object Qalt, Qhyper, Qsuper, Qctrl, + Qmeta, Qmodifier_value; extern int inhibit_window_system; @@ -778,7 +771,7 @@ QDEndCGContext (port, &context); #if 0 /* This doesn't work on Mac OS X 10.1. */ - ATSUClearLayoutControls (text_layout, + ATSUClearLayoutControls (text_layout, sizeof (tags) / sizeof (tags[0]), tags); #else @@ -871,6 +864,77 @@ } +#if USE_CG_TEXT_DRAWING +static XCharStruct *x_per_char_metric P_ ((XFontStruct *, XChar2b *)); + +static int +mac_draw_string_cg (f, gc, x, y, buf, nchars) + struct frame *f; + GC gc; + int x, y; + XChar2b *buf; + int nchars; +{ + CGrafPtr port; + float port_height, gx, gy; + int i; + CGContextRef context; + CGGlyph *glyphs; + CGSize *advances; + + if (NILP (Vmac_use_core_graphics) || GC_FONT (gc)->cg_font == NULL) + return 0; + + port = GetWindowPort (FRAME_MAC_WINDOW (f)); + port_height = FRAME_PIXEL_HEIGHT (f); + gx = x; + gy = port_height - y; + glyphs = (CGGlyph *)buf; + advances = xmalloc (sizeof (CGSize) * nchars); + for (i = 0; i < nchars; i++) + { + advances[i].width = x_per_char_metric (GC_FONT (gc), buf)->width; + advances[i].height = 0; + glyphs[i] = GC_FONT (gc)->cg_glyphs[buf->byte2]; + buf++; + } + + QDBeginCGContext (port, &context); + if (gc->n_clip_rects) + { + CGContextTranslateCTM (context, 0, port_height); + CGContextScaleCTM (context, 1, -1); + CGContextClipToRects (context, gc->clip_rects, gc->n_clip_rects); + CGContextScaleCTM (context, 1, -1); + CGContextTranslateCTM (context, 0, -port_height); + } + CGContextSetRGBFillColor (context, + RED_FROM_ULONG (gc->xgcv.foreground) / 255.0, + GREEN_FROM_ULONG (gc->xgcv.foreground) / 255.0, + BLUE_FROM_ULONG (gc->xgcv.foreground) / 255.0, + 1.0); + CGContextSetFont (context, GC_FONT (gc)->cg_font); + CGContextSetFontSize (context, GC_FONT (gc)->mac_fontsize); +#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1030 + CGContextSetTextPosition (context, gx, gy); + CGContextShowGlyphsWithAdvances (context, glyphs, advances, nchars); +#else + for (i = 0; i < nchars; i++) + { + CGContextShowGlyphsAtPoint (context, gx, gy, glyphs + i, 1); + gx += advances[i].width; + } +#endif + CGContextSynchronize (context); + QDEndCGContext (port, &context); + + xfree (advances); + + return 1; +} +#endif + + /* Mac replacement for XCopyArea: dest must be window. */ static void @@ -2265,6 +2329,13 @@ || GC_FONT (s->gc)->mac_style #endif ) +#if USE_CG_TEXT_DRAWING + if (!s->two_byte_p + && mac_draw_string_cg (s->f, s->gc, x, s->ybase - boff, + s->char2b, s->nchars)) + ; + else +#endif mac_draw_string_16 (s->f, s->gc, x, s->ybase - boff, s->char2b, s->nchars); else @@ -7288,6 +7359,7 @@ Str31 charset; SInt16 fontnum; #if USE_ATSUI + static ATSUFontID font_id; ATSUStyle mac_style = NULL; #endif Style fontface; @@ -7322,7 +7394,6 @@ kATSUQDBoldfaceTag, kATSUQDItalicTag}; ByteCount sizes[] = {sizeof (ATSUFontID), sizeof (Fixed), sizeof (Boolean), sizeof (Boolean)}; - static ATSUFontID font_id; static Fixed size_fixed; static Boolean bold_p, italic_p; ATSUAttributeValuePtr values[] = {&font_id, &size_fixed, @@ -7376,6 +7447,10 @@ font->mac_scriptcode = scriptcode; #if USE_ATSUI font->mac_style = mac_style; +#if USE_CG_TEXT_DRAWING + font->cg_font = NULL; + font->cg_glyphs = NULL; +#endif #endif /* Apple Japanese (SJIS) font is listed as both @@ -7405,6 +7480,30 @@ } bzero (font->per_char, sizeof (XCharStruct) * 0x10000); +#if USE_CG_TEXT_DRAWING + { + FMFontFamily font_family; + FMFontStyle style; + ATSFontRef ats_font; + + err = FMGetFontFamilyInstanceFromFont (font_id, &font_family, &style); + if (err == noErr) + err = FMGetFontFromFontFamilyInstance (font_family, fontface, + &font_id, &style); + /* Use CG text drawing if italic/bold is not synthesized. */ + if (err == noErr && style == fontface) + { + ats_font = FMGetATSFontRefFromFont (font_id); + font->cg_font = CGFontCreateWithPlatformFont (&ats_font); + } + } + + if (font->cg_font) + font->cg_glyphs = xmalloc (sizeof (CGGlyph) * 0x100); + if (font->cg_glyphs) + bzero (font->cg_glyphs, sizeof (CGGlyph) * 0x100); +#endif + err = atsu_get_text_layout_with_text_ptr (&c, 1, font->mac_style, &text_layout); @@ -7414,8 +7513,19 @@ return NULL; } - for (c = 0x20; c <= 0x7e; c++) + for (c = 0x20; c <= 0xff; c++) { + if (c == 0xad) + /* Soft hyphen is not supported in ATSUI. */ + continue; + else if (c == 0x7f) + { + STORE_XCHARSTRUCT (font->min_bounds, min_width, min_bounds); + STORE_XCHARSTRUCT (font->max_bounds, max_width, max_bounds); + c = 0x9f; + continue; + } + err = ATSUClearLayoutCache (text_layout, kATSUFromTextBeginning); if (err == noErr) err = ATSUMeasureTextImage (text_layout, @@ -7464,9 +7574,32 @@ } } } +#if USE_CG_TEXT_DRAWING + if (err == noErr && char_width > 0 && font->cg_font) + { + ATSUGlyphInfoArray glyph_info_array; + ByteCount count = sizeof (ATSUGlyphInfoArray); + + err = ATSUMatchFontsToText (text_layout, kATSUFromTextBeginning, + kATSUToTextEnd, NULL, NULL, NULL); + if (err == noErr) + err = ATSUGetGlyphInfo (text_layout, kATSUFromTextBeginning, + kATSUToTextEnd, &count, + &glyph_info_array); + if (err == noErr) + font->cg_glyphs[c] = glyph_info_array.glyphs[0].glyphID; + else + { + /* Don't use CG text drawing if font substitution + occurs in ASCII or Latin-1 characters. */ + CGFontRelease (font->cg_font); + font->cg_font = NULL; + xfree (font->cg_glyphs); + font->cg_glyphs = NULL; + } + } +#endif } - STORE_XCHARSTRUCT (font->min_bounds, min_width, min_bounds); - STORE_XCHARSTRUCT (font->max_bounds, max_width, max_bounds); font->min_byte1 = 0; font->max_byte1 = 0xff; @@ -7579,6 +7712,13 @@ SetRect (&max_bounds, 0, 0, 0, 0); for (c = 0x20; c <= 0xff; c++) { + if (c == 0x7f) + { + STORE_XCHARSTRUCT (font->min_bounds, min_width, min_bounds); + STORE_XCHARSTRUCT (font->max_bounds, max_width, max_bounds); + continue; + } + ch = c; char_width = CharWidth (ch); QDTextBounds (1, &ch, &char_bounds); @@ -7601,8 +7741,6 @@ UnionRect (&max_bounds, &char_bounds, &max_bounds); } } - STORE_XCHARSTRUCT (font->min_bounds, min_width, min_bounds); - STORE_XCHARSTRUCT (font->max_bounds, max_width, max_bounds); if (min_width == max_width && max_bounds.left >= 0 && max_bounds.right <= max_width) { @@ -7618,6 +7756,15 @@ TextFace (old_fontface); } +#if !defined (MAC_OS8) || USE_ATSUI + /* AppKit and WebKit do some adjustment to the heights of Courier, + Helvetica, and Times. This only works on the environments where + the XDrawImageString counterpart is never used. */ + if (strcmp (family, "courier") == 0 || strcmp (family, "helvetica") == 0 + || strcmp (family, "times") == 0) + font->ascent += (font->ascent + font->descent) * .15 + 0.5; +#endif + return font; } @@ -7633,6 +7780,12 @@ #if USE_ATSUI if (font->mac_style) ATSUDisposeStyle (font->mac_style); +#if USE_CG_TEXT_DRAWING + if (font->cg_font) + CGFontRelease (font->cg_font); + if (font->cg_glyphs) + xfree (font->cg_glyphs); +#endif #endif xfree (font); } @@ -7920,14 +8073,18 @@ /* Contains the string "reverse", which is a constant for mouse button emu.*/ Lisp_Object Qreverse; -/* True if using command key as meta key. */ -Lisp_Object Vmac_command_key_is_meta; - -/* Modifier associated with the option key, or nil for normal behavior. */ + +/* Modifier associated with the control key, or nil to ignore. */ +Lisp_Object Vmac_control_modifier; + +/* Modifier associated with the option key, or nil to ignore. */ Lisp_Object Vmac_option_modifier; -/* True if the ctrl and meta keys should be reversed. */ -Lisp_Object Vmac_reverse_ctrl_meta; +/* Modifier associated with the command key, or nil to ignore. */ +Lisp_Object Vmac_command_modifier; + +/* Modifier associated with the function key, or nil to ignore. */ +Lisp_Object Vmac_function_modifier; /* True if the option and command modifiers should be used to emulate a three button mouse */ @@ -8001,19 +8158,43 @@ #endif { unsigned int result = 0; - if (mods & macShiftKey) + if (mods & shiftKey) result |= shift_modifier; - if (mods & macCtrlKey) - result |= ctrl_modifier; - if (mods & macMetaKey) - result |= meta_modifier; - if (NILP (Vmac_command_key_is_meta) && (mods & macAltKey)) - result |= alt_modifier; + + + + /* Deactivated to simplify configuration: + if Vmac_option_modifier is non-NIL, we fully process the Option + key. Otherwise, we only process it if an additional Ctrl or Command + is pressed. That way the system may convert the character to a + composed one. + if ((mods & optionKey) && + (( !NILP(Vmac_option_modifier) || + ((mods & cmdKey) || (mods & controlKey))))) */ + if (!NILP (Vmac_option_modifier) && (mods & optionKey)) { - Lisp_Object val = Fget(Vmac_option_modifier, Qmodifier_value); - if (!NILP(val)) - result |= XUINT(val); + Lisp_Object val = Fget(Vmac_option_modifier, Qmodifier_value); + if (INTEGERP(val)) + result |= XUINT(val); + } + if (!NILP (Vmac_command_modifier) && (mods & cmdKey)) { + Lisp_Object val = Fget(Vmac_command_modifier, Qmodifier_value); + if (INTEGERP(val)) + result |= XUINT(val); } + if (!NILP (Vmac_control_modifier) && (mods & controlKey)) { + Lisp_Object val = Fget(Vmac_control_modifier, Qmodifier_value); + if (INTEGERP(val)) + result |= XUINT(val); + } + +#ifdef MAC_OSX + if (!NILP (Vmac_function_modifier) && (mods & kEventKeyModifierFnMask)) { + Lisp_Object val = Fget(Vmac_function_modifier, Qmodifier_value); + if (INTEGERP(val)) + result |= XUINT(val); + } +#endif return result; } @@ -8035,7 +8216,7 @@ #if USE_CARBON_EVENTS /* Obtains the event modifiers from the event ref and then calls mac_to_emacs_modifiers. */ -static int +static UInt32 mac_event_to_emacs_modifiers (EventRef eventRef) { UInt32 mods = 0; @@ -9385,6 +9566,7 @@ /*0x7C*/ 0x53 /*right*/, 0x54 /*down*/, 0x52 /*up*/, 0 }; + static int keycode_to_xkeysym (int keyCode, int *xKeySym) { @@ -9392,6 +9574,121 @@ return *xKeySym != 0; } +static unsigned char fn_keycode_to_xkeysym_table[] = { + /*0x00*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + /*0x10*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + /*0x20*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + + /*0x30*/ 0, 0, 0, 0, + /*0x34*/ 0, 0, 0, 0, + /*0x38*/ 0, 0, 0, 0, + /*0x3C*/ 0, 0, 0, 0, + + /*0x40*/ 0, 0x2e /*kp-. = .*/, 0, 0x50 /*kp-* = 'p'*/, + /*0x44*/ 0, '/' /*kp-+*/, 0, 0, + /*0x48*/ 0, 0, 0, 0x30 /*kp-/ = '0'*/, + /*0x4C*/ 0, 0, 0x3b /*kp-- = ';'*/, 0, + + /*0x50*/ 0, 0x2d /*kp-= = '-'*/, 0x6d /*kp-0 = 'm'*/, 0x6a /*kp-1 = 'j'*/, + /*0x54*/ 0x6b /*kp-2 = 'k'*/, 0x6c /*kp-3 = 'l'*/, 'u' /*kp-4*/, 'i' /*kp-5*/, + /*0x58*/ 'o' /*kp-6*/, '7' /*kp-7*/, 0, '8' /*kp-8*/, + /*0x5C*/ '9' /*kp-9*/, 0, 0, 0, + + /*0x60*/ 0, 0, 0, 0, + /*0x64*/ 0, 0, 0, 0, + /*0x68*/ 0, 0, 0, 0, + /*0x6C*/ 0, 0, 0, 0, + + /*0x70*/ 0, 0, 0, 0, + /*0x74*/ 0, 0, 0, 0, + /*0x78*/ 0, 0, 0, 0, + /*0x7C*/ 0, 0, 0, 0 +}; +static int +convert_fn_keycode (EventRef eventRef, int keyCode, int *newCode) +{ +#ifdef MAC_OSX + /* Use the special map to translate keys when function modifier is + to be caught. KeyTranslate can't be used in that case. + We can't detect the function key using the input_event.modifiers, + because this uses the high word of an UInt32. Therefore, + we'll just read it out of the original eventRef. + */ + + + /* TODO / known issues + + - Fn-Shift-j is regonized as Fn-j and not Fn-J. + The above table always translates to lower characters. We need to use + the KCHR keyboard resource (KeyTranslate() ) to map k->K and 8->*. + + - The table is meant for English language keyboards, and it will work + for many others with the exception of key combinations like Fn-ö on + a German keyboard, which is currently mapped to Fn-;. + How to solve this without keeping separate tables for all keyboards + around? KeyTranslate isn't of much help here, as it only takes a 16-bit + value for keycode with the modifiers in he high byte, i.e. no room for the + Fn modifier. That's why we need the table. + + */ + + UInt32 mods = 0; + if (!NILP(Vmac_function_modifier)) + { + GetEventParameter (eventRef, kEventParamKeyModifiers, typeUInt32, NULL, + sizeof (UInt32), NULL, &mods); + if (mods & kEventKeyModifierFnMask) + { *newCode = fn_keycode_to_xkeysym_table [keyCode & 0x7f]; + + return (*newCode != 0); + } + } +#endif + return false; +} + +static int +backtranslate_modified_keycode(int mods, int keycode, int def) +{ + if (mods & + (controlKey | + (NILP (Vmac_option_modifier) ? 0 : optionKey) | + cmdKey)) + { + /* This code comes from Keyboard Resource, + Appendix C of IM - Text. This is necessary + since shift is ignored in KCHR table + translation when option or command is pressed. + It also does not translate correctly + control-shift chars like C-% so mask off shift + here also. + + Not done for combinations with the option key (alt) + unless it is to be caught by Emacs: this is + to preserve key combinations translated by the OS + such as Alt-3. + */ + /* mask off option and command */ + int new_modifiers = mods & 0xe600; + /* set high byte of keycode to modifier high byte*/ + int new_keycode = keycode | new_modifiers; + Ptr kchr_ptr = (Ptr) GetScriptManagerVariable (smKCHRCache); + unsigned long some_state = 0; + return (int) KeyTranslate (kchr_ptr, new_keycode, + &some_state) & 0xff; + /* TO DO: Recognize two separate resulting characters, "for + example, when the user presses Option-E followed by N, you + can map this through the KeyTranslate function using the + U.S. 'KCHR' resource to produce ´n, which KeyTranslate + returns as two characters in the bytes labeled Character code + 1 and Character code 2." (from Carbon API doc) */ + + } + else + return def; +} + + #if !USE_CARBON_EVENTS static RgnHandle mouse_region = NULL; @@ -9936,8 +10233,7 @@ || !(er.modifiers & cmdKey)) && (!NILP (Vmac_pass_control_to_system) || !(er.modifiers & controlKey)) - && (!NILP (Vmac_command_key_is_meta) - && NILP (Vmac_option_modifier) + && (NILP (Vmac_option_modifier) || !(er.modifiers & optionKey))) if (SendEventToEventTarget (eventRef, toolbox_dispatcher) != eventNotHandledErr) @@ -9981,49 +10277,36 @@ dpyinfo->mouse_face_hidden = 1; } - if (keycode_to_xkeysym (keycode, &xkeysym)) + /* translate the keycode back to determine the original key */ + /* Convert key code if function key is pressed. + Otherwise, if non-ASCII-event, take care of that + without re-translating the key code. */ +#if USE_CARBON_EVENTS + if (convert_fn_keycode (eventRef, keycode, &xkeysym)) { - inev.code = 0xff00 | xkeysym; - inev.kind = NON_ASCII_KEYSTROKE_EVENT; + inev.code = xkeysym; + /* this doesn't work - tried to add shift modifiers */ + inev.code = + backtranslate_modified_keycode(er.modifiers & (~0x2200), + xkeysym | 0x80, xkeysym); + inev.kind = ASCII_KEYSTROKE_EVENT; } else - { - if (er.modifiers & (controlKey | - (NILP (Vmac_command_key_is_meta) ? optionKey - : cmdKey))) - { - /* This code comes from Keyboard Resource, - Appendix C of IM - Text. This is necessary - since shift is ignored in KCHR table - translation when option or command is pressed. - It also does not translate correctly - control-shift chars like C-% so mask off shift - here also */ - int new_modifiers = er.modifiers & 0xe600; - /* mask off option and command */ - int new_keycode = keycode | new_modifiers; - Ptr kchr_ptr = (Ptr) GetScriptManagerVariable (smKCHRCache); - unsigned long some_state = 0; - inev.code = KeyTranslate (kchr_ptr, new_keycode, - &some_state) & 0xff; - } - else if (!NILP (Vmac_option_modifier) - && (er.modifiers & optionKey)) - { - /* When using the option key as an emacs modifier, - convert the pressed key code back to one - without the Mac option modifier applied. */ - int new_modifiers = er.modifiers & ~optionKey; - int new_keycode = keycode | new_modifiers; - Ptr kchr_ptr = (Ptr) GetScriptManagerVariable (smKCHRCache); - unsigned long some_state = 0; - inev.code = KeyTranslate (kchr_ptr, new_keycode, - &some_state) & 0xff; - } - else - inev.code = er.message & charCodeMask; - inev.kind = ASCII_KEYSTROKE_EVENT; - } +#endif + if (keycode_to_xkeysym (keycode, &xkeysym)) + { + inev.code = 0xff00 | xkeysym; + inev.kind = NON_ASCII_KEYSTROKE_EVENT; + } + else + { + + inev.code = + backtranslate_modified_keycode(er.modifiers, keycode, + er.message & charCodeMask); + inev.kind = ASCII_KEYSTROKE_EVENT; + + } } #if USE_CARBON_EVENTS @@ -10463,10 +10746,9 @@ /* Map modifiers */ mac_quit_char_modifiers = 0; - if (qc_modifiers & ctrl_modifier) mac_quit_char_modifiers |= macCtrlKey; - if (qc_modifiers & shift_modifier) mac_quit_char_modifiers |= macShiftKey; - if (qc_modifiers & meta_modifier) mac_quit_char_modifiers |= macMetaKey; - if (qc_modifiers & alt_modifier) mac_quit_char_modifiers |= macAltKey; + if (qc_modifiers & ctrl_modifier) mac_quit_char_modifiers |= controlKey; + if (qc_modifiers & shift_modifier) mac_quit_char_modifiers |= shiftKey; + if (qc_modifiers & alt_modifier) mac_quit_char_modifiers |= optionKey; } static void @@ -10624,6 +10906,10 @@ #endif Qmodifier_value = intern ("modifier-value"); + Qctrl = intern ("ctrl"); + Fput (Qctrl, Qmodifier_value, make_number (ctrl_modifier)); + Qmeta = intern ("meta"); + Fput (Qmeta, Qmodifier_value, make_number (meta_modifier)); Qalt = intern ("alt"); Fput (Qalt, Qmodifier_value, make_number (alt_modifier)); Qhyper = intern ("hyper"); @@ -10676,21 +10962,36 @@ staticpro (&last_mouse_motion_frame); last_mouse_motion_frame = Qnil; - DEFVAR_LISP ("mac-command-key-is-meta", &Vmac_command_key_is_meta, - doc: /* Non-nil means that the command key is used as the Emacs meta key. -Otherwise the option key is used. */); - Vmac_command_key_is_meta = Qt; + + +/* Variables to configure modifier key assignment. */ + + DEFVAR_LISP ("mac-control-modifier", &Vmac_control_modifier, + doc: /* Modifier key assumed when the Mac control key is pressed. +The value can be `alt', `ctrl', `hyper', or `super' for the respective +modifier. The default is `ctrl'. */); + Vmac_control_modifier = Qctrl; DEFVAR_LISP ("mac-option-modifier", &Vmac_option_modifier, - doc: /* Modifier to use for the Mac alt/option key. The value can -be alt, hyper, or super for the respective modifier. If the value is -nil then the key will act as the normal Mac option modifier. */); + doc: /* Modifier key assumed when the Mac alt/option key is pressed. +The value can be `alt', `ctrl', `hyper', or `super' for the respective +modifier. If the value is nil then the key will act as the normal +Mac control modifier, and the option key can be used to compose +characters depending on the chosen Mac keyboard setting. */); Vmac_option_modifier = Qnil; - DEFVAR_LISP ("mac-reverse-ctrl-meta", &Vmac_reverse_ctrl_meta, - doc: /* Non-nil means that the control and meta keys are reversed. This is -useful for non-standard keyboard layouts. */); - Vmac_reverse_ctrl_meta = Qnil; + DEFVAR_LISP ("mac-command-modifier", &Vmac_command_modifier, + doc: /* Modifier key assumed when the Mac command key is pressed. +The value can be `alt', `ctrl', `hyper', or `super' for the respective +modifier. The default is `meta'. */); + Vmac_command_modifier = Qmeta; + + DEFVAR_LISP ("mac-function-modifier", &Vmac_function_modifier, + doc: /* Modifier key assumed when the Mac function key is pressed. +The value can be `alt', `ctrl', `hyper', or `super' for the respective +modifier. Note that remapping the function key may lead to unexpected +results for some keys on non-US/GB keyboards. */); + Vmac_function_modifier = Qnil; DEFVAR_LISP ("mac-emulate-three-button-mouse", &Vmac_emulate_three_button_mouse,
--- a/src/print.c Mon Nov 07 15:25:27 2005 +0000 +++ b/src/print.c Fri Nov 18 13:13:34 2005 +0000 @@ -970,6 +970,26 @@ Fprin1 (arg, Qexternal_debugging_output); fprintf (stderr, "\r\n"); } + +void +safe_debug_print (arg) + Lisp_Object arg; +{ + int valid = valid_lisp_object_p (arg); + + if (valid > 0) + debug_print (arg); + else + fprintf (stderr, "#<%s_LISP_OBJECT 0x%08lx>\r\n", + !valid ? "INVALID" : "SOME", +#ifdef NO_UNION_TYPE + (unsigned long) arg +#else + (unsigned long) arg.i +#endif + ); +} + DEFUN ("error-message-string", Ferror_message_string, Serror_message_string, 1, 1, 0,
--- a/src/process.c Mon Nov 07 15:25:27 2005 +0000 +++ b/src/process.c Fri Nov 18 13:13:34 2005 +0000 @@ -5944,97 +5944,100 @@ CHECK_SYMBOL (sigcode); name = SDATA (SYMBOL_NAME (sigcode)); + if (!strncmp(name, "SIG", 3)) + name += 3; + if (0) ; #ifdef SIGHUP - handle_signal ("SIGHUP", SIGHUP); + handle_signal ("HUP", SIGHUP); #endif #ifdef SIGINT - handle_signal ("SIGINT", SIGINT); + handle_signal ("INT", SIGINT); #endif #ifdef SIGQUIT - handle_signal ("SIGQUIT", SIGQUIT); + handle_signal ("QUIT", SIGQUIT); #endif #ifdef SIGILL - handle_signal ("SIGILL", SIGILL); + handle_signal ("ILL", SIGILL); #endif #ifdef SIGABRT - handle_signal ("SIGABRT", SIGABRT); + handle_signal ("ABRT", SIGABRT); #endif #ifdef SIGEMT - handle_signal ("SIGEMT", SIGEMT); + handle_signal ("EMT", SIGEMT); #endif #ifdef SIGKILL - handle_signal ("SIGKILL", SIGKILL); + handle_signal ("KILL", SIGKILL); #endif #ifdef SIGFPE - handle_signal ("SIGFPE", SIGFPE); + handle_signal ("FPE", SIGFPE); #endif #ifdef SIGBUS - handle_signal ("SIGBUS", SIGBUS); + handle_signal ("BUS", SIGBUS); #endif #ifdef SIGSEGV - handle_signal ("SIGSEGV", SIGSEGV); + handle_signal ("SEGV", SIGSEGV); #endif #ifdef SIGSYS - handle_signal ("SIGSYS", SIGSYS); + handle_signal ("SYS", SIGSYS); #endif #ifdef SIGPIPE - handle_signal ("SIGPIPE", SIGPIPE); + handle_signal ("PIPE", SIGPIPE); #endif #ifdef SIGALRM - handle_signal ("SIGALRM", SIGALRM); + handle_signal ("ALRM", SIGALRM); #endif #ifdef SIGTERM - handle_signal ("SIGTERM", SIGTERM); + handle_signal ("TERM", SIGTERM); #endif #ifdef SIGURG - handle_signal ("SIGURG", SIGURG); + handle_signal ("URG", SIGURG); #endif #ifdef SIGSTOP - handle_signal ("SIGSTOP", SIGSTOP); + handle_signal ("STOP", SIGSTOP); #endif #ifdef SIGTSTP - handle_signal ("SIGTSTP", SIGTSTP); + handle_signal ("TSTP", SIGTSTP); #endif #ifdef SIGCONT - handle_signal ("SIGCONT", SIGCONT); + handle_signal ("CONT", SIGCONT); #endif #ifdef SIGCHLD - handle_signal ("SIGCHLD", SIGCHLD); + handle_signal ("CHLD", SIGCHLD); #endif #ifdef SIGTTIN - handle_signal ("SIGTTIN", SIGTTIN); + handle_signal ("TTIN", SIGTTIN); #endif #ifdef SIGTTOU - handle_signal ("SIGTTOU", SIGTTOU); + handle_signal ("TTOU", SIGTTOU); #endif #ifdef SIGIO - handle_signal ("SIGIO", SIGIO); + handle_signal ("IO", SIGIO); #endif #ifdef SIGXCPU - handle_signal ("SIGXCPU", SIGXCPU); + handle_signal ("XCPU", SIGXCPU); #endif #ifdef SIGXFSZ - handle_signal ("SIGXFSZ", SIGXFSZ); + handle_signal ("XFSZ", SIGXFSZ); #endif #ifdef SIGVTALRM - handle_signal ("SIGVTALRM", SIGVTALRM); + handle_signal ("VTALRM", SIGVTALRM); #endif #ifdef SIGPROF - handle_signal ("SIGPROF", SIGPROF); + handle_signal ("PROF", SIGPROF); #endif #ifdef SIGWINCH - handle_signal ("SIGWINCH", SIGWINCH); + handle_signal ("WINCH", SIGWINCH); #endif #ifdef SIGINFO - handle_signal ("SIGINFO", SIGINFO); + handle_signal ("INFO", SIGINFO); #endif #ifdef SIGUSR1 - handle_signal ("SIGUSR1", SIGUSR1); + handle_signal ("USR1", SIGUSR1); #endif #ifdef SIGUSR2 - handle_signal ("SIGUSR2", SIGUSR2); + handle_signal ("USR2", SIGUSR2); #endif else error ("Undefined signal name %s", name);
--- a/src/s/darwin.h Mon Nov 07 15:25:27 2005 +0000 +++ b/src/s/darwin.h Fri Nov 18 13:13:34 2005 +0000 @@ -263,13 +263,13 @@ /* Indicate that we are compiling for Mac OS X and where to find Mac specific headers. */ -#define C_SWITCH_SYSTEM -fpascal-strings -fno-common -DMAC_OSX -I../mac/src +#define C_SWITCH_SYSTEM -fpascal-strings -DMAC_OSX -I../mac/src /* Link in the Carbon lib. */ #ifdef HAVE_CARBON #define LIBS_CARBON -framework Carbon -framework QuickTime #else -#define LIBS_CARBON -framework Carbon +#define LIBS_CARBON #endif /* The -headerpad option tells ld (see man page) to leave room at the @@ -328,6 +328,10 @@ does not exist. */ #undef HAVE_WORKING_VFORK #define vfork fork + +/* Don't close pty in process.c to make it as controlling terminal. + It is already a controlling terminal of subprocess, because we did + ioctl TIOCSCTTY. */ #define DONT_REOPEN_PTY #ifdef temacs
--- a/src/search.c Mon Nov 07 15:25:27 2005 +0000 +++ b/src/search.c Fri Nov 18 13:13:34 2005 +0000 @@ -1174,7 +1174,7 @@ int raw_pattern_size_byte; unsigned char *patbuf; int multibyte = !NILP (current_buffer->enable_multibyte_characters); - unsigned char *base_pat = SDATA (string); + unsigned char *base_pat; /* Set to positive if we find a non-ASCII char that need translation. Otherwise set to zero later. */ int charset_base = -1;
--- a/src/unexmacosx.c Mon Nov 07 15:25:27 2005 +0000 +++ b/src/unexmacosx.c Fri Nov 18 13:13:34 2005 +0000 @@ -174,7 +174,7 @@ struct segment_command *data_segment_scp; -/* Read n bytes from infd into memory starting at address dest. +/* Read N bytes from infd into memory starting at address DEST. Return true if successful, false otherwise. */ static int unexec_read (void *dest, size_t n) @@ -182,8 +182,9 @@ return n == read (infd, dest, n); } -/* Write n bytes from memory starting at address src to outfd starting - at offset dest. Return true if successful, false otherwise. */ +/* Write COUNT bytes from memory starting at address SRC to outfd + starting at offset DEST. Return true if successful, false + otherwise. */ static int unexec_write (off_t dest, const void *src, size_t count) { @@ -193,8 +194,32 @@ return write (outfd, src, count) == count; } -/* Copy n bytes from starting offset src in infd to starting offset - dest in outfd. Return true if successful, false otherwise. */ +/* Write COUNT bytes of zeros to outfd starting at offset DEST. + Return true if successful, false otherwise. */ +static int +unexec_write_zero (off_t dest, size_t count) +{ + char buf[UNEXEC_COPY_BUFSZ]; + ssize_t bytes; + + bzero (buf, UNEXEC_COPY_BUFSZ); + if (lseek (outfd, dest, SEEK_SET) != dest) + return 0; + + while (count > 0) + { + bytes = count > UNEXEC_COPY_BUFSZ ? UNEXEC_COPY_BUFSZ : count; + if (write (outfd, buf, bytes) != bytes) + return 0; + count -= bytes; + } + + return 1; +} + +/* Copy COUNT bytes from starting offset SRC in infd to starting + offset DEST in outfd. Return true if successful, false + otherwise. */ static int unexec_copy (off_t dest, off_t src, ssize_t count) { @@ -684,14 +709,39 @@ if (!unexec_write (header_offset, sectp, sizeof (struct section))) unexec_error ("cannot write section %s's header", SECT_DATA); } - else if (strncmp (sectp->sectname, SECT_BSS, 16) == 0 - || strncmp (sectp->sectname, SECT_COMMON, 16) == 0) + else if (strncmp (sectp->sectname, SECT_COMMON, 16) == 0) { sectp->flags = S_REGULAR; if (!unexec_write (sectp->offset, (void *) sectp->addr, sectp->size)) - unexec_error ("cannot write section %s", SECT_DATA); + unexec_error ("cannot write section %s", sectp->sectname); if (!unexec_write (header_offset, sectp, sizeof (struct section))) - unexec_error ("cannot write section %s's header", SECT_DATA); + unexec_error ("cannot write section %s's header", sectp->sectname); + } + else if (strncmp (sectp->sectname, SECT_BSS, 16) == 0) + { + extern char *my_endbss_static; + unsigned long my_size; + + sectp->flags = S_REGULAR; + + /* Clear uninitialized local variables in statically linked + libraries. In particular, function pointers stored by + libSystemStub.a, which is introduced in Mac OS X 10.4 for + binary compatibility with respect to long double, are + cleared so that they will be reinitialized when the + dumped binary is executed on other versions of OS. */ + my_size = (unsigned long)my_endbss_static - sectp->addr; + if (!(sectp->addr <= (unsigned long)my_endbss_static + && my_size <= sectp->size)) + unexec_error ("my_endbss_static is not in section %s", + sectp->sectname); + if (!unexec_write (sectp->offset, (void *) sectp->addr, my_size)) + unexec_error ("cannot write section %s", sectp->sectname); + if (!unexec_write_zero (sectp->offset + my_size, + sectp->size - my_size)) + unexec_error ("cannot write section %s", sectp->sectname); + if (!unexec_write (header_offset, sectp, sizeof (struct section))) + unexec_error ("cannot write section %s's header", sectp->sectname); } else if (strncmp (sectp->sectname, "__la_symbol_ptr", 16) == 0 || strncmp (sectp->sectname, "__nl_symbol_ptr", 16) == 0
--- a/src/xdisp.c Mon Nov 07 15:25:27 2005 +0000 +++ b/src/xdisp.c Fri Nov 18 13:13:34 2005 +0000 @@ -2965,11 +2965,13 @@ struct it *it; { enum prop_handled handled; - int handle_overlay_change_p = 1; + int handle_overlay_change_p; struct props *p; it->dpvec = NULL; it->current.dpvec_index = -1; + handle_overlay_change_p = !it->ignore_overlay_strings_at_pos_p; + it->ignore_overlay_strings_at_pos_p = 0; /* Use face of preceding text for ellipsis (if invisible) */ if (it->selective_display_ellipsis_p) @@ -5673,6 +5675,9 @@ reseat_at_next_visible_line_start (it, 1); else if (it->dpvec_char_len > 0) { + if (it->method == GET_FROM_STRING + && it->n_overlay_strings > 0) + it->ignore_overlay_strings_at_pos_p = 1; it->len = it->dpvec_char_len; set_iterator_to_next (it, reseat_p); } @@ -20809,7 +20814,7 @@ /* Use cursor-in-non-selected-windows for non-selected window or frame. */ if (non_selected) { - alt_cursor = XBUFFER (w->buffer)->cursor_in_non_selected_windows; + alt_cursor = b->cursor_in_non_selected_windows; return get_specified_cursor_type (alt_cursor, width); }
--- a/src/xfns.c Mon Nov 07 15:25:27 2005 +0000 +++ b/src/xfns.c Fri Nov 18 13:13:34 2005 +0000 @@ -829,6 +829,27 @@ UNGCPRO; return result; } + +int +xg_set_icon_from_xpm_data (f, data) + FRAME_PTR f; + char **data; +{ + int result = 0; + GError *err = NULL; + GdkPixbuf *pixbuf = gdk_pixbuf_new_from_xpm_data (data); + + if (!pixbuf) + { + g_error_free (err); + return 0; + } + + gtk_window_set_icon (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), + pixbuf); + g_object_unref (pixbuf); + return 1; +} #endif /* USE_GTK */
--- a/src/xterm.c Mon Nov 07 15:25:27 2005 +0000 +++ b/src/xterm.c Fri Nov 18 13:13:34 2005 +0000 @@ -7376,10 +7376,30 @@ /* Create the GNU bitmap and mask if necessary. */ if (FRAME_X_DISPLAY_INFO (f)->icon_bitmap_id < 0) { - FRAME_X_DISPLAY_INFO (f)->icon_bitmap_id - = x_create_bitmap_from_data (f, gnu_bits, - gnu_width, gnu_height); - x_create_bitmap_mask (f, FRAME_X_DISPLAY_INFO (f)->icon_bitmap_id); + int rc = -1; + +#if defined (HAVE_XPM) && defined (HAVE_X_WINDOWS) +#ifdef USE_GTK + if (xg_set_icon_from_xpm_data (f, gnu_xpm_bits)) + return 0; +#else + rc = x_create_bitmap_from_xpm_data (f, gnu_xpm_bits); + if (rc != -1) + FRAME_X_DISPLAY_INFO (f)->icon_bitmap_id = rc; +#endif /* USE_GTK */ +#endif /* defined (HAVE_XPM) && defined (HAVE_X_WINDOWS) */ + + /* If all else fails, use the (black and white) xbm image. */ + if (rc == -1) + { + rc = x_create_bitmap_from_data (f, gnu_xbm_bits, + gnu_xbm_width, gnu_xbm_height); + if (rc == -1) + return 1; + + FRAME_X_DISPLAY_INFO (f)->icon_bitmap_id = rc; + x_create_bitmap_mask (f, FRAME_X_DISPLAY_INFO (f)->icon_bitmap_id); + } } /* The first time we create the GNU bitmap and mask,