diff --git a/admin/ChangeLog b/admin/ChangeLog index 0f4438aa24c..ff753ae0b6f 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,8 @@ +2005-11-11 Kim F. Storm + + * FOR-RELEASE (FATAL ERRORS): Fix infinite loop in redisplay + when displaying a non-breaking space in an overlay string. + 2005-10-30 Chong Yidong * FOR-RELEASE: Init file change implemented. diff --git a/admin/FOR-RELEASE b/admin/FOR-RELEASE index 93f0064b152..81a65e67730 100644 --- a/admin/FOR-RELEASE +++ b/admin/FOR-RELEASE @@ -35,6 +35,8 @@ bitmap usage to a bitmap name, and second level maps bitmap name to a bitmap appearence. [Assigned to KFS] +** Install Zhilin's icons. + * FATAL ERRORS ** Investigate reported crashes in compact_small_strings. @@ -44,8 +46,11 @@ invalid pointer from string_free_list. * 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 @@ Seems to be a problem in sys_select in w32proc.c. * 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/help.texi "Luc Teirlinck" Chong Yidong 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 diff --git a/etc/ChangeLog b/etc/ChangeLog index 16d62c46abd..baebe91ebf2 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,18 @@ +2005-11-16 Nick Roberts + + * 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 + + * images/gud/pp.xpm, images/gud/pp.pbm: New icons. + 2005-11-06 Jan Dj,Ad(Brv * images/copy.xpm, images/copy.pbm, images/low-color/copy.xpm diff --git a/etc/NEWS b/etc/NEWS index ef4b8529e9e..9df53f25ae0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -260,6 +260,9 @@ Since the default input is the current directory, this has the effect 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 @@ is already active in Transient Mark mode. 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 @@ The info-search bindings on C-h C-f, C-h C-k and C-h C-i 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, - - C-h w and C-h f new-kill-line reports: new-kill-line is on C-k @@ -672,6 +672,10 @@ modes do. ** 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 @@ -3501,7 +3505,7 @@ dangerous; otherwise it returns a reason why the form might be unsafe 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. @@ -4480,6 +4484,11 @@ and scroll-bar settings. +++ *** 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 diff --git a/etc/TODO b/etc/TODO index da5b0cc1e14..3e3e26bc32a 100644 --- a/etc/TODO +++ b/etc/TODO @@ -40,6 +40,8 @@ to the FSF. 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/.] diff --git a/etc/images/gud/break.pbm b/etc/images/gud/break.pbm index ff28ff8649f..e1ffbddc1b6 100644 Binary files a/etc/images/gud/break.pbm and b/etc/images/gud/break.pbm differ diff --git a/etc/images/gud/break.xpm b/etc/images/gud/break.xpm index 2ffc2748271..341a5d743ad 100644 --- a/etc/images/gud/break.xpm +++ b/etc/images/gud/break.xpm @@ -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.... ", -" .................. ", " ................ ", +" ................ ", +" ................ ", +" .............. ", " .............. ", " ............ ", " .......... ", +" ........ ", +" .... ", +" ", +" ", " ", " "}; diff --git a/etc/images/gud/go.pbm b/etc/images/gud/go.pbm new file mode 100644 index 00000000000..516bec1f785 Binary files /dev/null and b/etc/images/gud/go.pbm differ diff --git a/etc/images/gud/go.xpm b/etc/images/gud/go.xpm new file mode 100644 index 00000000000..7e0bbd06cf2 --- /dev/null +++ b/etc/images/gud/go.xpm @@ -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....... ", +" .................. ", +" ................ ", +" .............. ", +" ............ ", +" .......... ", +" ", +" "}; diff --git a/etc/images/gud/pp.pbm b/etc/images/gud/pp.pbm new file mode 100644 index 00000000000..45810295296 Binary files /dev/null and b/etc/images/gud/pp.pbm differ diff --git a/etc/images/gud/pp.xpm b/etc/images/gud/pp.xpm new file mode 100644 index 00000000000..03c00d95df0 --- /dev/null +++ b/etc/images/gud/pp.xpm @@ -0,0 +1,29 @@ +/* XPM */ +static char * pp_xpm[] = { +"24 24 2 1", +" c None", +". c #000000000000", +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" ... ... ... ... ", +" ... ... ... ... ", +" .. .. .. .. ", +" .. .. .. .. ", +" .. .. .. .. ", +" .. .. .. .. ", +" .. .. .. .. ", +" ... .. ... .. ", +" .. .. .. .. ", +" .. .. ", +" .. .. ", +" .. .. ", +" .... .... ", +" ", +" ", +" "}; diff --git a/etc/images/gud/pstar.xpm b/etc/images/gud/pstar.xpm index 6edc603db14..4f9ed1b64e8 100644 --- a/etc/images/gud/pstar.xpm +++ b/etc/images/gud/pstar.xpm @@ -1,5 +1,5 @@ /* XPM */ -static char * gud_pstar_xpm[] = { +static char * pstar_xpm[] = { "24 24 2 1", " c #BDBDBEBEBDBD", ". c #000000000000", diff --git a/etc/images/gud/remove.pbm b/etc/images/gud/remove.pbm index 516bec1f785..9940b338ead 100644 Binary files a/etc/images/gud/remove.pbm and b/etc/images/gud/remove.pbm differ diff --git a/etc/images/gud/remove.xpm b/etc/images/gud/remove.xpm index 5f38bd416ed..0c301f5e364 100644 --- a/etc/images/gud/remove.xpm +++ b/etc/images/gud/remove.xpm @@ -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. ", " .......... ", +" ........ ", +" .... ", +" ", +" ", " ", " "}; diff --git a/etc/images/gud/stop.pbm b/etc/images/gud/stop.pbm new file mode 100644 index 00000000000..ff28ff8649f Binary files /dev/null and b/etc/images/gud/stop.pbm differ diff --git a/etc/images/gud/stop.xpm b/etc/images/gud/stop.xpm new file mode 100644 index 00000000000..decfb9050b9 --- /dev/null +++ b/etc/images/gud/stop.xpm @@ -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.... ", +" .................. ", +" ................ ", +" .............. ", +" ............ ", +" .......... ", +" ", +" "}; diff --git a/etc/images/gud/until.xpm b/etc/images/gud/until.xpm index aae32e177a7..abd6c8cae99 100644 --- a/etc/images/gud/until.xpm +++ b/etc/images/gud/until.xpm @@ -1,5 +1,5 @@ /* XPM */ -static char * goto_xpm[] = { +static char * until_xpm[] = { "24 24 6 1", " c None", ". c #cc0033", diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 8a8a62a31c2..0536cef1422 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,495 @@ +2005-11-16 Luc Teirlinck + + * 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 + + * 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 + + * 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 (tiny change) + + * wid-edit.el (color): Enclose %t in %{...%}. + + * cus-edit.el (face): Enclose %t in %{...%}. + +2005-11-16 Hrvoje Niksic + + * savehist.el (savehist-mode-hook): Re-add the var. + (savehist-mode): Use it. + +2005-11-16 Stefan Monnier + + * 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 + + * textmodes/reftex.el (reftex-use-fonts): Remove the check for + window-system, to allow fonts on tty. + +2005-11-17 Nick Roberts + + * 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 + + * 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 + + * progmodes/gud.el (gud-stop-subjob): New function. + (gud-menu-map, gud-tool-bar-map): Use it. + +2005-11-16 Kim F. Storm + + * 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 + + * progmodes/gud.el (gud-menu-map): Make visibility of stop and + go buttons complementary. + +2005-11-15 Stefan Monnier + + * 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 + + * 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 + + * term.el (term-termcap-format): Fix typos. + (term-down): Fix the negative argument case. + +2005-11-16 Nick Roberts + + * 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 + + * progmodes/gud.el (gud-tool-bar-item-visible-no-fringe): New function. + (gud-menu-map): Use it. + +2005-11-14 Luc Teirlinck + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * textmodes/flyspell.el (flyspell-large-region): + Call flyspell-accept-buffer-local-defs. + +2005-11-13 Agustin Martin + + * 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 + + * help.el (help-for-help-internal): Improve doc of C-h a. + (describe-key): Improve prompt; doc fix. + +2005-11-13 Stefan Monnier + + * vc-svn.el (vc-svn-registered): Catch all errors. + + * cus-dep.el (custom-make-dependencies): Typo. + +2005-11-13 Michael Albinus + + * net/tramp-util.el (top): Fix compilation warning. + +2005-11-13 Kim F. Storm + + * help.el (help-for-help-internal): Fix `a' entry. Add `d' entry. + +2005-11-13 Nick Roberts + + * 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 + + * 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 + + * 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 + + * bookmark.el (bookmark-write-file): Don't visit the destination + file, just write the data to it using write-region. This is + similar to saveplace.el at 2005-05-29T08:36:26Z!rms@gnu.org, but with an additional + change to avoid visiting the file in the first place. + +2005-11-12 Chong Yidong + + * hi-lock.el (hi-lock-mode): Set the default value of + font-lock-defaults. + +2005-11-11 Luc Teirlinck + + * 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 + + * 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 + + * 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 + + * apropos.el (apropos-calc-scores): Use `apropos-pattern'. + +2005-11-11 Nick Roberts + + * progmodes/gud.el (gud-menu-map): Move parentheses. + (gdb): New command gud-pv. + +2005-11-10 Stefan Monnier + + * 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 + + * add-log.el (add-log-current-defun): Handle class::method + notation of c++. Fix incorrect comment. + +2005-11-10 Alan Mackenzie + + * help-fns.el (describe-variable): Make C-h v work when a variable + has variable documentation yet is unbound. + +2005-11-10 Masatake YAMATO + + * man.el (Man-highlight-references): Set an empty + string to `Man-arguments' if it is nil. + Suggested by Reiner Steib . + +2005-11-09 Stefan Monnier + + * 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 + + * 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 + + * find-lisp.el: Require dired. + (find-lisp-find-dired-internal): Do not call + `abbreviate-file-name' on DIR. + +2005-11-10 Nick Roberts + + * progmodes/gud.el (gdb): Make gud-pp use user-defined command pp1. + +2005-11-09 Nick Roberts + + * 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 + + * replace.el (occur-excluded-properties): New defcustom. + (occur-1, occur-engine, occur-accumulate-lines): Use it. + +2005-11-08 Jay Belanger + + * calc/calc-units.el (math-convert-units): Replace any composite + unit by its definition. + +2005-11-08 Lars Hansen + + * emacs-lisp/autoload.el (update-directory-autoloads): + Add obsolete function alias. + +2005-11-07 Stefan Monnier + + * 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 + + * textmodes/org.el (org-export-as-html): Remove bogus (debug) form. + 2005-11-06 Richard M. Stallman * progmodes/compile.el (compilation-internal-error-properties): @@ -15,14 +507,14 @@ 2005-11-07 Masatake YAMATO - * 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 @@ -251,7 +743,7 @@ * mail/rmailout.el (rmail-output-to-rmail-file, rmail-output): Doc fix. -2005-11-04 Ken Manheimer +2005-11-04 Ken Manheimer * pgg-pgp.el (pgg-pgp-encrypt-region, pgg-pgp-decrypt-region) (pgg-pgp-encrypt-symmetric-region, pgg-pgp-encrypt-symmetric) diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 226110e35c7..081a7f13b4b 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -98,11 +98,11 @@ $(lisp)/loaddefs.el: 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 @@ mh-autoloads: $(lisp)/mh-e/mh-loaddefs.el $(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 " >> $@ - echo ";;; Keywords: mail" >> $@ + echo ";; Copyright (C) 2003, 2004, 2005 Free Software Foundation, Inc." >> $@ + echo ";; Author: Bill Wohler " >> $@ + echo ";; Keywords: mail" >> $@ echo ";;; Commentary:" >> $@ - echo ";;; Change Log:" >> $@ echo ";;; Code:" >> $@ $(EMACS) $(EMACSOPT) \ -l autoload \ @@ -245,11 +244,11 @@ $(lisp)/mh-e/mh-loaddefs.el: $(MH-E-SRC) -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. diff --git a/lisp/add-log.el b/lisp/add-log.el index 024262a6bee..91d7ba36bab 100644 --- a/lisp/add-log.el +++ b/lisp/add-log.el @@ -860,7 +860,7 @@ Has a preference of looking backwards." (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 @@ Has a preference of looking backwards." ;; 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 ") diff --git a/lisp/apropos.el b/lisp/apropos.el index 990ad68e5ec..5eda7567ef0 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -100,15 +100,27 @@ turns off mouse highlighting." (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 @@ The computed score is shown for each match." (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 @@ The computed score is shown for each match." 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 @@ before finding a label." "\\)") ""))) -(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 @@ If REGEXP is already a regexp, don't modify it." (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 @@ Value is a list of offsets of the words into the string." "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 @@ Value is a list of offsets of the words into the string." "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 @@ This requires that at least 2 keywords (unless only one was given)." \\{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 @@ normal variables." ;;;###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 @@ satisfy the predicate VAR-PREDICATE." (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 @@ satisfy the predicate VAR-PREDICATE." ;;;###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 @@ time-consuming. Returns list of symbols and documentation found." ;;;###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 @@ Returns list of symbols and values found." (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 @@ Returns list of symbols and values found." ;;;###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 @@ Returns list of symbols and documentation found." (+ (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 @@ Returns list of symbols and documentation found." (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 @@ Returns list of symbols and documentation found." ;; 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 @@ Returns list of symbols and documentation found." (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 @@ Returns list of symbols and documentation found." (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 @@ Returns list of symbols and documentation found." 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 @@ Will return nil instead." 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 @@ alphabetically by symbol name; but this function also sets 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 @@ If non-nil TEXT is a string that will be printed as a heading." (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 non-nil TEXT is a string that will be printed as a heading." (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) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 86fa6e489f0..31616469454 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -716,6 +716,14 @@ This expects to be called from `point-min' in a bookmark file." ;;; 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: @@ -1350,14 +1358,12 @@ for a file, defaulting to the file defined by variable (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 @@ for a file, defaulting to the file defined by variable (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 @@ method buffers use to resolve name collisions." (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 @@ method buffers use to resolve name collisions." (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))) diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el index 11d550bb5d2..a57f7ede375 100644 --- a/lisp/calc/calc-alg.el +++ b/lisp/calc/calc-alg.el @@ -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: ") diff --git a/lisp/calc/calc-arith.el b/lisp/calc/calc-arith.el index f8057c5f1b9..dc341cb7aec 100644 --- a/lisp/calc/calc-arith.el +++ b/lisp/calc/calc-arith.el @@ -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) diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 563bcd9b023..ed290ea780a 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -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-dnonneg calcFunc-dnonzero calcFunc-dnumint calcFunc-dodd 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-force-refresh calc-locate-cursor-element calc-show-edit-buffer) ("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 diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index c1673508897..c4b1127a5c5 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -911,6 +911,11 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).") (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))) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 4c6820ca90e..bd161132ddf 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -2027,6 +2027,10 @@ See calc-keypad for details." (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") diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index 896f0755ad8..18d984d9ae9 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -378,7 +378,7 @@ If LIST-ONLY is non-nil don't modify or display the buffer, only return a list." (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 @@ If LIST-ONLY is non-nil don't modify or display the buffer, only return a list." 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 @@ is created." (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 @@ diary entries." 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 @@ If omitted, NONMARKING defaults to nil and FILE defaults to `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)) diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el index 61c597a200e..1b13a12698f 100644 --- a/lisp/cus-dep.el +++ b/lisp/cus-dep.el @@ -79,54 +79,46 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" (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 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" \(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 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" -;;; arch-tag: b7b6421a-bf7a-44fd-a382-6f44976bdf68 +;; arch-tag: b7b6421a-bf7a-44fd-a382-6f44976bdf68 ;;; cus-dep.el ends here diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 40e26834c83..63a0f388f56 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -493,11 +493,12 @@ Return a list suitable for use in `interactive'." (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 @@ making them as if they had never been customized at all." (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 @@ Insert PREFIX first if non-nil." (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 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." (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 @@ restoring it to the state of a face that has never been customized." (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 diff --git a/lisp/dired-x.el b/lisp/dired-x.el index e48d6780c48..14e0a459f86 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -112,6 +112,7 @@ (require 'dired-aux) (defvar vm-folder-directory) +(eval-when-compile (require 'man)) ;;; User-defined variables. @@ -1411,9 +1412,11 @@ Uses `man.el' of \\[manual-entry] fame." ;;; 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. diff --git a/lisp/disp-table.el b/lisp/disp-table.el index 3c862bcc421..3259b1d2123 100644 --- a/lisp/disp-table.el +++ b/lisp/disp-table.el @@ -229,7 +229,7 @@ for users who call this function in `.emacs'." ;; 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. diff --git a/lisp/ediff-util.el b/lisp/ediff-util.el index 9db05ad143b..caa927f2113 100644 --- a/lisp/ediff-util.el +++ b/lisp/ediff-util.el @@ -3173,7 +3173,7 @@ Hit \\[ediff-recenter] to reset the windows afterward." (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 diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index b14a556e02d..ff795e6de77 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -568,6 +568,9 @@ directory or directories specified." (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. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 8711a05e2d9..b46366a94b9 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -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) diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index 8e1f79f95ee..e595ff92a39 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -194,7 +194,12 @@ See Info node `(elisp)Derived Modes' for more details." 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))) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index b9a73218322..6dd5ffa217f 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -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 @@ which see." (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 diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el index d0b9b34e4d6..def90669885 100644 --- a/lisp/emulation/viper-util.el +++ b/lisp/emulation/viper-util.el @@ -1242,8 +1242,12 @@ the `Local variables' section of a file." ;; 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 diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index 71b9347b8b0..7bcaf8be399 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -440,6 +440,8 @@ widget." Buffer-menu-mode compilation-mode + rcirc-mode + view-mode vm-mode vm-summary-mode) diff --git a/lisp/files.el b/lisp/files.el index d99e641898b..7228116eecb 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2717,7 +2717,10 @@ Interactively, confirmation is required unless you supply a prefix argument." (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. diff --git a/lisp/find-lisp.el b/lisp/find-lisp.el index 59dac2f62d6..19ebe3fae6f 100644 --- a/lisp/find-lisp.el +++ b/lisp/find-lisp.el @@ -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 @@ It is a function which takes two arguments, the directory and its parent." (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 @@ It is a function which takes two arguments, the directory and its parent." (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 @@ It is a function which takes two arguments, the directory and its parent." (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) diff --git a/lisp/font-core.el b/lisp/font-core.el index 22311fd1e74..2f903acee6b 100644 --- a/lisp/font-core.el +++ b/lisp/font-core.el @@ -295,7 +295,8 @@ means that Font Lock mode is turned on for buffers in C and C++ modes only." 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. diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 6c96e46333f..f197ea11940 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,23 @@ +2005-11-09 Katsumi Yamaoka + + * message.el (message-generate-headers): Downcase the argument + given to message-check-element. + +2005-11-01 Katsumi Yamaoka + + * 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 (tiny change) + + * gnus-score.el (gnus-update-score-entry-dates): Doc fix. + +2005-10-31 Katsumi Yamaoka + + * mml.el (mml-preview): Doc fix. + 2005-10-27 Reiner Steib * 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 - - * 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 (tiny change) * gnus-art.el (gnus-treatment-function-alist): Move date-lapsed to diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index 2858ecb8343..f9edda4ec64 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -142,7 +142,7 @@ If this variable is nil, no score file entries will be expired." 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 is called with one parameter -- the score to be decayed." 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 @@ It can be: 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.) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 5d35137aec6..578fc49395c 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -1104,6 +1104,17 @@ For example: :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 @@ You should probably use `gnus-find-method-for-group' instead." (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 diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 6b1cd32d03d..019b5bd4f07 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -5077,7 +5077,8 @@ Headers already prepared in the buffer are not modified." ;; 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 diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 3024959ae7f..8b00313fb92 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -1102,7 +1102,7 @@ Should be adopted if code in `message-send-mail' is changed." (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)) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 73ab0f81807..6d95827c3e4 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -497,7 +497,11 @@ it is displayed along with the global value." (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))))) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index a2e7fb88663..b7cea179aea 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -384,8 +384,9 @@ that." (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 @@ that." (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 @@ See `help-make-xrefs'." ((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 @@ help buffer." ;; 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 @@ For the cross-reference format, see `help-make-xrefs'." (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)))))) diff --git a/lisp/help.el b/lisp/help.el index cb634e2bdad..5141c06981a 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -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 @@ If FUNCTION is nil, it applies `message', thus displaying the message." "You have typed %THIS-KEY%, the help character. Type a Help option: \(Use SPC or DEL to scroll through this text. Type \\\\[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 @@ the last key hit are used." (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 diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index 84a8cd6284e..63f7611bd52 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -304,8 +304,10 @@ is found. A mode is excluded if it's in the list `hi-lock-exclude-modes'." (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 @@ is found. A mode is excluded if it's in the list `hi-lock-exclude-modes'." (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)))) diff --git a/lisp/international/ucs-tables.el b/lisp/international/ucs-tables.el index 937df9e78df..8d0760563c5 100644 --- a/lisp/international/ucs-tables.el +++ b/lisp/international/ucs-tables.el @@ -2523,9 +2523,9 @@ This function is automatically called directly at the end of `get-buffer-create' (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 diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el index fb0a62d602d..d5305211f50 100644 --- a/lisp/jka-cmpr-hook.el +++ b/lisp/jka-cmpr-hook.el @@ -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 @@ invoked." 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 @@ and `inhibit-first-line-modes-suffixes'." (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)) + (push jka-compr-file-name-handler-entry file-name-handler-alist) - (setq jka-compr-added-to-file-coding-system-alist nil) + (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)) - (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))) - - (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 @@ The return value is the entry in `file-name-handler-alist' for jka-compr." "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 @@ Returns the new status of auto compression (non-nil means on)." (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) diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el index b25d3865668..c15cfbdea30 100644 --- a/lisp/jka-compr.el +++ b/lisp/jka-compr.el @@ -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 @@ data appears to be compressed already.") (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 @@ based on the filename itself and `jka-compr-compression-info-list'." (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 @@ to keep: LEN chars starting BEG chars from the beginning." (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 @@ There should be no more than seven characters after the final `/'." (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 @@ There should be no more than seven characters after the final `/'." (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 @@ by `jka-compr-installed'." (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 @@ by `jka-compr-installed'." (provide 'jka-compr) -;;; arch-tag: 3f15b630-e9a7-46c4-a22a-94afdde86ebc +;; arch-tag: 3f15b630-e9a7-46c4-a22a-94afdde86ebc ;;; jka-compr.el ends here diff --git a/lisp/loadup.el b/lisp/loadup.el index affc735ecd0..9b3cae5ba37 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -147,6 +147,7 @@ (load "select"))) (load "emacs-lisp/timer") (load "isearch") +(load "rfn-eshadow") (message "%s" (garbage-collect)) (load "menu-bar") diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index 55a4d060fad..1a280ffc7f4 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -365,7 +365,7 @@ This is relative to `smtpmail-queue-dir'.") (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) diff --git a/lisp/man.el b/lisp/man.el index 30ab44efad0..5b5096f157d 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -923,6 +923,10 @@ header file (#include ) and files in FILES. 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 diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 902b48e0a50..007fd4190fe 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -641,8 +641,7 @@ by \"Save Options\" in Custom buffers.") ;; 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 @@ mail status in mode line")) "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 @@ key, a click, or a menu-item")) '(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) diff --git a/lisp/net/eudcb-ph.el b/lisp/net/eudcb-ph.el index 3aea6030257..30a8efbbae3 100644 --- a/lisp/net/eudcb-ph.el +++ b/lisp/net/eudcb-ph.el @@ -184,7 +184,7 @@ SERVER is either a string naming the server or a list (NAME PORT)." (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) diff --git a/lisp/net/tramp-util.el b/lisp/net/tramp-util.el index 10f9f7ff605..acb10727d46 100644 --- a/lisp/net/tramp-util.el +++ b/lisp/net/tramp-util.el @@ -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. diff --git a/lisp/printing.el b/lisp/printing.el index 3771871c9c8..c199dcacc28 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -1042,12 +1042,6 @@ Please send all bug fixes and enhancements to ;; 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 @@ See `pr-ps-printer-alist'.") (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 diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el index fed5057b9c6..f8f80ce6f66 100644 --- a/lisp/progmodes/gdb-ui.el +++ b/lisp/progmodes/gdb-ui.el @@ -358,13 +358,16 @@ With arg, use separate IO iff arg is positive." (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 @@ With arg, use separate IO iff arg is positive." (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 @@ With arg, use separate IO iff arg is positive." (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 @@ With arg, use separate IO iff arg is positive." `(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 @@ With arg, use separate IO iff arg is positive." (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 arg, use separate IO iff arg is positive." (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 @@ static char *magick[] = { :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 @@ corresponding to the mode line clicked." (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 @@ BUFFER nil or omitted means use the current buffer." (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))) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index c61f3cf96d2..31223ddc7a9 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -122,33 +122,50 @@ Used to grey out relevant togolbar icons.") (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 @@ Used to grey out relevant togolbar icons.") :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 @@ Used to grey out relevant togolbar icons.") (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 @@ t means that there is no stack, and we are in display-file mode.") (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 @@ t means that there is no stack, and we are in display-file mode.") (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 @@ required by the caller." (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 @@ and source-file directory for your debugger." (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[+]?) *") diff --git a/lisp/replace.el b/lisp/replace.el index 3016f5f6198..e74b8690c28 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -878,6 +878,16 @@ If the value is nil, don't highlight the buffer names specially." :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 the value is nil, don't highlight the buffer names specially." (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 @@ See also `multi-occur'." (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 @@ See also `multi-occur'." (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 diff --git a/lisp/reveal.el b/lisp/reveal.el index 41b7c4268c2..06f8940eddc 100644 --- a/lisp/reveal.el +++ b/lisp/reveal.el @@ -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 diff --git a/lisp/rfn-eshadow.el b/lisp/rfn-eshadow.el index 9141b5220e8..a9f55ced0e4 100644 --- a/lisp/rfn-eshadow.el +++ b/lisp/rfn-eshadow.el @@ -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 @@ Only used when `file-name-shadow-mode' is active and emacs 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 @@ The prompt and initial input should already have been inserted." (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 @@ that portion dim, invisible, or otherwise less visually noticeable. 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 @@ Returns non-nil if the new state is enabled." (provide 'rfn-eshadow) -;;; arch-tag: dcf70a52-0115-4ec2-b1e3-4f8d3541a888 +;; arch-tag: dcf70a52-0115-4ec2-b1e3-4f8d3541a888 ;;; rfn-eshadow.el ends here diff --git a/lisp/savehist.el b/lisp/savehist.el index 6c85fb7c635..97960199302 100644 --- a/lisp/savehist.el +++ b/lisp/savehist.el @@ -4,7 +4,7 @@ ;; Author: Hrvoje Niksic ;; 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 @@ If set to nil, disables timer-based autosaving." :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 @@ along with minibuffer history. You can change its value off `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 @@ which is probably undesirable." (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 @@ Does nothing if savehist-mode is off." (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 @@ Does nothing if savehist-mode is off." (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) diff --git a/lisp/simple.el b/lisp/simple.el index 15ff83ef6f2..5f8c6efa660 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -893,8 +893,8 @@ in *Help* buffer. See also the command `describe-char'." (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 @@ The goal column is stored in the variable `goal-column'." ;;"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 @@ If nil, search stops at the beginning of the accessible portion of the buffer." (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 @@ Called from `temp-buffer-show-hook'." 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 @@ of the differing parts is, by contrast, slightly highlighted." "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 @@ is the substring.)") (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) diff --git a/lisp/startup.el b/lisp/startup.el index 0bde4a000bc..b56aa331e71 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -773,6 +773,7 @@ opening the first frame (e.g. open a connection to an X server).") (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) diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 0e57d541dfe..5a400ffbec4 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -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 @@ how many null padding bytes go on the end of the tar file." :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 @@ the file never exists on disk." :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 @@ write-date, checksum, link-type, and link-name." (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 @@ write-date, checksum, link-type, and link-name." (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 @@ MODE should be an integer which is a file mode value." (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 @@ MODE should be an integer which is a file mode value." 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) -(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. + ;; Make menu bar items. -;; Get rid of the Edit menu bar item to save space. -(define-key tar-mode-map [menu-bar edit] 'undefined) + ;; Get rid of the Edit menu bar item to save space. + (define-key map [menu-bar edit] 'undefined) -(define-key tar-mode-map [menu-bar immediate] - (cons "Immediate" (make-sparse-keymap "Immediate"))) + (define-key map [menu-bar immediate] + (cons "Immediate" (make-sparse-keymap "Immediate"))) -(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 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 tar-mode-map [menu-bar mark] - (cons "Mark" (make-sparse-keymap "Mark"))) + (define-key map [menu-bar mark] + (cons "Mark" (make-sparse-keymap "Mark"))) -(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 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 operate] - (cons "Operate" (make-sparse-keymap "Operate"))) + (define-key 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)) + + map) + "Local keymap for Tar mode listings.") -(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)) ;; tar mode is suitable only for specially formatted data. (put 'tar-mode 'mode-class 'special) @@ -559,7 +558,7 @@ or click mouse-2 on the file's line in the Tar mode buffer. 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 @@ appear on disk when you save the tar-file's buffer." (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 @@ appear on disk when you save the tar-file's buffer." (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 @@ the current tar-entry." (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 @@ With a prefix argument, mark that many files." (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 @@ With a prefix argument, un-mark that many files backward." "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 @@ With a prefix argument, un-mark that many files backward." (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 @@ With a prefix argument, un-mark that many files backward." (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 @@ for this to be permanent." (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 @@ for this to be permanent." (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 @@ for this to be permanent." (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 @@ for this to be permanent." (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 @@ for this to be permanent." (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 @@ for this to be permanent." (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 @@ for this to be permanent." (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 @@ to make your changes permanent." ;; 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 @@ Leaves the region wide." (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 @@ Leaves the region wide." (provide 'tar-mode) -;;; arch-tag: 8a585a4a-340e-42c2-89e7-d3b1013a4b78 +;; arch-tag: 8a585a4a-340e-42c2-89e7-d3b1013a4b78 ;;; tar-mode.el ends here diff --git a/lisp/term.el b/lisp/term.el index 4d319c253ae..14d4fb9a5ab 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -1406,8 +1406,8 @@ The main purpose is to get rid of the local keymap." :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 @@ all pending output has been dealt with.")) (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 @@ Should only be called when point is at the start of a screen line." ;;; 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)) diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index a4d77213aec..dd718e21ed9 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -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 @@ This variable specifies how far to search to find such a duplicate. :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 @@ command was not the very same command." :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 @@ Ispell's ultimate default dictionary." :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 @@ http://strw.leidenuniv.nl/~dominik/Tools" (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 @@ If `flyspell-large-region' is nil, all regions are treated as small." :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 @@ If `flyspell-large-region' is nil, all regions are treated as small." :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 @@ If `flyspell-large-region' is nil, all regions are treated as small." "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 @@ Flyspell mode sets this variable to whatever is the `flyspell-mode-predicate' 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 @@ property of the major mode name.") (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 @@ property of the major mode name.") (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 @@ property of the major mode name.") (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 @@ property of the major mode name.") (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 @@ property of the major mode name.") (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 @@ property of the major mode name.") (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 @@ property of the major mode name.") (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 @@ See also `flyspell-duplicate-distance'." (defvar flyspell-overlay nil) -;*---------------------------------------------------------------------*/ -;* flyspell-mode ... */ -;*---------------------------------------------------------------------*/ +;;*---------------------------------------------------------------------*/ +;;* flyspell-mode ... */ +;;*---------------------------------------------------------------------*/ ;;;###autoload(defvar flyspell-mode nil) ;;;###autoload (define-minor-mode flyspell-mode @@ -494,32 +483,31 @@ in your .emacs file. (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 @@ in your .emacs file. (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 @@ in your .emacs file. ;; 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 @@ It will be checked only after `flyspell-delay' seconds." (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 @@ not the very same deplacement command." (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 @@ not the very same deplacement command." (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 @@ not the very same deplacement command." (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 @@ not the very same deplacement command." ;; 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 @@ before the current command." (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 @@ Mostly we check word delimiters." (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 @@ Mostly we check word delimiters." (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 @@ Mostly we check word delimiters." ;; 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 @@ Mostly we check word delimiters." '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 @@ Mostly we check word delimiters." ;; 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 @@ Mostly we check word delimiters." (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 @@ Mostly we check word delimiters." (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 @@ Mostly we check word delimiters." (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 @@ Mostly we check word delimiters." ;; 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 @@ Mostly we check word delimiters." (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 @@ Mostly we check word delimiters." (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 @@ Mostly we check word delimiters." (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 @@ Mostly we check word delimiters." (>= (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 @@ this function changes the last char of the `ispell-casechars' string." (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 @@ this function changes the last char of the `ispell-casechars' string." (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 syntax described by `flyspell-dictionary-alist' (which see)." 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 @@ Word syntax described by `flyspell-dictionary-alist' (which see)." (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 @@ The buffer to mark them in is `flyspell-large-region-buffer'." (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 @@ The buffer to mark them in is `flyspell-large-region-buffer'." (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 @@ The buffer to mark them in is `flyspell-large-region-buffer'." (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 @@ The buffer to mark them in is `flyspell-large-region-buffer'." (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 @@ FLYSPELL-BUFFER." (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 @@ FLYSPELL-BUFFER." (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 @@ if the character at POS has any other property." (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 @@ is itself incorrect, but suspiciously repeated." (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 @@ as returned by `ispell-parse-output'." (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 @@ as returned by `ispell-parse-output'." (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 @@ misspelled words backwards." (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 @@ misspelled words backwards." (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 @@ misspelled words backwards." (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 @@ This command proposes various successive corrections for the current word." 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 @@ This command proposes various successive corrections for the current word." (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 @@ Sets `flyspell-auto-correct-previous-pos' to nil" (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 @@ But don't look beyond what's visible on the screen." ;; 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 @@ The word checked is the word at the mouse position." (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 @@ The word checked is the word at the mouse position." (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 @@ The word checked is the word at the mouse position." (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 @@ The word checked is the word at the mouse position." (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 @@ The word checked is the word at the mouse position." 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 @@ The word checked is the word at the mouse position." 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 @@ This function is meant to be added to `flyspell-incorrect-hook'." (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)) diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el index 372b0dd64bd..ef1c66bf166 100644 --- a/lisp/textmodes/org.el +++ b/lisp/textmodes/org.el @@ -9103,7 +9103,6 @@ headlines. The default is 3. Lower levels will become bulleted lists." (if org-export-html-with-timestamp (insert org-export-html-html-helper-timestamp)) (insert "\n\n") - (debug) (normal-mode) (save-buffer) (goto-char (point-min))))) diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el index 8d0aa4bf80d..386f19f1797 100644 --- a/lisp/textmodes/reftex.el +++ b/lisp/textmodes/reftex.el @@ -2262,7 +2262,7 @@ IGNORE-WORDS List of words which should be removed from the string." (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))) diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index f45c73216f7..e0a68349ce1 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,9 +1,14 @@ +2005-11-16 Juergen Hoetzel (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 (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. diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index 4fa52572a94..1c9d1d9c0b1 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -202,6 +202,7 @@ accessible." (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 @@ accessible." (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) diff --git a/lisp/vc-svn.el b/lisp/vc-svn.el index de34fa847e2..8480d61c843 100644 --- a/lisp/vc-svn.el +++ b/lisp/vc-svn.el @@ -116,8 +116,11 @@ This is only meaningful if you don't use the implicit checkout model (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))))) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 5f5d3479547..0df0b7365db 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -3575,7 +3575,7 @@ example: ;; 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" diff --git a/lispref/ChangeLog b/lispref/ChangeLog index 3eb27dd4c5e..d8014b27613 100644 --- a/lispref/ChangeLog +++ b/lispref/ChangeLog @@ -1,3 +1,8 @@ +2005-11-16 Stefan Monnier + + * 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 * files.texi (Magic File Names): find-file-name-handler checks the @@ -31,9 +36,9 @@ 2005-10-27 Masatake YAMATO - * minibuf.texi (Completion Commands): + * minibuf.texi (Completion Commands): Write about new optional argument for `display-completion-list'. - + 2005-10-23 Richard M. Stallman * display.texi (Overlay Arrow): Clarify about local bindings of diff --git a/lispref/modes.texi b/lispref/modes.texi index 00b58f0a9ff..f0513704b1f 100644 --- a/lispref/modes.texi +++ b/lispref/modes.texi @@ -1214,8 +1214,8 @@ The value of this variable is a list of all minor mode commands. 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 @@ enable the mode. For example: "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 diff --git a/lispref/windows.texi b/lispref/windows.texi index 0ca7d69c9f9..56ec80b9a24 100644 --- a/lispref/windows.texi +++ b/lispref/windows.texi @@ -488,7 +488,7 @@ selected window and current buffer. It is just like 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 @@ these. The selected window is always the most recently used window. 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 @@ If it is a frame, consider windows on that frame. @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 diff --git a/mac/ChangeLog b/mac/ChangeLog index 15b5855db92..e61cb12a946 100644 --- a/mac/ChangeLog +++ b/mac/ChangeLog @@ -1,3 +1,7 @@ +2005-11-09 YAMAMOTO Mitsuharu + + * makefile.MPW (shortlisp): Sync with src/Makefile.in. + 2005-10-24 YAMAMOTO Mitsuharu * INSTALL: Replace `Mac OS 8/9' with `Mac OS Classic'. Add diff --git a/mac/makefile.MPW b/mac/makefile.MPW index 9d8eda541cf..60edb1f8732 100644 --- a/mac/makefile.MPW +++ b/mac/makefile.MPW @@ -1077,6 +1077,9 @@ shortlisp = {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 ¶ diff --git a/man/ChangeLog b/man/ChangeLog index 84df05319ec..0ebbeee7884 100644 --- a/man/ChangeLog +++ b/man/ChangeLog @@ -1,3 +1,59 @@ +2005-11-16 Chong Yidong + + * ack.texi (Acknowledgments): Acknowledge Andrew Zhilin for Emacs + icons. + +2005-11-12 Kim F. Storm + + * 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 + + * gnus.texi (XVarious): Fix description of gnus-use-toolbar; add + new variable gnus-toolbar-thickness. + +2005-11-08 Katsumi Yamaoka + + * gnus.texi (XVarious): Revert description of gnus-use-toolbar. + +2005-11-07 Katsumi Yamaoka + + * 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 + + * gnus.texi (Group Parameters): Mention new varable + gnus-parameters-case-fold-search. + (Home Score File): Addition. + +2005-11-09 Luc Teirlinck + + * killing.texi (CUA Bindings): Add @section. + +2005-11-10 Kim F. Storm + + * 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 + + * 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 * misc.texi (Shell Mode): Describe how to activate password echoing. diff --git a/man/ack.texi b/man/ack.texi index 48a32072083..206b2cbc268 100644 --- a/man/ack.texi +++ b/man/ack.texi @@ -1470,6 +1470,9 @@ aliases, and tar files. @end itemize +@item +Andrew Zhilin created the Emacs icons used beginning with Emacs 22. + @item Shenghuo Zhu wrote: diff --git a/man/emacs.texi b/man/emacs.texi index d1fd4cc2505..8da4e4ed051 100644 --- a/man/emacs.texi +++ b/man/emacs.texi @@ -285,6 +285,8 @@ Killing and Moving Text 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 diff --git a/man/gnus.texi b/man/gnus.texi index cbd8554c382..a588dd78974 100644 --- a/man/gnus.texi +++ b/man/gnus.texi @@ -3060,6 +3060,19 @@ example: 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 @@ group name, the @var{file-name} will be used as the home score file. @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 @@ function, this function will be called with the face as the argument. 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 @@ This is where Gnus will look for pictures. Gnus will normally 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 @@ default. @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 diff --git a/man/help.texi b/man/help.texi index 8ecc610c66c..4da43fcb6ff 100644 --- a/man/help.texi +++ b/man/help.texi @@ -46,17 +46,19 @@ manual index, then finally look in the FAQ and the package keywords. @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 @@ command. 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 @@ mode bindings, major mode bindings, and global bindings 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 @@ view, describe, default. @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 @@ If the variable @code{apropos-sort-by-scores} is non-@code{nil}, 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 @@ Emacs (@code{describe-no-warranty}). 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 diff --git a/man/killing.texi b/man/killing.texi index bcb170ac265..8353eb00bb3 100644 --- a/man/killing.texi +++ b/man/killing.texi @@ -520,7 +520,7 @@ of the specified file. The file is changed immediately on disk. 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 @@ rectangle shifts right. @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 diff --git a/man/mini.texi b/man/mini.texi index a76be23ba7d..20295e86071 100644 --- a/man/mini.texi +++ b/man/mini.texi @@ -109,6 +109,9 @@ GNU Emacs gives a special meaning to a double slash (which is not 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 diff --git a/man/misc.texi b/man/misc.texi index 14dadbfc9d7..f1f19ea8b6a 100644 --- a/man/misc.texi +++ b/man/misc.texi @@ -2136,29 +2136,6 @@ Emacs key bindings are still available. The EDT emulation rebindings 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 diff --git a/man/regs.texi b/man/regs.texi index 0e3c9073ac7..0992d750052 100644 --- a/man/regs.texi +++ b/man/regs.texi @@ -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 diff --git a/src/.gdbinit b/src/.gdbinit index 462b6a86c5f..3f7755a3d8e 100644 --- a/src/.gdbinit +++ b/src/.gdbinit @@ -31,6 +31,9 @@ dir ../lwlib # 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 @@ end # 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 @@ define pitx 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 @@ document xbacktrace 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 diff --git a/src/ChangeLog b/src/ChangeLog index e2798ad1268..900db33db3d 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,152 @@ +2005-11-16 Stefan Monnier + + * lread.c (readevalloop): Add missing GCPROs. + +2005-11-16 Chong Yidong + + * 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 + + * Makefile.in (lisp, shortlisp): Add rfn-eshadow. + +2005-11-16 Nick Roberts + + * .gdbinit: Make SIGTSTP work like SIGINT normally does. + +2005-11-15 Andreas Schwab + + * 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 + + * 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 + + * 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 + + * 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 + + * .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 + + * fileio.c (file-regular-p): Doc fix. + +2005-11-10 Kim F. Storm + + * 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 + + * .gdbinit (pp1): New user-defined function. + +2005-11-09 YAMAMOTO Mitsuharu + + * 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 + + * 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 + + * 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 * 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) diff --git a/src/Makefile.in b/src/Makefile.in index 30dc5ab030d..7c9203d11ff 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -725,6 +725,7 @@ lisp= \ ${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 @@ shortlisp= \ ../lisp/help.elc \ ../lisp/indent.elc \ ../lisp/isearch.elc \ + ../lisp/rfn-eshadow.elc \ ../lisp/loadup.el \ ../lisp/loaddefs.el \ ../lisp/bindings.elc \ diff --git a/src/alloc.c b/src/alloc.c index 1e95447549b..bc48f7bb3b4 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2532,7 +2532,7 @@ void 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 @@ make_float (float_value) /* 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 @@ void 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 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0, /* 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 @@ check_cons_list () struct Lisp_Cons *tail = cons_free_list; while (tail) - tail = *(struct Lisp_Cons **)&tail->cdr; + tail = tail->u.chain; #endif } @@ -3141,7 +3141,7 @@ Its value and function definition are void, and its property list is nil. */) 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 @@ mark_stack () #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 @@ returns nil, because real GC can't be done. */) 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 @@ mark_object (arg) 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 @@ gc_sweep () 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 @@ gc_sweep () { *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 @@ gc_sweep () 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 @@ gc_sweep () { *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 @@ gc_sweep () 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 @@ gc_sweep () { *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--; } diff --git a/src/dispextern.h b/src/dispextern.h index 078726aa5c8..f5573efdcc4 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -1974,6 +1974,10 @@ struct it /* 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; diff --git a/src/doc.c b/src/doc.c index a31c53d5b21..0566c5f9d06 100644 --- a/src/doc.c +++ b/src/doc.c @@ -735,15 +735,18 @@ the same file name is found in the `doc-directory'. */) 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 \\=\\ 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; { diff --git a/src/fileio.c b/src/fileio.c index 6806c7d025a..b7262b6c58b 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -3394,8 +3394,10 @@ searchable directory. */) } 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; { diff --git a/src/gnu.h b/src/gnu.h index 1d623431af8..dbf47317493 100644 --- a/src/gnu.h +++ b/src/gnu.h @@ -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, diff --git a/src/image.c b/src/image.c index fb3cdecaa54..1ba1cd197ff 100644 --- a/src/image.c +++ b/src/image.c @@ -2549,6 +2549,7 @@ image_load_quartz2d (f, img, png_p) if (!check_image_size (f, width, height)) { + CGImageRelease (image); UNGCPRO; image_error ("Invalid image size", Qnil, Qnil); return 0; @@ -3715,6 +3716,45 @@ xpm_image_p (object) #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 @@ xpm_load (f, img) 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 @@ init_image () { #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 diff --git a/src/keymap.c b/src/keymap.c index 7e5b00bc771..a19b0102127 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -2370,7 +2370,13 @@ shadow_lookup (shadow, key, flag) 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; diff --git a/src/lisp.h b/src/lisp.h index adf53035e98..767e97a94a6 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -600,9 +600,19 @@ struct Lisp_Cons /* 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 @@ struct Lisp_Cons 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 @@ union Lisp_Misc /* 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_once P_ ((void)); 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; diff --git a/src/lread.c b/src/lread.c index 1bae0ea7ddd..234fbe6e395 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1317,7 +1317,7 @@ readevalloop (readcharfun, stream, sourcename, evalfun, 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 @@ readevalloop (readcharfun, stream, sourcename, evalfun, 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); diff --git a/src/mac.c b/src/mac.c index 4c8e78ade25..2493945727d 100644 --- a/src/mac.c +++ b/src/mac.c @@ -854,9 +854,14 @@ parse_resource_line (p) 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 @@ xrm_create_database () 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 @@ xrm_q_put_resource (database, quarks, value) 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 @@ xrm_get_resource (database, name, class) 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 @@ xrm_get_resource (database, name, class) 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 @@ DEFUN ("mac-code-convert-string", Fmac_code_convert_string, Smac_code_convert_st 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 @@ DEFUN ("mac-clear-font-name-table", Fmac_clear_font_name_table, Smac_clear_font_ 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 @@ extern int noninteractive; 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 @@ init_mac_osx_environment () 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 @@ init_mac_osx_environment () #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 () { diff --git a/src/macgui.h b/src/macgui.h index 6e2adb092c6..40244dbc7c6 100644 --- a/src/macgui.h +++ b/src/macgui.h @@ -92,6 +92,12 @@ typedef GWorldPtr Pixmap; #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 @@ struct MacFontStruct { #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 */ diff --git a/src/macterm.c b/src/macterm.c index 70120bdf59d..169e3d60855 100644 --- a/src/macterm.c +++ b/src/macterm.c @@ -87,14 +87,6 @@ Boston, MA 02110-1301, USA. */ #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 @@ extern EMACS_INT extra_keyboard_modifiers; /* 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 @@ mac_draw_string_common (f, gc, x, y, buf, nchars, mode, bytes_per_char) 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 @@ mac_draw_image_string_16 (f, gc, x, y, buf, nchars) } +#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 @@ x_draw_glyph_string_foreground (s) || 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 @@ XLoadQueryFont (Display *dpy, char *fontname) Str31 charset; SInt16 fontnum; #if USE_ATSUI + static ATSUFontID font_id; ATSUStyle mac_style = NULL; #endif Style fontface; @@ -7322,7 +7394,6 @@ XLoadQueryFont (Display *dpy, char *fontname) 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 @@ XLoadQueryFont (Display *dpy, char *fontname) 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 @@ XLoadQueryFont (Display *dpy, char *fontname) } 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 @@ XLoadQueryFont (Display *dpy, char *fontname) 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 @@ XLoadQueryFont (Display *dpy, char *fontname) } } } +#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 @@ XLoadQueryFont (Display *dpy, char *fontname) 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 @@ XLoadQueryFont (Display *dpy, char *fontname) 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 @@ XLoadQueryFont (Display *dpy, char *fontname) 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 @@ mac_unload_font (dpyinfo, font) #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 @@ x_find_ccl_program (fontp) /* 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 @@ mac_to_emacs_modifiers (EventModifiers mods) #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 @@ mac_get_emulated_btn ( UInt32 modifiers ) #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 @@ static unsigned char keycode_to_xkeysym_table[] = { /*0x7C*/ 0x53 /*right*/, 0x54 /*down*/, 0x52 /*up*/, 0 }; + static int keycode_to_xkeysym (int keyCode, int *xKeySym) { @@ -9392,6 +9574,121 @@ keycode_to_xkeysym (int keyCode, int *xKeySym) 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 @@ XTread_socket (sd, expected, hold_quit) || !(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 @@ XTread_socket (sd, expected, hold_quit) 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; - } - 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.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 +#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 @@ mac_determine_quit_char_modifiers() /* 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 @@ syms_of_macterm () #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 @@ syms_of_macterm () 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, diff --git a/src/print.c b/src/print.c index 91642afd651..d563580ddd3 100644 --- a/src/print.c +++ b/src/print.c @@ -970,6 +970,26 @@ debug_print (arg) 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, diff --git a/src/process.c b/src/process.c index dd892637726..752768a7bad 100644 --- a/src/process.c +++ b/src/process.c @@ -5944,97 +5944,100 @@ SIGCODE may be an integer, or a symbol whose name is a signal name. */) 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); diff --git a/src/s/darwin.h b/src/s/darwin.h index fad445d7557..6227010e3ed 100644 --- a/src/s/darwin.h +++ b/src/s/darwin.h @@ -263,13 +263,13 @@ Boston, MA 02110-1301, USA. */ /* 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 @@ struct kboard; 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 diff --git a/src/search.c b/src/search.c index d3a5bd838a9..ab4b2a0f519 100644 --- a/src/search.c +++ b/src/search.c @@ -1174,7 +1174,7 @@ search_buffer (string, pos, pos_byte, lim, lim_byte, n, 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; diff --git a/src/unexmacosx.c b/src/unexmacosx.c index 9db9622f6f5..43e1f5e805c 100644 --- a/src/unexmacosx.c +++ b/src/unexmacosx.c @@ -174,7 +174,7 @@ off_t data_segment_old_fileoff; 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 @@ unexec_read (void *dest, size_t n) 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 @@ unexec_write (off_t dest, const void *src, size_t count) 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 @@ copy_data_segment (struct load_command *lc) 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 diff --git a/src/xdisp.c b/src/xdisp.c index 4db562c2283..623a1b3a524 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -2965,11 +2965,13 @@ handle_stop (it) 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 @@ set_iterator_to_next (it, reseat_p) 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 @@ get_window_cursor_type (w, glyph, width, active_cursor) /* 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); } diff --git a/src/xfns.c b/src/xfns.c index d39616429ad..311bc5f1bd8 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -829,6 +829,27 @@ xg_set_icon (f, file) 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 */ diff --git a/src/xterm.c b/src/xterm.c index 1adcb4fb4d1..42c860b64c9 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -7376,10 +7376,30 @@ x_bitmap_icon (f, file) /* 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,