Using saved parent location: http://bzr.savannah.gnu.org/r/emacs/trunk/ Now on revision 102386. ------------------------------------------------------------ revno: 102386 committer: YAMAMOTO Mitsuharu branch nick: trunk timestamp: Sun 2010-11-14 15:55:27 +0900 message: Add const to array elements. * keyboard.c (modify_event_symbol) : Add const to array elements of arg NAME_TABLE. (lispy_accent_keys, lispy_function_keys, lispy_multimedia_keys) (lispy_kana_keys, iso_lispy_function_keys, lispy_wheel_names) (lispy_wheel_names, lispy_drag_n_drop_names, modifier_names): Add const to array elements. (scroll_bar_parts): Make static. Fix position of const. * w32fns.c (lispy_function_keys): Add const to extern. * w32inevt.c (lispy_function_keys): Likewise. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-11-14 02:09:11 +0000 +++ src/ChangeLog 2010-11-14 06:55:27 +0000 @@ -1,3 +1,17 @@ +2010-11-14 YAMAMOTO Mitsuharu + + * keyboard.c (modify_event_symbol) : Add const to array elements of + arg NAME_TABLE. + (lispy_accent_keys, lispy_function_keys, lispy_multimedia_keys) + (lispy_kana_keys, iso_lispy_function_keys, lispy_wheel_names) + (lispy_wheel_names, lispy_drag_n_drop_names, modifier_names): + Add const to array elements. + (scroll_bar_parts): Make static. Fix position of const. + + * w32fns.c (lispy_function_keys): Add const to extern. + + * w32inevt.c (lispy_function_keys): Likewise. + 2010-11-14 Chong Yidong * xfns.c (Fx_create_frame): Don't check for the cursorColor === modified file 'src/keyboard.c' --- src/keyboard.c 2010-11-09 20:07:10 +0000 +++ src/keyboard.c 2010-11-14 06:55:27 +0000 @@ -620,7 +620,7 @@ unsigned long); #endif static Lisp_Object modify_event_symbol (EMACS_INT, unsigned, Lisp_Object, - Lisp_Object, const char **, + Lisp_Object, const char *const *, Lisp_Object *, unsigned); static Lisp_Object make_lispy_switch_frame (Lisp_Object); static void save_getcjmp (jmp_buf); @@ -4752,7 +4752,7 @@ /* This is a list of Lisp names for special "accent" characters. It parallels lispy_accent_codes. */ -static const char *lispy_accent_keys[] = +static const char *const lispy_accent_keys[] = { "dead-circumflex", "dead-grave", @@ -4779,7 +4779,7 @@ #ifdef HAVE_NTGUI #define FUNCTION_KEY_OFFSET 0x0 -char const *lispy_function_keys[] = +const char *const lispy_function_keys[] = { 0, /* 0 */ @@ -4973,7 +4973,7 @@ /* Some of these duplicate the "Media keys" on newer keyboards, but they are delivered to the application in a different way. */ -static const char *lispy_multimedia_keys[] = +static const char *const lispy_multimedia_keys[] = { 0, "browser-back", @@ -5037,7 +5037,7 @@ the XK_kana_A case below. */ #if 0 #ifdef XK_kana_A -static const char *lispy_kana_keys[] = +static const char *const lispy_kana_keys[] = { /* X Keysym value */ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /* 0x400 .. 0x40f */ @@ -5076,7 +5076,7 @@ /* You'll notice that this table is arranged to be conveniently indexed by X Windows keysym values. */ -static const char *lispy_function_keys[] = +static const char *const lispy_function_keys[] = { /* X Keysym value */ @@ -5162,7 +5162,7 @@ /* ISO 9995 Function and Modifier Keys; the first byte is 0xFE. */ #define ISO_FUNCTION_KEY_OFFSET 0xfe00 -static const char *iso_lispy_function_keys[] = +static const char *const iso_lispy_function_keys[] = { 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe00 */ 0, 0, 0, 0, 0, 0, 0, 0, /* 0xfe08 */ @@ -5185,14 +5185,14 @@ Lisp_Object Vlispy_mouse_stem; -static const char *lispy_wheel_names[] = +static const char *const lispy_wheel_names[] = { "wheel-up", "wheel-down", "wheel-left", "wheel-right" }; /* drag-n-drop events are generated when a set of selected files are dragged from another application and dropped onto an Emacs window. */ -static const char *lispy_drag_n_drop_names[] = +static const char *const lispy_drag_n_drop_names[] = { "drag-n-drop" }; @@ -5203,7 +5203,7 @@ Lisp_Object Qtop, Qratio; /* An array of scroll bar parts, indexed by an enum scroll_bar_part value. */ -const Lisp_Object *scroll_bar_parts[] = { +static Lisp_Object *const scroll_bar_parts[] = { &Qabove_handle, &Qhandle, &Qbelow_handle, &Qup, &Qdown, &Qtop, &Qbottom, &Qend_scroll, &Qratio }; @@ -6351,7 +6351,7 @@ } -static const char *modifier_names[] = +static const char *const modifier_names[] = { "up", "down", "drag", "click", "double", "triple", 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -6571,7 +6571,7 @@ static Lisp_Object modify_event_symbol (EMACS_INT symbol_num, unsigned int modifiers, Lisp_Object symbol_kind, - Lisp_Object name_alist_or_stem, const char **name_table, + Lisp_Object name_alist_or_stem, const char *const *name_table, Lisp_Object *symbol_table, unsigned int table_size) { Lisp_Object value; === modified file 'src/w32fns.c' --- src/w32fns.c 2010-11-06 13:45:37 +0000 +++ src/w32fns.c 2010-11-14 06:55:27 +0000 @@ -82,7 +82,7 @@ extern int quit_char; -extern char *lispy_function_keys[]; +extern const char *const lispy_function_keys[]; /* The colormap for converting color names to RGB values */ Lisp_Object Vw32_color_map; === modified file 'src/w32inevt.c' --- src/w32inevt.c 2010-10-14 14:32:27 +0000 +++ src/w32inevt.c 2010-11-14 06:55:27 +0000 @@ -282,7 +282,7 @@ } -extern char *lispy_function_keys[]; +extern const char *const lispy_function_keys[]; static int faked_key = 0; ------------------------------------------------------------ revno: 102385 committer: Chong Yidong branch nick: trunk timestamp: Sat 2010-11-13 21:09:11 -0500 message: Let the cursorColor X resource set the the cursor face (Bug#7392). * lisp/startup.el (command-line): If the cursorColor resource is set, change the cursor face-spec (Bug#7392). * src/xfns.c (Fx_create_frame): Don't check for the cursorColor resource here; it's now done at startup. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-11-14 00:47:07 +0000 +++ lisp/ChangeLog 2010-11-14 02:09:11 +0000 @@ -1,3 +1,8 @@ +2010-11-14 Chong Yidong + + * startup.el (command-line): If the cursorColor resource is set, + change the cursor face-spec (Bug#7392). + 2010-11-13 Ken Manheimer The main features of the following allout.el changes are: === modified file 'lisp/startup.el' --- lisp/startup.el 2010-11-10 04:11:08 +0000 +++ lisp/startup.el 2010-11-14 02:09:11 +0000 @@ -885,14 +885,15 @@ ;; Under X, this creates the X frame and deletes the terminal frame. (unless (daemonp) - ;; Enable or disable the tool-bar and menu-bar. - ;; While we're at it, set `no-blinking-cursor' too. + + ;; If X resources are available, use them to initialize the values + ;; of `tool-bar-mode' and `menu-bar-mode', as well as the value of + ;; `no-blinking-cursor' and the `cursor' face. (cond ((or noninteractive emacs-basic-display) (setq menu-bar-mode nil tool-bar-mode nil no-blinking-cursor t)) - ;; Check X resources if available. ((memq initial-window-system '(x w32 ns)) (let ((no-vals '("no" "off" "false" "0"))) (if (member (x-get-resource "menuBar" "MenuBar") no-vals) @@ -901,7 +902,13 @@ (setq tool-bar-mode nil)) (if (member (x-get-resource "cursorBlink" "CursorBlink") no-vals) - (setq no-blinking-cursor t))))) + (setq no-blinking-cursor t))) + ;; If the cursorColor X resource exists, alter the `cursor' face + ;; spec, but mark it as changed outside of Customize. + (let ((color (x-get-resource "cursorColor" "CursorColor"))) + (when color + (face-spec-set 'cursor `((t (:background ,color)))) + (put 'cursor 'face-modified t))))) (frame-initialize)) (when (fboundp 'x-create-frame) === modified file 'src/ChangeLog' --- src/ChangeLog 2010-11-13 22:20:01 +0000 +++ src/ChangeLog 2010-11-14 02:09:11 +0000 @@ -1,3 +1,8 @@ +2010-11-14 Chong Yidong + + * xfns.c (Fx_create_frame): Don't check for the cursorColor + resource here; it's now done at startup. + 2010-11-13 Dan Nicolaescu * xmenu.c: Make it clear that ../lwlib/lwlib.h is only needed for Motif. === modified file 'src/xfns.c' --- src/xfns.c 2010-11-12 08:46:21 +0000 +++ src/xfns.c 2010-11-14 02:09:11 +0000 @@ -3367,8 +3367,6 @@ "background", "Background", RES_TYPE_STRING); x_default_parameter (f, parms, Qmouse_color, build_string ("black"), "pointerColor", "Foreground", RES_TYPE_STRING); - x_default_parameter (f, parms, Qcursor_color, build_string ("black"), - "cursorColor", "Foreground", RES_TYPE_STRING); x_default_parameter (f, parms, Qborder_color, build_string ("black"), "borderColor", "BorderColor", RES_TYPE_STRING); x_default_parameter (f, parms, Qscreen_gamma, Qnil, ------------------------------------------------------------ revno: 102384 committer: Glenn Morris branch nick: trunk timestamp: Sat 2010-11-13 17:55:37 -0800 message: Restore clobbered allout.el changes. diff: === modified file 'lisp/allout.el' --- lisp/allout.el 2010-11-13 22:30:10 +0000 +++ lisp/allout.el 2010-11-14 01:55:37 +0000 @@ -1,7 +1,7 @@ ;;; allout.el --- extensive outline mode for use alone and with other modes ;; Copyright (C) 1992, 1993, 1994, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Ken Manheimer ;; Maintainer: Ken Manheimer @@ -5832,8 +5832,7 @@ (let ((inhibit-field-text-motion t)) (beginning-of-line) (let ((beg (point)) - (end (progn (end-of-line)(point)))) - (goto-char beg) + (end (point-at-eol))) (save-match-data (while (re-search-forward "\\\\" ;;"\\\\\\|\\{\\|\\}\\|\\_\\|\\$\\|\\\"\\|\\&\\|\\^\\|\\-\\|\\*\\|#" ------------------------------------------------------------ revno: 102383 committer: Glenn Morris branch nick: trunk timestamp: Sat 2010-11-13 16:47:07 -0800 message: ChangeLog OCD. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-11-13 22:30:10 +0000 +++ lisp/ChangeLog 2010-11-14 00:47:07 +0000 @@ -1,82 +1,70 @@ -2010-11-13 Ken Manheimer - - Another omnibus checkin of a backlog of fixes. (Now that i'm - using bzr i should be able to interact with the gnu version - control repository in smaller, properly incremental steps, from - here on.) - - This main features of the changes here are: - +2010-11-13 Ken Manheimer + + The main features of the following allout.el changes are: - implement user customization for the allout key bindings - add a customization control by which the user can inhibit use of - a trailing Ctl-H, so by default it's reserved for use with + a trailing Ctrl-H, so by default it's reserved for use with describe-prefix-bindings - adapt to new version of called-interactively-p, while - maintaining backwards compatability with old version + maintaining backwards compatibility with old version - fix hotspot navigation so i works properly with meta-modified keys - + allout.el (allout-keybindings), (allout-bind-keys), - (allout-keybindings-binding), allout-prefixed-keybindings, - allout-unprefixed-keybindings, allout-preempt-trailing-ctrl-h, - allout-keybindings-list, - allout-mode-map-adjustments, (allout-setup-mode-map): Establish - allout-mode keymaps as user customizable settings, and also - establish a customizable setting which regulates whether or not a - trailing control-h is reserved for use with - describe-prefix-bindings - and inihibit it by default, so that - control-h *is* reserved for describe-prefix-bindings unless the - user changes this setting. + * allout.el (allout-keybindings, allout-bind-keys) + (allout-keybindings-binding, allout-prefixed-keybindings) + (allout-unprefixed-keybindings, allout-preempt-trailing-ctrl-h) + (allout-keybindings-list, allout-mode-map-adjustments) + (allout-setup-mode-map): Establish allout-mode keymaps as user + customizable settings, and also establish a customizable setting which + regulates whether or not a trailing control-h is reserved for use with + describe-prefix-bindings - and inhibit it by default, so that control-h + *is* reserved for describe-prefix-bindings unless the user changes it. - (allout-hotspot-key-handler): Distinguish more explicitly and - accurately between modified and unmodified events, and handle + * allout.el (allout-hotspot-key-handler): Distinguish more explicitly + and accurately between modified and unmodified events, and handle modified events more comprehensively. - (allout-substring-no-properties): Alias to use or provide version - of 'substring-no-properties'. - (allout-solicit-alternate-bullet): Use - 'allout-substring-no-properties'. - - (allout-next-single-char-property-change): Alias to use or provide - version of 'next-single-char-property-change'. - (allout-annotate-hidden), (allout-hide-by-annotation): Use - 'allout-next-single-char-property-change'. - - (allout-select-safe-coding-system): Alias to use or provide - version of 'select-safe-coding-system'. - (allout-toggle-subtree-encryption): Use - 'allout-select-safe-coding-system'. - - (allout-set-buffer-multibyte): Alias to use or provide version of - 'set-buffer-multibyte'. - (allout-encrypt-string): Use 'allout-set-buffer-multibyte'. - - (allout-called-interactively-p): Macro for using the different - versions of called-interactively-p identically, depending on the - subroutine's argument signature. - - (allout-back-to-current-heading), (allout-beginning-of-current-entry) - - use '(interactive "p")' instead of '(called-interactively-p)'. - - (allout-init), (allout-ascend), (allout-end-of-level), - (allout-previous-visible-heading), (allout-forward-current-level), - (allout-backward-current-level), (allout-show-children) - use - '(allout-called-interactively-p)' instead of - '(called-interactively-p)'. - - (allout-before-change-handler): Exempt edits to the (overlaid) - character after the allout outline bullet from edit confirmation - prompt. - - (allout-add-resumptions): Ensure that it respects correct buffer - for keybindings. - - (allout-beginning-of-line): Use - 'allout-previous-single-char-property-change' alias for the sake - of diverse compatibility. - - (allout-end-of-line): Use 'allout-mark-active-p' to encapsulate - respect for mark activity. - + * allout.el (allout-substring-no-properties): + Alias to use or provide version of `substring-no-properties'. + (allout-solicit-alternate-bullet): Use `allout-substring-no-properties'. + + * allout.el (allout-next-single-char-property-change): + Alias to use or provide version of `next-single-char-property-change'. + (allout-annotate-hidden, allout-hide-by-annotation): + Use `allout-next-single-char-property-change'. + + * allout.el (allout-select-safe-coding-system): + Alias to use or provide version of `select-safe-coding-system'. + (allout-toggle-subtree-encryption): + Use `allout-select-safe-coding-system'. + + * allout.el (allout-set-buffer-multibyte): + Alias to use or provide version of `set-buffer-multibyte'. + (allout-encrypt-string): Use `allout-set-buffer-multibyte'. + + * allout.el (allout-called-interactively-p): Macro for using the + different versions of called-interactively-p identically, depending on + the subroutine's argument signature. + (allout-back-to-current-heading, allout-beginning-of-current-entry): + Use `(interactive "p")' instead of `(called-interactively-p)'. + + * allout.el (allout-init, allout-ascend, allout-end-of-level) + (allout-previous-visible-heading, allout-forward-current-level) + (allout-backward-current-level, allout-show-children): + Use `allout-called-interactively-p' instead of `called-interactively-p'. + + * allout.el (allout-before-change-handler): + Exempt edits to the (overlaid) character after the allout outline + bullet from edit confirmation prompt. + + * allout.el (allout-add-resumptions): + Ensure that it respects correct buffer for keybindings. + + * allout.el (allout-beginning-of-line): + Use `allout-previous-single-char-property-change' alias for the sake of + diverse compatibility. + + * allout.el (allout-end-of-line): + Use `allout-mark-active-p' to encapsulate respect for mark activity. 2010-11-13 Chong Yidong ------------------------------------------------------------ revno: 102382 committer: Ken Manheimer branch nick: trunk timestamp: Sat 2010-11-13 17:30:10 -0500 message: (allout-keybindings), (allout-bind-keys), (allout-keybindings-binding), allout-prefixed-keybindings, allout-unprefixed-keybindings, allout-preempt-trailing-ctrl-h, allout-keybindings-list, allout-mode-map-adjustments, (allout-setup-mode-map): Establish allout-mode keymaps as user customizable settings, and also establish a customizable setting which regulates whether or not a trailing control-h is reserved for use with describe-prefix-bindings - and inihibit it by default, so that control-h *is* reserved for describe-prefix-bindings unless the user changes this setting. (allout-hotspot-key-handler): Distinguish more explicitly and accurately between modified and unmodified events, and handle modified events more comprehensively. (allout-substring-no-properties): Alias to use or provide version of 'substring-no-properties'. (allout-solicit-alternate-bullet): Use 'allout-substring-no-properties'. (allout-next-single-char-property-change): Alias to use or provide version of 'next-single-char-property-change'. (allout-annotate-hidden), (allout-hide-by-annotation): Use 'allout-next-single-char-property-change'. (allout-select-safe-coding-system): Alias to use or provide version of 'select-safe-coding-system'. (allout-toggle-subtree-encryption): Use 'allout-select-safe-coding-system'. (allout-set-buffer-multibyte): Alias to use or provide version of 'set-buffer-multibyte'. (allout-encrypt-string): Use 'allout-set-buffer-multibyte'. (allout-called-interactively-p): Macro for using the different versions of called-interactively-p identically, depending on the subroutine's argument signature. (allout-back-to-current-heading), (allout-beginning-of-current-entry) - use '(interactive "p")' instead of '(called-interactively-p)'. (allout-init), (allout-ascend), (allout-end-of-level), (allout-previous-visible-heading), (allout-forward-current-level), (allout-backward-current-level), (allout-show-children) - use '(allout-called-interactively-p)' instead of '(called-interactively-p)'. (allout-before-change-handler): Exempt edits to the (overlaid) character after the allout outline bullet from edit confirmation prompt. (allout-add-resumptions): Ensure that it respects correct buffer for keybindings. (allout-beginning-of-line): Use 'allout-previous-single-char-property-change' alias for the sake of diverse compatibility. (allout-end-of-line): Use 'allout-mark-active-p' to encapsulate respect for mark activity. substitute "???" for "XXX" for non-urgent comment remarks. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-11-13 18:34:02 +0000 +++ lisp/ChangeLog 2010-11-13 22:30:10 +0000 @@ -1,3 +1,83 @@ +2010-11-13 Ken Manheimer + + Another omnibus checkin of a backlog of fixes. (Now that i'm + using bzr i should be able to interact with the gnu version + control repository in smaller, properly incremental steps, from + here on.) + + This main features of the changes here are: + + - implement user customization for the allout key bindings + - add a customization control by which the user can inhibit use of + a trailing Ctl-H, so by default it's reserved for use with + describe-prefix-bindings + - adapt to new version of called-interactively-p, while + maintaining backwards compatability with old version + - fix hotspot navigation so i works properly with meta-modified keys + + + allout.el (allout-keybindings), (allout-bind-keys), + (allout-keybindings-binding), allout-prefixed-keybindings, + allout-unprefixed-keybindings, allout-preempt-trailing-ctrl-h, + allout-keybindings-list, + allout-mode-map-adjustments, (allout-setup-mode-map): Establish + allout-mode keymaps as user customizable settings, and also + establish a customizable setting which regulates whether or not a + trailing control-h is reserved for use with + describe-prefix-bindings - and inihibit it by default, so that + control-h *is* reserved for describe-prefix-bindings unless the + user changes this setting. + + (allout-hotspot-key-handler): Distinguish more explicitly and + accurately between modified and unmodified events, and handle + modified events more comprehensively. + + (allout-substring-no-properties): Alias to use or provide version + of 'substring-no-properties'. + (allout-solicit-alternate-bullet): Use + 'allout-substring-no-properties'. + + (allout-next-single-char-property-change): Alias to use or provide + version of 'next-single-char-property-change'. + (allout-annotate-hidden), (allout-hide-by-annotation): Use + 'allout-next-single-char-property-change'. + + (allout-select-safe-coding-system): Alias to use or provide + version of 'select-safe-coding-system'. + (allout-toggle-subtree-encryption): Use + 'allout-select-safe-coding-system'. + + (allout-set-buffer-multibyte): Alias to use or provide version of + 'set-buffer-multibyte'. + (allout-encrypt-string): Use 'allout-set-buffer-multibyte'. + + (allout-called-interactively-p): Macro for using the different + versions of called-interactively-p identically, depending on the + subroutine's argument signature. + + (allout-back-to-current-heading), (allout-beginning-of-current-entry) + - use '(interactive "p")' instead of '(called-interactively-p)'. + + (allout-init), (allout-ascend), (allout-end-of-level), + (allout-previous-visible-heading), (allout-forward-current-level), + (allout-backward-current-level), (allout-show-children) - use + '(allout-called-interactively-p)' instead of + '(called-interactively-p)'. + + (allout-before-change-handler): Exempt edits to the (overlaid) + character after the allout outline bullet from edit confirmation + prompt. + + (allout-add-resumptions): Ensure that it respects correct buffer + for keybindings. + + (allout-beginning-of-line): Use + 'allout-previous-single-char-property-change' alias for the sake + of diverse compatibility. + + (allout-end-of-line): Use 'allout-mark-active-p' to encapsulate + respect for mark activity. + + 2010-11-13 Chong Yidong * frame.el (frame-notice-user-settings): Don't clobber other === modified file 'lisp/allout.el' --- lisp/allout.el 2010-11-09 05:33:07 +0000 +++ lisp/allout.el 2010-11-13 22:30:10 +0000 @@ -1,7 +1,7 @@ ;;; allout.el --- extensive outline mode for use alone and with other modes -;; Copyright (C) 1992, 1993, 1994, 2001, 2002, 2003, 2004, 2005, 2006, -;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1992, 1993, 1994, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Ken Manheimer ;; Maintainer: Ken Manheimer @@ -98,21 +98,142 @@ ;;;_* USER CUSTOMIZATION VARIABLES: -;;;_ > defgroup allout +;;;_ > defgroup allout, allout-keybindings (defgroup allout nil "Extensive outline mode for use alone and with other modes." :prefix "allout-" :group 'outlines) +(defgroup allout-keybindings nil + "Allout outline mode keyboard bindings configuration." + :group 'allout) ;;;_ + Layout, Mode, and Topic Header Configuration -;;;_ = allout-command-prefix +;;;_ > allout-keybindings incidentals: +;;;_ > allout-bind-keys &optional varname value +(defun allout-bind-keys (&optional varname value) + "Rebuild the `allout-mode-map' according to the keybinding specs. + +Useful standalone, to init the map, or in customizing the +respective allout-mode keybinding variables, `allout-command-prefix', +`allout-prefixed-keybindings', and `allout-unprefixed-keybindings'" + ;; Set the customization variable, if any: + (when varname + (set-default varname value)) + (let ((map (make-sparse-keymap)) + key) + (when (boundp 'allout-prefixed-keybindings) + ;; Be tolerant of the moments when the variables are first being defined. + (dolist (entry allout-prefixed-keybindings) + (define-key map + ;; XXX vector vs non-vector key descriptions? + (vconcat allout-command-prefix + (car (read-from-string (car entry)))) + (cadr entry)))) + (when (boundp 'allout-unprefixed-keybindings) + (dolist (entry allout-unprefixed-keybindings) + (define-key map (car (read-from-string (car entry))) (cadr entry)))) + (setq allout-mode-map map) + map + )) +;;;_ = allout-command-prefix (defcustom allout-command-prefix "\C-c " "Key sequence to be used as prefix for outline mode command key bindings. Default is '\C-c'; just '\C-c' is more short-and-sweet, if you're willing to let allout use a bunch of \C-c keybindings." :type 'string + :group 'allout-keybindings + :set 'allout-bind-keys) +;;;_ = allout-keybindings-binding +(define-widget 'allout-keybindings-binding 'lazy + "Structure of allout keybindings customization items." + :type '(repeat + (list (string :tag "Key" :value "[(meta control shift ?f)]") + (function :tag "Function name" + :value allout-forward-current-level)))) +;;;_ = allout-prefixed-keybindings +(defcustom allout-prefixed-keybindings + '(("[(control ?n)]" allout-next-visible-heading) + ("[(control ?p)]" allout-previous-visible-heading) +;; ("[(control ?u)]" allout-up-current-level) + ("[(control ?f)]" allout-forward-current-level) + ("[(control ?b)]" allout-backward-current-level) + ("[(control ?a)]" allout-beginning-of-current-entry) + ("[(control ?e)]" allout-end-of-entry) + ("[(control ?i)]" allout-show-children) + ("[(control ?i)]" allout-show-children) + ("[(control ?s)]" allout-show-current-subtree) + ("[(control ?t)]" allout-toggle-current-subtree-exposure) + ("[(control ?h)]" allout-hide-current-subtree) + ("[?h]" allout-hide-current-subtree) + ("[(control ?o)]" allout-show-current-entry) + ("[?!]" allout-show-all) + ("[?x]" allout-toggle-current-subtree-encryption) + ("[? ]" allout-open-sibtopic) + ("[?.]" allout-open-subtopic) + ("[?,]" allout-open-supertopic) + ("[?']" allout-shift-in) + ("[?>]" allout-shift-in) + ("[?<]" allout-shift-out) + ("[(control ?m)]" allout-rebullet-topic) + ("[?*]" allout-rebullet-current-heading) + ("[?']" allout-number-siblings) + ("[(control ?k)]" allout-kill-topic) + ("[??]" allout-copy-topic-as-kill) + ("[?@]" allout-resolve-xref) + ("[?=?c]" allout-copy-exposed-to-buffer) + ("[?=?i]" allout-indented-exposed-to-buffer) + ("[?=?t]" allout-latexify-exposed) + ("[?=?p]" allout-flatten-exposed-to-buffer) + ) + "Allout-mode key bindings that are prefixed with `allout-command-prefix'. + +See `allout-unprefixed-keybindings' for the list of keybindings +that are not prefixed. + +Use vector format for the keys: + - put literal keys after a '?' question mark, eg: '?a', '?.' + - enclose control, shift, or meta-modified keys as sequences within + parentheses, with the literal key, as above, preceded by the name(s) + of the modifers, eg: [(control ?a)] +See the existing keys for examples. + +Functions can be bound to multiple keys, but binding keys to +multiple functions will not work - the last binding for a key +prevails." + :type 'allout-keybindings-binding + :group 'allout-keybindings + :set 'allout-bind-keys + ) +;;;_ = allout-unprefixed-keybindings +(defcustom allout-unprefixed-keybindings + '(("[(control ?k)]" allout-kill-line) + ("[??(meta ?k)]" allout-copy-line-as-kill) + ("[(control ?y)]" allout-yank) + ("[??(meta ?y)]" allout-yank-pop) + ) + "Allout-mode functions bound to keys without any added prefix. + +This is in contrast to the majority of allout-mode bindings on +`allout-prefixed-bindings', whose bindings are created with a +preceeding command key. + +Use vector format for the keys: + - put literal keys after a '?' question mark, eg: '?a', '?.' + - enclose control, shift, or meta-modified keys as sequences within + parentheses, with the literal key, as above, preceded by the name(s) + of the modifers, eg: [(control ?a)] +See the existing keys for examples." + :type 'allout-keybindings-binding + :group 'allout-keybindings + :set 'allout-bind-keys + ) + +;;;_ = allout-preempt-trailing-ctrl-h +(defcustom allout-preempt-trailing-ctrl-h nil + "Use -\C-h, instead of leaving it for describe-prefix-bindings?" + :type 'boolean :group 'allout) ;;;_ = allout-keybindings-list @@ -133,9 +254,13 @@ ("\C-a" allout-beginning-of-current-entry) ("\C-e" allout-end-of-entry) ; Exposure commands: - ("\C-i" allout-show-children) + ([(control i)] allout-show-children) ; xemacs translates "\C-i" to tab + ("\C-i" allout-show-children) ; but we still need this for hotspot ("\C-s" allout-show-current-subtree) - ("\C-h" allout-hide-current-subtree) + ;; binding to \C-h is included if allout-preempt-trailing-ctrl-h, + ;; so user controls whether or not to preempt the conventional ^H + ;; binding to help-command. + ("\C-h" allout-hide-current-subtree) ("\C-t" allout-toggle-current-subtree-exposure) ("h" allout-hide-current-subtree) ("\C-o" allout-show-current-entry) @@ -753,7 +878,7 @@ ;;;_ + Developer ;;;_ = allout-developer group (defgroup allout-developer nil - "Settings for topic encryption features of allout outliner." + "Allout settings developers care about, including topic encryption and more." :group 'allout) ;;;_ = allout-run-unit-tests-on-load (defcustom allout-run-unit-tests-on-load nil @@ -1163,6 +1288,13 @@ (car (cdr cell))))))) keymap-list) map)) +;;;_ > allout-mode-map-adjustments (base-map) +(defun allout-mode-map-adjustments (base-map) + "Do conditional additions to specified base-map, like inclusion of \\C-h." + (if allout-preempt-trailing-ctrl-h + (cons '("\C-h" allout-hide-current-subtree) base-map) + base-map) + ) ;;;_ : Menu bar (defvar allout-mode-exposure-menu) (defvar allout-mode-editing-menu) @@ -1278,7 +1410,7 @@ (void-variable nil))) (when (not (assoc name allout-mode-prior-settings)) ;; Not already added as a resumption, create the prior setting entry. - (if (local-variable-p name) + (if (local-variable-p name (current-buffer)) ;; is already local variable -- preserve the prior value: (push (list name prior-value) allout-mode-prior-settings) ;; wasn't local variable, indicate so for resumption by killing @@ -1541,6 +1673,14 @@ (goto-char (cadr allout-after-save-decrypt)) (setq allout-after-save-decrypt nil)) ) +;;;_ > allout-called-interactively-p () +(defmacro allout-called-interactively-p () + "A version of called-interactively-p independent of emacs version." + ;; ... to ease maintenance of allout without betraying deprecation. + (if (equal (subr-arity (symbol-function 'called-interactively-p)) + '(0 . 0)) + '(called-interactively-p) + '(called-interactively-p 'interactive))) ;;;_ = allout-inhibit-aberrance-doublecheck nil ;; In some exceptional moments, disparate topic depths need to be allowed ;; momentarily, eg when one topic is being yanked into another and they're @@ -1554,7 +1694,7 @@ This should only be momentarily let-bound non-nil, not set non-nil in a lasting way.") -;;;_ #2 Mode activation +;;;_ #2 Mode environment and activation ;;;_ = allout-explicitly-deactivated (defvar allout-explicitly-deactivated nil "If t, `allout-mode's last deactivation was deliberate. @@ -1590,7 +1730,7 @@ \(allout-init t)" (interactive) - (if (called-interactively-p 'interactive) + (if (allout-called-interactively-p) (progn (setq mode (completing-read @@ -1614,7 +1754,7 @@ (cond ((not mode) (set find-file-hook-var-name (delq hook (symbol-value find-file-hook-var-name))) - (if (called-interactively-p 'interactive) + (if (allout-called-interactively-p) (message "Allout outline mode auto-activation inhibited."))) ((eq mode 'report) (if (not (memq hook (symbol-value find-file-hook-var-name))) @@ -1656,7 +1796,7 @@ (setplist 'allout-exposure-category nil) (put 'allout-exposure-category 'invisible 'allout) (put 'allout-exposure-category 'evaporate t) - ;; XXX We use isearch-open-invisible *and* isearch-mode-end-hook. The + ;; ??? We use isearch-open-invisible *and* isearch-mode-end-hook. The ;; latter would be sufficient, but it seems that a separate behavior -- ;; the _transient_ opening of invisible text during isearch -- is keyed to ;; presence of the isearch-open-invisible property -- even though this @@ -2116,9 +2256,11 @@ (defun allout-setup-mode-map () "Establish allout-mode bindings." (setq-default allout-mode-map - (produce-allout-mode-map allout-keybindings-list)) + (produce-allout-mode-map + (allout-mode-map-adjustments allout-keybindings-list))) (setq allout-mode-map - (produce-allout-mode-map allout-keybindings-list)) + (produce-allout-mode-map + (allout-mode-map-adjustments allout-keybindings-list))) (substitute-key-definition 'beginning-of-line 'allout-beginning-of-line allout-mode-map global-map) @@ -2153,7 +2295,7 @@ ;;;_ - Position Assessment ;;;_ > allout-hidden-p (&optional pos) (defsubst allout-hidden-p (&optional pos) - "Non-nil if the character after point is invisible." + "Non-nil if the character after point was made invisible by allout." (eq (get-char-property (or pos (point)) 'invisible) 'allout)) ;;;_ > allout-overlay-insert-in-front-handler (ol after beg end @@ -2162,8 +2304,8 @@ &optional prelen) "Shift the overlay so stuff inserted in front of it is excluded." (if after - ;; XXX Shouldn't moving the overlay should be unnecessary, if overlay - ;; front-advance on the overlay worked as it should? + ;; ??? Shouldn't moving the overlay should be unnecessary, if overlay + ;; front-advance on the overlay worked as expected? (move-overlay ol (1+ beg) (overlay-end ol)))) ;;;_ > allout-overlay-interior-modification-handler (ol after beg end ;;; &optional prelen) @@ -2225,8 +2367,9 @@ (save-excursion (goto-char beg) (let ((overlay (allout-get-invisibility-overlay))) - (allout-overlay-interior-modification-handler - overlay nil beg end nil))))) + (if overlay + (allout-overlay-interior-modification-handler + overlay nil beg end nil)))))) ;;;_ > allout-isearch-end-handler (&optional overlay) (defun allout-isearch-end-handler (&optional overlay) "Reconcile allout outline exposure on arriving in hidden text after isearch. @@ -2508,7 +2651,7 @@ ;;;_ > allout-end-of-current-line () (defun allout-end-of-current-line () "Move to the end of line, past concealed text if any." - ;; XXX This is for symmetry with `allout-beginning-of-current-line' -- + ;; This is for symmetry with `allout-beginning-of-current-line' -- ;; `move-end-of-line' doesn't suffer the same problem as ;; `move-beginning-of-line'. (let ((inhibit-field-text-motion t)) @@ -2527,7 +2670,7 @@ (progn (if (and (not (bolp)) (allout-hidden-p (1- (point)))) - (goto-char (previous-single-char-property-change + (goto-char (allout-previous-single-char-property-change (1- (point)) 'invisible))) (move-beginning-of-line 1)) (allout-depth) @@ -2573,9 +2716,20 @@ (allout-back-to-current-heading) (allout-end-of-current-line)) (t - (if (not (and transient-mark-mode mark-active)) + (if (not (allout-mark-active-p)) (push-mark)) (allout-end-of-entry)))))) +;;;_ > allout-mark-active-p () +(defun allout-mark-active-p () + "True if the mark is currently or always active." + ;; `(cond (boundp...))' (or `(if ...)') invokes special byte-compiler + ;; provisions, at least in fsf emacs to prevent warnings about lack of, + ;; eg, region-active-p. + (cond ((boundp 'mark-active) + mark-active) + ((fboundp 'region-active-p) + (region-active-p)) + (t))) ;;;_ > allout-next-heading () (defsubst allout-next-heading () "Move to the heading for the topic (possibly invisible) after this one. @@ -2888,8 +3042,8 @@ (if (not (allout-current-depth)) nil (1- allout-recent-prefix-end))) -;;;_ > allout-back-to-current-heading () -(defun allout-back-to-current-heading () +;;;_ > allout-back-to-current-heading (&optional interactive) +(defun allout-back-to-current-heading (&optional interactive) "Move to heading line of current topic, or beginning if not in a topic. If interactive, we position at the end of the prefix. @@ -2897,11 +3051,13 @@ Return value of resulting point, unless we started outside of (before any) topics, in which case we return nil." + (interactive "p") + (allout-beginning-of-current-line) (let ((bol-point (point))) (if (allout-goto-prefix-doublechecked) (if (<= (point) bol-point) - (if (called-interactively-p 'interactive) + (if interactive (allout-end-of-prefix) (point)) (goto-char (point-min)) @@ -2955,20 +3111,20 @@ Returns the value of point." (interactive) (allout-end-of-subtree t include-trailing-blank)) -;;;_ > allout-beginning-of-current-entry () -(defun allout-beginning-of-current-entry () +;;;_ > allout-beginning-of-current-entry (&optional interactive) +(defun allout-beginning-of-current-entry (&optional interactive) "When not already there, position point at beginning of current topic header. If already there, move cursor to bullet for hot-spot operation. \(See `allout-mode' doc string for details of hot-spot operation.)" - (interactive) + (interactive "p") (let ((start-point (point))) (move-beginning-of-line 1) (if (< 0 (allout-current-depth)) (goto-char allout-recent-prefix-end) (goto-char (point-min))) (allout-end-of-prefix) - (if (and (called-interactively-p 'interactive) + (if (and interactive (= (point) start-point)) (goto-char (allout-current-bullet-pos))))) ;;;_ > allout-end-of-entry (&optional inclusive) @@ -3018,9 +3174,9 @@ (while (and (< depth allout-recent-depth) (setq last-ascended (allout-ascend)))) (goto-char allout-recent-prefix-beginning) - (if (called-interactively-p 'interactive) (allout-end-of-prefix)) + (if (allout-called-interactively-p) (allout-end-of-prefix)) (and last-ascended allout-recent-depth)))) -;;;_ > allout-ascend () +;;;_ > allout-ascend (&optional dont-move-if-unsuccessful) (defun allout-ascend (&optional dont-move-if-unsuccessful) "Ascend one level, returning resulting depth if successful, nil if not. @@ -3046,7 +3202,7 @@ (goto-char bolevel) (allout-depth) nil)))) - (if (called-interactively-p 'interactive) (allout-end-of-prefix)))) + (if (allout-called-interactively-p) (allout-end-of-prefix)))) ;;;_ > allout-descend-to-depth (depth) (defun allout-descend-to-depth (depth) "Descend to depth DEPTH within current topic. @@ -3074,7 +3230,7 @@ (if (not (allout-ascend)) (progn (goto-char start-point) (error "Can't ascend past outermost level")) - (if (called-interactively-p 'interactive) (allout-end-of-prefix)) + (if (allout-called-interactively-p) (allout-end-of-prefix)) allout-recent-prefix-beginning))) ;;;_ - Linear @@ -3219,7 +3375,7 @@ (let ((depth (allout-depth))) (while (allout-previous-sibling depth nil)) (prog1 allout-recent-depth - (if (called-interactively-p 'interactive) (allout-end-of-prefix))))) + (if (allout-called-interactively-p) (allout-end-of-prefix))))) ;;;_ > allout-next-visible-heading (arg) (defun allout-next-visible-heading (arg) "Move to the next ARG'th visible heading line, backward if arg is negative. @@ -3272,7 +3428,7 @@ matches)." (interactive "p") (prog1 (allout-next-visible-heading (- arg)) - (if (called-interactively-p 'interactive) (allout-end-of-prefix)))) + (if (allout-called-interactively-p) (allout-end-of-prefix)))) ;;;_ > allout-forward-current-level (arg) (defun allout-forward-current-level (arg) "Position point at the next heading of the same level. @@ -3293,7 +3449,7 @@ (allout-previous-sibling) (allout-next-sibling))) (setq arg (1- arg))) - (if (not (called-interactively-p 'interactive)) + (if (not (allout-called-interactively-p)) nil (allout-end-of-prefix) (if (not (zerop arg)) @@ -3306,7 +3462,7 @@ (defun allout-backward-current-level (arg) "Inverse of `allout-forward-current-level'." (interactive "p") - (if (called-interactively-p 'interactive) + (if (allout-called-interactively-p) (let ((current-prefix-arg (* -1 arg))) (call-interactively 'allout-forward-current-level)) (allout-forward-current-level (* -1 arg)))) @@ -3391,8 +3547,10 @@ Returns the qualifying command, if any, else nil." (interactive) - (let* ((key-string (if (numberp last-command-event) - (char-to-string last-command-event))) + (let* ((modified (event-modifiers last-command-event)) + (key-string (if (numberp last-command-event) + (char-to-string + (event-basic-type last-command-event)))) (key-num (cond ((numberp last-command-event) last-command-event) ;; for XEmacs character type: ((and (fboundp 'characterp) @@ -3406,6 +3564,7 @@ (if (and ;; exclude control chars and escape: + (not modified) (<= 33 key-num) (setq mapped-binding (or (and (assoc key-string allout-keybindings-list) @@ -3413,22 +3572,22 @@ (cadr (assoc key-string allout-keybindings-list))) ;; translate as a keybinding: (key-binding (vconcat allout-command-prefix - (char-to-string - (if (and (<= 97 key-num) ; "a" - (>= 122 key-num)) ; "z" - (- key-num 96) key-num))) + (vector + (if (and (<= 97 key-num) ; "a" + (>= 122 key-num)) ; "z" + (- key-num 96) key-num))) t)))) ;; Qualified as an allout command -- do hot-spot operation. (setq allout-post-goto-bullet t) - ;; accept-defaults nil, or else we'll get allout-item-icon-key-handler. - (setq mapped-binding (key-binding (char-to-string key-num)))) + ;; accept-defaults nil, or else we get allout-item-icon-key-handler. + (setq mapped-binding (key-binding (vector key-num)))) (while (keymapp mapped-binding) (setq mapped-binding (lookup-key mapped-binding (vector (read-char))))) - (if mapped-binding - (setq this-command mapped-binding))))) + (when mapped-binding + (setq this-command mapped-binding))))) ;;;_ > allout-find-file-hook () (defun allout-find-file-hook () @@ -3457,7 +3616,7 @@ (setq choice (solicit-char-in-string (format "Select bullet: %s ('%s' default): " sans-escapes - (substring-no-properties default-bullet)) + (allout-substring-no-properties default-bullet)) sans-escapes t))) (message "") @@ -4455,9 +4614,9 @@ (if (not (allout-hidden-p)) (setq next (max (1+ (point)) - (next-single-char-property-change (point) - 'invisible - nil end)))) + (allout-next-single-char-property-change (point) + 'invisible + nil end)))) (if (or (not next) (eq prev next)) ;; still not at start of hidden area -- must not be any left. (setq done t) @@ -4496,9 +4655,8 @@ (while (not done) ;; at or advance to start of next annotation: (if (not (get-text-property (point) 'allout-was-hidden)) - (setq next (next-single-char-property-change (point) - 'allout-was-hidden - nil end))) + (setq next (allout-next-single-char-property-change + (point) 'allout-was-hidden nil end))) (if (or (not next) (eq prev next)) ;; no more or not advancing -- must not be any left. (setq done t) @@ -4508,9 +4666,8 @@ ;; still not at start of annotation. (setq done t) ;; advance to just after end of this annotation: - (setq next (next-single-char-property-change (point) - 'allout-was-hidden - nil end)) + (setq next (allout-next-single-char-property-change + (point) 'allout-was-hidden nil end)) (overlay-put (make-overlay prev next nil 'front-advance) 'category 'allout-exposure-category) (allout-deannotate-hidden prev next) @@ -4766,7 +4923,10 @@ (when (featurep 'xemacs) (let ((props (symbol-plist 'allout-exposure-category))) (while props - (overlay-put o (pop props) (pop props))))))) + (condition-case nil + ;; as of 2008-02-27, xemacs lacks modification-hooks + (overlay-put o (pop props) (pop props)) + (error nil))))))) (run-hooks 'allout-view-change-hook) (run-hook-with-args 'allout-exposure-change-hook from to flag)) ;;;_ > allout-flag-current-subtree (flag) @@ -4845,7 +5005,7 @@ (to-reveal (or (allout-chart-to-reveal chart chart-level) ;; interactive, show discontinuous children: (and chart - (called-interactively-p 'interactive) + (allout-called-interactively-p) (save-excursion (allout-back-to-current-heading) (setq depth (allout-current-depth)) @@ -5672,7 +5832,8 @@ (let ((inhibit-field-text-motion t)) (beginning-of-line) (let ((beg (point)) - (end (point-at-eol))) + (end (progn (end-of-line)(point)))) + (goto-char beg) (save-match-data (while (re-search-forward "\\\\" ;;"\\\\\\|\\{\\|\\}\\|\\_\\|\\$\\|\\\"\\|\\&\\|\\^\\|\\-\\|\\*\\|#" @@ -5975,7 +6136,7 @@ ;; they're encrypted, so the coding system is set to accommodate ;; them. (setq buffer-file-coding-system - (select-safe-coding-system subtree-beg subtree-end)) + (allout-select-safe-coding-system subtree-beg subtree-end)) ;; if the coding system for the text being encrypted is different ;; than that prevailing, then there a real risk that the coding ;; system can't be noticed by emacs when the file is visited. to @@ -6118,7 +6279,7 @@ (insert text) ;; convey the text characteristics of the original buffer: - (set-buffer-multibyte multibyte) + (allout-set-buffer-multibyte multibyte) (when encoding (set-buffer-file-coding-system encoding) (if (not decrypt) @@ -6830,6 +6991,14 @@ ((atom (car list)) (cons (car list) (allout-flatten (cdr list)))) (t (append (allout-flatten (car list)) (allout-flatten (cdr list)))))) ;;;_ : Compatibility: +;;;_ : xemacs undo-in-progress provision: +(unless (boundp 'undo-in-progress) + (defvar undo-in-progress nil + "Placeholder defvar for XEmacs compatibility from allout.el.") + (defadvice undo-more (around allout activate) + ;; This defadvice used only in emacs that lack undo-in-progress, eg xemacs. + (let ((undo-in-progress t)) ad-do-it))) + ;;;_ > allout-mark-marker to accommodate divergent emacsen: (defun allout-mark-marker (&optional force buffer) "Accommodate the different signature for `mark-marker' across Emacsen. @@ -6990,6 +7159,42 @@ (setq arg 1) (setq done t))))))) ) +;;;_ > allout-next-single-char-property-change -- alias unless lacking +(defalias 'allout-next-single-char-property-change + (if (fboundp 'next-single-char-property-change) + 'next-single-char-property-change + 'next-single-property-change) + ;; No docstring because xemacs defalias doesn't support it. + ) +;;;_ > allout-previous-single-char-property-change -- alias unless lacking +(defalias 'allout-previous-single-char-property-change + (if (fboundp 'previous-single-char-property-change) + 'previous-single-char-property-change + 'previous-single-property-change) + ;; No docstring because xemacs defalias doesn't support it. + ) +;;;_ > allout-set-buffer-multibyte +;; define as alias first, so byte compiler is happy. +(defalias 'allout-set-buffer-multibyte 'set-buffer-multibyte) +;; then supplant with definition if underlying alias absent. +(if (not (fboundp 'set-buffer-multibyte)) + (defun allout-set-buffer-multibyte (is-multibyte) + (setq enable-multibyte-characters is-multibyte)) + ) +;;;_ > allout-select-safe-coding-system +(defalias 'allout-select-safe-coding-system + (if (fboundp 'select-safe-coding-system) + 'select-safe-coding-system + 'detect-coding-region) + ) +;;;_ > allout-substring-no-properties +;; define as alias first, so byte compiler is happy. +(defalias 'allout-substring-no-properties 'substring-no-properties) +;; then supplant with definition if underlying alias absent. +(if (not (fboundp 'substring-no-properties)) + (defun allout-substring-no-properties (string &optional start end) + (substring string (or start 0) end)) + ) ;;;_ #10 Unfinished ;;;_ > allout-bullet-isearch (&optional bullet) @@ -7021,7 +7226,7 @@ ;;;_ > allout-tests-obliterate-variable (name) (defun allout-tests-obliterate-variable (name) "Completely unbind variable with NAME." - (if (local-variable-p name) (kill-local-variable name)) + (if (local-variable-p name (current-buffer)) (kill-local-variable name)) (while (boundp name) (makunbound name))) ;;;_ > allout-test-resumptions () (defvar allout-tests-globally-unbound nil @@ -7040,11 +7245,12 @@ (allout-tests-obliterate-variable 'allout-tests-globally-unbound) (allout-add-resumptions '(allout-tests-globally-unbound t)) (assert (not (default-boundp 'allout-tests-globally-unbound))) - (assert (local-variable-p 'allout-tests-globally-unbound)) + (assert (local-variable-p 'allout-tests-globally-unbound (current-buffer))) (assert (boundp 'allout-tests-globally-unbound)) (assert (equal allout-tests-globally-unbound t)) (allout-do-resumptions) - (assert (not (local-variable-p 'allout-tests-globally-unbound))) + (assert (not (local-variable-p 'allout-tests-globally-unbound + (current-buffer)))) (assert (not (boundp 'allout-tests-globally-unbound)))) ;; ensure that variable with prior global value is resumed @@ -7053,10 +7259,11 @@ (setq allout-tests-globally-true t) (allout-add-resumptions '(allout-tests-globally-true nil)) (assert (equal (default-value 'allout-tests-globally-true) t)) - (assert (local-variable-p 'allout-tests-globally-true)) + (assert (local-variable-p 'allout-tests-globally-true (current-buffer))) (assert (equal allout-tests-globally-true nil)) (allout-do-resumptions) - (assert (not (local-variable-p 'allout-tests-globally-true))) + (assert (not (local-variable-p 'allout-tests-globally-true + (current-buffer)))) (assert (boundp 'allout-tests-globally-true)) (assert (equal allout-tests-globally-true t))) @@ -7067,16 +7274,16 @@ (assert (not (default-boundp 'allout-tests-locally-true)) nil (concat "Test setup mistake -- variable supposed to" " not have global binding, but it does.")) - (assert (local-variable-p 'allout-tests-locally-true) + (assert (local-variable-p 'allout-tests-locally-true (current-buffer)) nil (concat "Test setup mistake -- variable supposed to have" " local binding, but it lacks one.")) (allout-add-resumptions '(allout-tests-locally-true nil)) (assert (not (default-boundp 'allout-tests-locally-true))) - (assert (local-variable-p 'allout-tests-locally-true)) + (assert (local-variable-p 'allout-tests-locally-true (current-buffer))) (assert (equal allout-tests-locally-true nil)) (allout-do-resumptions) (assert (boundp 'allout-tests-locally-true)) - (assert (local-variable-p 'allout-tests-locally-true)) + (assert (local-variable-p 'allout-tests-locally-true (current-buffer))) (assert (equal allout-tests-locally-true t)) (assert (not (default-boundp 'allout-tests-locally-true)))) @@ -7095,22 +7302,24 @@ '(allout-tests-locally-true 4)) ;; reestablish many of the basic conditions are maintained after re-add: (assert (not (default-boundp 'allout-tests-globally-unbound))) - (assert (local-variable-p 'allout-tests-globally-unbound)) + (assert (local-variable-p 'allout-tests-globally-unbound (current-buffer))) (assert (equal allout-tests-globally-unbound 2)) (assert (default-boundp 'allout-tests-globally-true)) - (assert (local-variable-p 'allout-tests-globally-true)) + (assert (local-variable-p 'allout-tests-globally-true (current-buffer))) (assert (equal allout-tests-globally-true 3)) (assert (not (default-boundp 'allout-tests-locally-true))) - (assert (local-variable-p 'allout-tests-locally-true)) + (assert (local-variable-p 'allout-tests-locally-true (current-buffer))) (assert (equal allout-tests-locally-true 4)) (allout-do-resumptions) - (assert (not (local-variable-p 'allout-tests-globally-unbound))) + (assert (not (local-variable-p 'allout-tests-globally-unbound + (current-buffer)))) (assert (not (boundp 'allout-tests-globally-unbound))) - (assert (not (local-variable-p 'allout-tests-globally-true))) + (assert (not (local-variable-p 'allout-tests-globally-true + (current-buffer)))) (assert (boundp 'allout-tests-globally-true)) (assert (equal allout-tests-globally-true t)) (assert (boundp 'allout-tests-locally-true)) - (assert (local-variable-p 'allout-tests-locally-true)) + (assert (local-variable-p 'allout-tests-locally-true (current-buffer))) (assert (equal allout-tests-locally-true t)) (assert (not (default-boundp 'allout-tests-locally-true)))) ------------------------------------------------------------ revno: 102381 committer: Dan Nicolaescu branch nick: trunk timestamp: Sat 2010-11-13 14:20:01 -0800 message: * src/xmenu.c: Make it clear that ../lwlib/lwlib.h is only needed for Motif. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-11-13 22:17:22 +0000 +++ src/ChangeLog 2010-11-13 22:20:01 +0000 @@ -1,7 +1,8 @@ 2010-11-13 Dan Nicolaescu + * xmenu.c: Make it clear that ../lwlib/lwlib.h is only needed for Motif. + Fix compilation on Solaris. - * sysdep.c: Do not #include . (tputs): Add declaration, similar to what cm.c does. (Bug#7178) === modified file 'src/xmenu.c' --- src/xmenu.c 2010-10-30 13:09:52 +0000 +++ src/xmenu.c 2010-11-13 22:20:01 +0000 @@ -89,7 +89,9 @@ #include #endif /* HAVE_XAW3D */ #endif /* USE_LUCID */ +#ifdef USE_MOTIF #include "../lwlib/lwlib.h" +#endif #else /* not USE_X_TOOLKIT */ #ifndef USE_GTK #include "../oldXMenu/XMenu.h" @@ -2581,5 +2583,3 @@ #endif } -/* arch-tag: 92ea573c-398e-496e-ac73-2436f7d63242 - (do not change this comment) */ ------------------------------------------------------------ revno: 102380 committer: Dan Nicolaescu branch nick: trunk timestamp: Sat 2010-11-13 14:17:22 -0800 message: Fix compilation on Solaris. * src/sysdep.c: Do not #include . (tputs): Add declaration, similar to what cm.c does. (Bug#7178) diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-11-13 22:10:34 +0000 +++ src/ChangeLog 2010-11-13 22:17:22 +0000 @@ -1,5 +1,10 @@ 2010-11-13 Dan Nicolaescu + Fix compilation on Solaris. + + * sysdep.c: Do not #include . + (tputs): Add declaration, similar to what cm.c does. (Bug#7178) + * s/ms-w32.h (HAVE_TERMIOS_H): Do not undef, not used anymore. 2010-11-13 Jan Djärv === modified file 'src/sysdep.c' --- src/sysdep.c 2010-10-10 13:44:22 +0000 +++ src/sysdep.c 2010-11-13 22:17:22 +0000 @@ -90,12 +90,6 @@ #include "dispextern.h" #include "process.h" #include "cm.h" /* for reset_sys_modes */ -#ifdef HAVE_TERM_H -/* Include this last. If it is ncurses header file, it adds a lot of - defines that interfere with stuff in other headers. Someone responsible - for ncurses messed up bigtime. See bug#6812. */ -#include -#endif #ifdef WINDOWSNT #include @@ -123,6 +117,9 @@ #endif #endif +/* Declare here, including term.h is problematic on some systems. */ +extern void tputs (const char *, int, int (*)(int)); + static const int baud_convert[] = { 0, 50, 75, 110, 135, 150, 200, 300, 600, 1200, @@ -3071,6 +3068,3 @@ #endif /* !defined (WINDOWSNT) */ - -/* arch-tag: edb43589-4e09-4544-b325-978b5b121dcf - (do not change this comment) */ ------------------------------------------------------------ revno: 102379 committer: Dan Nicolaescu branch nick: trunk timestamp: Sat 2010-11-13 14:10:34 -0800 message: * src/s/ms-w32.h (HAVE_TERMIOS_H): Do not undef, not used anymore. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-11-13 18:59:28 +0000 +++ src/ChangeLog 2010-11-13 22:10:34 +0000 @@ -1,3 +1,7 @@ +2010-11-13 Dan Nicolaescu + + * s/ms-w32.h (HAVE_TERMIOS_H): Do not undef, not used anymore. + 2010-11-13 Jan Djärv * xterm.c (set_wm_state): Don't put Atom in cons, call === modified file 'src/s/ms-w32.h' --- src/s/ms-w32.h 2010-08-22 17:00:08 +0000 +++ src/s/ms-w32.h 2010-11-13 22:10:34 +0000 @@ -112,7 +112,6 @@ #undef HAVE_UTIME_H #undef HAVE_LINUX_VERSION_H #undef HAVE_SYS_SYSTEMINFO_H -#undef HAVE_TERMIOS_H #define HAVE_LIMITS_H 1 #define HAVE_STRING_H 1 #define HAVE_STDLIB_H 1 ------------------------------------------------------------ revno: 102378 committer: Eli Zaretskii branch nick: trunk timestamp: Sat 2010-11-13 22:40:21 +0200 message: mule.texi (Fontsets): Fix xref from last change. diff: === modified file 'doc/emacs/mule.texi' --- doc/emacs/mule.texi 2010-11-13 13:29:31 +0000 +++ doc/emacs/mule.texi 2010-11-13 20:40:21 +0000 @@ -1318,7 +1318,7 @@ code. If a fontset specifies no font for a certain character, or if it specifies a font that does not exist on your system, then it cannot display that character properly. It will display that character as a -hex code or thin space or an empty box instead. (@xref{Text Display, +hex code or thin space or an empty box instead. (@xref{Text Display, , glyphless characters}, for details.) @node Defining Fontsets ------------------------------------------------------------ revno: 102377 committer: Jan D branch nick: trunk timestamp: Sat 2010-11-13 19:59:28 +0100 message: Fix Atoms and Lisp_Object mixup and related bugs. * src/xselect.c (x_send_client_event): Move CHECK_STRING ... (Fx_send_client_event): to here. * src/xterm.c (set_wm_state): Don't put Atom in cons, call make_fixnum_or_float on them first. (x_term_init): Initialize Xatom_net_supporting_wm_check and Xatom_net_supported correctly. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-11-13 18:49:22 +0000 +++ src/ChangeLog 2010-11-13 18:59:28 +0000 @@ -1,3 +1,13 @@ +2010-11-13 Jan Djärv + + * xterm.c (set_wm_state): Don't put Atom in cons, call + make_fixnum_or_float on them first. + (x_term_init): Initialize Xatom_net_supporting_wm_check and + Xatom_net_supported correctly. + + * xselect.c (x_send_client_event): Move CHECK_STRING ... + (Fx_send_client_event): to here. + 2010-11-13 Martin Rudalics * window.c (Fwindow_use_time): New function. === modified file 'src/xselect.c' --- src/xselect.c 2010-11-12 09:31:44 +0000 +++ src/xselect.c 2010-11-13 18:59:28 +0000 @@ -2528,8 +2528,11 @@ { struct x_display_info *dpyinfo = check_x_display_info (display); + CHECK_STRING (message_type); x_send_client_event(display, dest, from, - XInternAtom (dpyinfo->display, SDATA (message_type), False), + XInternAtom (dpyinfo->display, + SDATA (message_type), + False), format, values); return Qnil; @@ -2546,7 +2549,6 @@ struct frame *f = check_x_frame (from); int to_root; - CHECK_STRING (message_type); CHECK_NUMBER (format); CHECK_CONS (values); === modified file 'src/xterm.c' --- src/xterm.c 2010-11-13 13:29:31 +0000 +++ src/xterm.c 2010-11-13 18:59:28 +0000 @@ -8380,8 +8380,9 @@ Fcons (make_number (add ? 1 : 0), Fcons - (atom, - value != 0 ? value : Qnil))); + (make_fixnum_or_float (atom), + value != 0 + ? make_fixnum_or_float (value) : Qnil))); } void @@ -10247,7 +10248,7 @@ { "_NET_WM_ICON_NAME", &dpyinfo->Xatom_net_wm_icon_name }, { "_NET_WM_NAME", &dpyinfo->Xatom_net_wm_name }, { "_NET_SUPPORTED", &dpyinfo->Xatom_net_supported }, - { "_NET_SUPPORTING_WM_CHECK", &dpyinfo->Xatom_net_supported }, + { "_NET_SUPPORTING_WM_CHECK", &dpyinfo->Xatom_net_supporting_wm_check }, { "_NET_WM_WINDOW_OPACITY", &dpyinfo->Xatom_net_wm_window_opacity }, { "_NET_ACTIVE_WINDOW", &dpyinfo->Xatom_net_active_window }, { "_NET_FRAME_EXTENTS", &dpyinfo->Xatom_net_frame_extents }, ------------------------------------------------------------ revno: 102376 author: Martin Rudalics committer: Chong Yidong branch nick: trunk timestamp: Sat 2010-11-13 13:49:22 -0500 message: * src/window.c (Fwindow_use_time): New function. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-11-13 13:29:31 +0000 +++ src/ChangeLog 2010-11-13 18:49:22 +0000 @@ -1,3 +1,7 @@ +2010-11-13 Martin Rudalics + + * window.c (Fwindow_use_time): New function. + 2010-11-13 Eli Zaretskii * xdisp.c (set_cursor_from_row): Fix cursor positioning on === modified file 'src/window.c' --- src/window.c 2010-09-25 13:21:20 +0000 +++ src/window.c 2010-11-13 18:49:22 +0000 @@ -2420,6 +2420,16 @@ window_loop (CHECK_ALL_WINDOWS, Qnil, 1, Qt); } +DEFUN ("window-use-time", Fwindow_use_time, Swindow_use_time, 0, 1, 0, + doc: /* Return WINDOW's use time. +WINDOW defaults to the selected window. The window with the highest use +time is the most recently selected one. The window with the lowest use +time is the least recently selected one. */) + (Lisp_Object window) +{ + return decode_window (window)->use_time; +} + DEFUN ("get-lru-window", Fget_lru_window, Sget_lru_window, 0, 2, 0, doc: /* Return the window least recently selected or used for display. \(LRU means Least Recently Used.) ------------------------------------------------------------ revno: 102375 committer: Chong Yidong branch nick: trunk timestamp: Sat 2010-11-13 13:34:02 -0500 message: Fix background-color setting in initial frame (Bug#7373). * lisp/frame.el (frame-notice-user-settings): Don't clobber other user-set parameters when calling face-set-after-frame-default in response to background-color parameter (Bug#7373). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-11-13 13:35:44 +0000 +++ lisp/ChangeLog 2010-11-13 18:34:02 +0000 @@ -1,3 +1,9 @@ +2010-11-13 Chong Yidong + + * frame.el (frame-notice-user-settings): Don't clobber other + user-set parameters when calling face-set-after-frame-default in + response to background-color parameter (Bug#7373). + 2010-11-13 Eli Zaretskii * international/characters.el (glyphless-char-display-control): === modified file 'lisp/frame.el' --- lisp/frame.el 2010-10-24 18:43:31 +0000 +++ lisp/frame.el 2010-11-13 18:34:02 +0000 @@ -296,22 +296,19 @@ (null frame-initial-frame)) ;; This case happens when we don't have a window system, and ;; also for MS-DOS frames. - (let ((parms (frame-parameters frame-initial-frame))) + (let ((parms (frame-parameters))) ;; Don't change the frame names. (setq parms (delq (assq 'name parms) parms)) ;; Can't modify the minibuffer parameter, so don't try. (setq parms (delq (assq 'minibuffer parms) parms)) - (modify-frame-parameters nil - (if (null initial-window-system) - (append initial-frame-alist - window-system-frame-alist - default-frame-alist - parms - nil) - ;; initial-frame-alist and - ;; default-frame-alist were already - ;; applied in pc-win.el. - parms)) + (modify-frame-parameters + nil + (if initial-window-system + parms + ;; initial-frame-alist and default-frame-alist were already + ;; applied in pc-win.el. + (append initial-frame-alist window-system-frame-alist + default-frame-alist parms nil))) (if (null initial-window-system) ;; MS-DOS does this differently in pc-win.el (let ((newparms (frame-parameters)) (frame (selected-frame))) @@ -512,25 +509,28 @@ ;; it is undesirable to specify the parm again ;; once the user has seen the frame and been able to alter it ;; manually. - (while tail - (let (newval oldval) - (setq oldval (assq (car (car tail)) - frame-initial-frame-alist)) - (setq newval (cdr (assq (car (car tail)) allparms))) + (let (newval oldval) + (dolist (entry tail) + (setq oldval (assq (car entry) frame-initial-frame-alist)) + (setq newval (cdr (assq (car entry) allparms))) (or (and oldval (eq (cdr oldval) newval)) (setq newparms - (cons (cons (car (car tail)) newval) newparms)))) - (setq tail (cdr tail))) + (cons (cons (car entry) newval) newparms))))) (setq newparms (nreverse newparms)) - (modify-frame-parameters frame-initial-frame - newparms) - ;; If we changed the background color, - ;; we need to update the background-mode parameter - ;; and maybe some faces too. - (when (assq 'background-color newparms) - (unless (assq 'background-mode newparms) - (frame-set-background-mode frame-initial-frame)) - (face-set-after-frame-default frame-initial-frame))))) + + (let ((new-bg (assq 'background-color newparms))) + ;; If the `background-color' parameter is changed, apply + ;; it first, then make sure that the `background-mode' + ;; parameter and other faces are updated, before applying + ;; the other parameters. + (when new-bg + (modify-frame-parameters frame-initial-frame + (list new-bg)) + (unless (assq 'background-mode newparms) + (frame-set-background-mode frame-initial-frame)) + (face-set-after-frame-default frame-initial-frame) + (setq newparms (delq new-bg newparms))) + (modify-frame-parameters frame-initial-frame newparms))))) ;; Restore the original buffer. (set-buffer old-buffer) ------------------------------------------------------------ revno: 102374 committer: Eli Zaretskii branch nick: trunk timestamp: Sat 2010-11-13 15:35:44 +0200 message: lisp/ChangeLog: Fix last log entry. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-11-13 13:29:31 +0000 +++ lisp/ChangeLog 2010-11-13 13:35:44 +0000 @@ -1,8 +1,9 @@ 2010-11-13 Eli Zaretskii * international/characters.el (glyphless-char-display-control): - Doc fix. Signal an error if display method is not one of the - recognized symbols. + Renamed from glyphless-char-control; all users changed. Doc fix. + Signal an error if display method is not one of the recognized + symbols. 2010-11-13 Michael Albinus ------------------------------------------------------------ revno: 102373 committer: Eli Zaretskii branch nick: trunk timestamp: Sat 2010-11-13 15:29:31 +0200 message: Fix and document display of glyphless characters. src/xdisp.c (set_cursor_from_row): Fix cursor positioning on zero-width characters. (syms_of_xdisp) : Doc fix. src/.gdbinit (pgx): Adapt to latest changes in `struct glyph'. src/w32term.c (x_draw_glyphless_glyph_string_foreground): Draw the box before drawing the glyphs inside it. src/dispextern.h (enum glyphless_display_method): Rename GLYPHLESS_DISPLAY_HEXA_CODE to GLYPHLESS_DISPLAY_HEX_CODE. All users changed. src/term.c (append_glyphless_glyph, produce_glyphless_glyph): Fix comments. (produce_glyphless_glyph): Enclose "U+nnnn" and "empty box" whitespace in "[]", to simulate a box. Don't use uninitialized variable `width'. lisp/international/characters.el (glyphless-char-display-control): Renamed from glyphless-char-control; all users changed. Doc fix. Signal an error if display method is not one of the recognized symbols. doc/emacs/rmail.texi (Rmail Coding): Characters with no fonts are not necessarily displayed as empty boxes. doc/emacs/mule.texi (Language Environments, Fontsets): Characters with no fonts are not necessarily displayed as empty boxes. doc/emacs/display.texi (Text Display): Document display of glyphless characters. doc/lispref/display.texi (Usual Display): Characters with no fonts are not necessarily displayed as empty boxes. etc/NEWS: Document display of glyphless characters. diff: === modified file 'doc/emacs/ChangeLog' --- doc/emacs/ChangeLog 2010-11-13 03:48:16 +0000 +++ doc/emacs/ChangeLog 2010-11-13 13:29:31 +0000 @@ -1,3 +1,14 @@ +2010-11-13 Eli Zaretskii + + * rmail.texi (Rmail Coding): Characters with no fonts are not + necessarily displayed as empty boxes. + + * mule.texi (Language Environments, Fontsets): Characters with no + fonts are not necessarily displayed as empty boxes. + + * display.texi (Text Display): Document display of glyphless + characters. + 2010-11-13 Glenn Morris * basic.texi (Position Info): Add M-x count-words-region. === modified file 'doc/emacs/display.texi' --- doc/emacs/display.texi 2010-07-10 18:52:53 +0000 +++ doc/emacs/display.texi 2010-11-13 13:29:31 +0000 @@ -1136,6 +1136,48 @@ by means of a display table. @xref{Display Tables,, Display Tables, elisp, The Emacs Lisp Reference Manual}. +@cindex glyphless characters +@cindex characters with no font glyphs + On graphics displays, some characters could have no glyphs in any of +the fonts available to Emacs. On text terminals, some characters +could be impossible to encode with the terminal coding system +(@pxref{Terminal Coding}). Emacs can display such @dfn{glyphless} +characters using one of the following methods: + +@table @code +@item zero-width +Don't display the character. + +@item thin-space +Display a thin space, 1-pixel wide on graphics displays or 1-character +wide on text terminals. + +@item empty-box +Display an empty box. + +@item acronym +Display the acronym of the character's name (such as @sc{zwnj} or +@sc{rlm}) in a box. + +@item hex-code +Display the Unicode codepoint of the character in hexadecimal +notation, in a box. +@end table + +@noindent +@cindex @code{glyphless-char} face +With the exception of @code{zero-width}, all other methods draw these +characters in a special face @code{glyphless-char}, which you can +customize. + +@vindex glyphless-char-display-control +@vindex char-acronym-table +To control what glyphless characters are displayed using which method, +customize the variable @code{glyphless-char-display-control}; see its +doc string for the details. For even finer control, set the elements +of 2 char-tables: @code{glyphless-char-display} and +@code{char-acronym-table}. + @node Cursor Display @section Displaying the Cursor === modified file 'doc/emacs/mule.texi' --- doc/emacs/mule.texi 2010-07-10 18:52:53 +0000 +++ doc/emacs/mule.texi 2010-11-13 13:29:31 +0000 @@ -351,10 +351,11 @@ @cindex Intlfonts package, installation To display the script(s) used by your language environment on a graphical display, you need to have a suitable font. If some of the -characters appear as empty boxes, you should install the GNU Intlfonts -package, which includes fonts for most supported scripts.@footnote{If -you run Emacs on X, you need to inform the X server about the location -of the newly installed fonts with the following commands: +characters appear as empty boxes or hex codes, you should install the +GNU Intlfonts package, which includes fonts for most supported +scripts.@footnote{If you run Emacs on X, you need to inform the X +server about the location of the newly installed fonts with the +following commands: @example xset fp+ /usr/local/share/emacs/fonts @@ -1314,10 +1315,11 @@ explicitly requested, despite its name. A fontset does not necessarily specify a font for every character -code. If a fontset specifies no font for a certain character, or if it -specifies a font that does not exist on your system, then it cannot -display that character properly. It will display that character as an -empty box instead. +code. If a fontset specifies no font for a certain character, or if +it specifies a font that does not exist on your system, then it cannot +display that character properly. It will display that character as a +hex code or thin space or an empty box instead. (@xref{Text Display, +glyphless characters}, for details.) @node Defining Fontsets @section Defining fontsets === modified file 'doc/emacs/rmail.texi' --- doc/emacs/rmail.texi 2010-06-23 02:46:43 +0000 +++ doc/emacs/rmail.texi 2010-11-13 13:29:31 +0000 @@ -1192,7 +1192,8 @@ example, a misconfigured mailer could send a message with a @samp{charset=iso-8859-1} header when the message is actually encoded in @code{koi8-r}. When you see the message text garbled, or some of -its characters displayed as empty boxes, this may have happened. +its characters displayed as hex codes or empty boxes, this may have +happened. @findex rmail-redecode-body You can correct the problem by decoding the message again using the === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2010-10-31 14:40:01 +0000 +++ doc/lispref/ChangeLog 2010-11-13 13:29:31 +0000 @@ -1,3 +1,8 @@ +2010-11-13 Eli Zaretskii + + * display.texi (Usual Display): Characters with no fonts are not + necessarily displayed as empty boxes. + 2010-10-31 Glenn Morris * maps.texi (Standard Keymaps): Update File menu description. === modified file 'doc/lispref/display.texi' --- doc/lispref/display.texi 2010-10-24 21:36:09 +0000 +++ doc/lispref/display.texi 2010-11-13 13:29:31 +0000 @@ -5579,9 +5579,9 @@ table can specify a glyph to use instead of @samp{\}.) @item -Multibyte character codes above 256 are displayed as themselves, or as a -question mark or empty box if the terminal cannot display that -character. +Multibyte character codes above 256 are displayed as themselves, or as +a question mark or a hex code or an empty box if the terminal cannot +display that character. @end itemize The usual display conventions apply even when there is a display === modified file 'etc/ChangeLog' --- etc/ChangeLog 2010-11-13 03:33:24 +0000 +++ etc/ChangeLog 2010-11-13 13:29:31 +0000 @@ -1,3 +1,7 @@ +2010-11-13 Eli Zaretskii + + * NEWS: Document display of glyphless characters. + 2010-11-11 Eric Schulte * refcards/orgcard.tex: Add new Babel key sequences. === modified file 'etc/NEWS' --- etc/NEWS 2010-11-13 03:48:16 +0000 +++ etc/NEWS 2010-11-13 13:29:31 +0000 @@ -138,6 +138,18 @@ Emacs.pane.menubar.faceName: Courier-12 Set faceName to none and use font to use the old X fonts. ++++ +** Enhanced support for characters that have no glyphs in available fonts +If a character has no glyphs in any of the available fonts, Emacs by +default will display it either as a hexadecimal code in a box or as a +thin 1-pixel space. In addition to these two methods, Emacs can +display these characters as empty box, as an acronym, or not display +them at all. To change how these characters are displayed, customize +the variable `glyphless-char-display-control'. + +On character terminals these methods are used for characters that +cannot be encoded by the `terminal-coding-system'. + ** On graphical displays, the mode-line no longer ends in dashes. ** Basic SELinux support has been added. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-11-13 10:42:32 +0000 +++ lisp/ChangeLog 2010-11-13 13:29:31 +0000 @@ -1,3 +1,9 @@ +2010-11-13 Eli Zaretskii + + * international/characters.el (glyphless-char-display-control): + Doc fix. Signal an error if display method is not one of the + recognized symbols. + 2010-11-13 Michael Albinus * net/tramp-compat.el (tramp-compat-line-beginning-position) === modified file 'lisp/international/characters.el' --- lisp/international/characters.el 2010-10-29 00:50:13 +0000 +++ lisp/international/characters.el 2010-11-13 13:29:31 +0000 @@ -1294,40 +1294,48 @@ (aset char-acronym-table #xE007F "->|TAG") ; CANCEL TAG ;;; Control of displaying glyphless characters. -(defvar glyphless-char-control +(defvar glyphless-char-display-control '((format-control . thin-space) - (no-font . hexa-code)) - "List of directives to control displaying of glyphless characters. - -Each element has the form (TARGET . METHOD), where TARGET is a -symbol specifying the target character group to control, and -METHOD is a symbol specifying the method of displaying them. - -TARGET must be one of these symbols: - `c0-control': U+0000..U+001F. - `c1-control': U+0080..U+009F. - `format-control': Characters of Unicode General Category `Cf'. - Ex: U+200C (ZWNJ), U+200E (LRM)), but don't include characters - that have graphic image such as U+00AD (SHY). - `no-font': characters for which no suitable font is found. + (no-font . hex-code)) + "List of directives to control display of glyphless characters. + +Each element has the form (GROUP . METHOD), where GROUP is a +symbol specifying the character group, and METHOD is a symbol +specifying the method of displaying characters belonging to that +group. + +GROUP must be one of these symbols: + `c0-control': U+0000..U+001F. + `c1-control': U+0080..U+009F. + `format-control': Characters of Unicode General Category `Cf', + such as U+200C (ZWNJ), U+200E (LRM), but + excluding characters that have graphic images, + such as U+00AD (SHY). + `no-font': characters for which no suitable font is found. + For character terminals, characters that cannot + be encoded by `terminal-coding-system'. METHOD must be one of these symbols: `zero-width': don't display. - `thin-space': display a thin space (1-pixel width). - `empty-box': display an empty box. - `acronym': display an acronum string in a box. - `hexa-code': display a hexadecimal character code in a box. + `thin-space': display a thin (1-pixel width) space. On character + terminals, display as 1-character space. + `empty-box': display an empty box. + `acronym': display an acronym of the character in a box. The + acronym is taken from `char-acronym-table', which see. + `hex-code': display the hexadecimal character code in a box. Just setting this variable does not take effect. Call the function `update-glyphless-char-display' (which see) after setting this variable.") (defun update-glyphless-char-display () - "Make the setting of `glyphless-char-control' take effect. + "Make the setting of `glyphless-char-display-control' take effect. This function updates the char-table `glyphless-char-display'." - (dolist (elt glyphless-char-control) + (dolist (elt glyphless-char-display-control) (let ((target (car elt)) (method (cdr elt))) + (or (memq method '(zero-width thin-space empty-box acronym hex-code)) + (error "Invalid glyphless character display method: %s" method)) (cond ((eq target 'c0-control) (set-char-table-range glyphless-char-display '(#x00 . #x1F) method)) @@ -1346,7 +1354,7 @@ (while (<= from to) (when (/= from #xAD) (if (eq method 'acronym) - (setq this-method + (setq this-method (aref char-acronym-table from))) (set-char-table-range glyphless-char-display from this-method)) @@ -1355,7 +1363,7 @@ ((eq target 'no-font) (set-char-table-extra-slot glyphless-char-display 0 method)) (t - (error "Invalid target character group: %s" target)))))) + (error "Invalid glyphless character group: %s" target)))))) (update-glyphless-char-display) === modified file 'src/.gdbinit' --- src/.gdbinit 2010-08-06 14:54:06 +0000 +++ src/.gdbinit 2010-11-13 13:29:31 +0000 @@ -494,14 +494,30 @@ end # COMPOSITE_GLYPH if ($g->type == 1) - printf "COMP[%d (%d..%d)]", $g->u.cmp.id, $g->u.cmp.from, $g->u.cmp.to + printf "COMP[%d (%d..%d)]", $g->u.cmp.id, $g->slice.cmp.from, $g->slice.cmp.to + end + # GLYPHLESS_GLYPH + if ($g->type == 2) + printf "GLYPHLESS[" + if ($g->u.glyphless.method == 0) + printf "THIN]" + end + if ($g->u.glyphless.method == 1) + printf "EMPTY]" + end + if ($g->u.glyphless.method == 2) + printf "ACRO]" + end + if ($g->u.glyphless.method == 3) + printf "HEX]" + end end # IMAGE_GLYPH - if ($g->type == 2) + if ($g->type == 3) printf "IMAGE[%d]", $g->u.img_id end # STRETCH_GLYPH - if ($g->type == 3) + if ($g->type == 4) printf "STRETCH[%d+%d]", $g->u.stretch.height, $g->u.stretch.ascent end xgettype ($g->object) @@ -544,8 +560,8 @@ if ($g->right_box_line_p) printf " ]" end - if ($g->slice.x || $g->slice.y || $g->slice.width || $g->slice.height) - printf " slice=%d,%d,%d,%d" ,$g->slice.x, $g->slice.y, $g->slice.width, $g->slice.height + if ($g->slice.img.x || $g->slice.img.y || $g->slice.img.width || $g->slice.img.height) + printf " slice=%d,%d,%d,%d" ,$g->slice.img.x, $g->slice.img.y, $g->slice.img.width, $g->slice.img.height end printf "\n" end === modified file 'src/ChangeLog' --- src/ChangeLog 2010-11-12 09:31:44 +0000 +++ src/ChangeLog 2010-11-13 13:29:31 +0000 @@ -1,3 +1,25 @@ +2010-11-13 Eli Zaretskii + + * xdisp.c (set_cursor_from_row): Fix cursor positioning on + zero-width characters. + + * .gdbinit (pgx): Adapt to latest changes in `struct glyph'. + + * w32term.c (x_draw_glyphless_glyph_string_foreground): Draw the + box before drawing the glyphs inside it. + + * xdisp.c (syms_of_xdisp) : Doc fix. + + * dispextern.h (enum glyphless_display_method): Rename + GLYPHLESS_DISPLAY_HEXA_CODE to GLYPHLESS_DISPLAY_HEX_CODE. All + users changed. + + * term.c (append_glyphless_glyph, produce_glyphless_glyph): Fix + comments. + (produce_glyphless_glyph): Enclose "U+nnnn" and "empty box" + whitespace in "[]", to simulate a box. Don't use uninitialized + variable `width'. + 2010-11-11 Julien Danjou * xsettings.c (init_xsettings): Use already fetch atoms. === modified file 'src/dispextern.h' --- src/dispextern.h 2010-11-09 20:07:10 +0000 +++ src/dispextern.h 2010-11-13 13:29:31 +0000 @@ -371,12 +371,11 @@ displaying. The member `pixel_width' above is set to 1. */ unsigned padding_p : 1; - /* 1 means the actual glyph is not available, draw a box instead. - This can happen when a font couldn't be loaded, or a character - doesn't have a glyph in a font. */ + /* 1 means the actual glyph is not available, draw using `struct + glyphless' below instead. This can happen when a font couldn't + be loaded, or a character doesn't have a glyph in a font. */ unsigned glyph_not_available_p : 1; - /* Non-zero means don't display cursor here. */ unsigned avoid_cursor_p : 1; @@ -1997,14 +1996,15 @@ enum glyphless_display_method { - /* Display a thin (1-pixel width) space. */ + /* Display a thin (1-pixel width) space. On a TTY, display a + 1-character width space. */ GLYPHLESS_DISPLAY_THIN_SPACE, /* Display an empty box of proper width. */ GLYPHLESS_DISPLAY_EMPTY_BOX, /* Display an acronym string in a box. */ GLYPHLESS_DISPLAY_ACRONYM, - /* Display a hexadecimal character code in a box. */ - GLYPHLESS_DISPLAY_HEXA_CODE + /* Display the hexadecimal code of the character in a box. */ + GLYPHLESS_DISPLAY_HEX_CODE }; struct it_slice === modified file 'src/term.c' --- src/term.c 2010-11-06 08:28:31 +0000 +++ src/term.c 2010-11-13 13:29:31 +0000 @@ -1850,9 +1850,9 @@ /* Append a glyph for a glyphless character to IT->glyph_row. FACE_ID - is a face ID to be used for the glyph. What actually appended are - glyphs of type CHAR_GLYPH of which characters are in STR - (it->nglyphs bytes). */ + is a face ID to be used for the glyph. What is actually appended + are glyphs of type CHAR_GLYPH whose characters are in STR (which + comes from it->nglyphs bytes). */ static void append_glyphless_glyph (struct it *it, int face_id, char *str) @@ -1923,7 +1923,7 @@ /* Produce glyphs for a glyphless character for iterator IT. IT->glyphless_method specifies which method to use for displaying the character. See the description of enum - glyphless_display_method in dispextern.h for the detail. + glyphless_display_method in dispextern.h for the details. FOR_NO_FONT is nonzero if and only if this is for a character that is not supproted by the coding system of the terminal. ACRONYM, if @@ -1935,11 +1935,11 @@ produce_glyphless_glyph (struct it *it, int for_no_font, Lisp_Object acronym) { int face_id; - int width, len; - char buf[9], *str = " "; + int len; + char buf[11], *str = " "; /* Get a face ID for the glyph by utilizing a cache (the same way as - doen for `escape-glyph' in get_next_display_element). */ + done for `escape-glyph' in get_next_display_element). */ if (it->f == last_glyphless_glyph_frame && it->face_id == last_glyphless_glyph_face_id) { @@ -1956,8 +1956,8 @@ if (it->glyphless_method == GLYPHLESS_DISPLAY_THIN_SPACE) { - /* As there's no way to produce a thin space, we produce - a space of canonical width.. */ + /* As there's no way to produce a thin space, we produce a space + of canonical width. */ len = 1; } else if (it->glyphless_method == GLYPHLESS_DISPLAY_EMPTY_BOX) @@ -1965,8 +1965,11 @@ len = CHAR_WIDTH (it->c); if (len == 0) len = 1; - else if (width > 4) + else if (len > 4) len = 4; + sprintf (buf, "[%.*s]", len, str); + len += 2; + str = buf; } else { @@ -1983,11 +1986,11 @@ } else { - xassert (it->glyphless_method == GLYPHLESS_DISPLAY_HEXA_CODE); - len = (it->c < 0x100 ? sprintf (buf, "U+%02X", it->c) - : it->c < 0x10000 ? sprintf (buf, "U+%04X", it->c) - : it->c <= MAX_UNICODE_CHAR ? sprintf (buf, "U+%06X", it->c) - : sprintf (buf, "E+%06X", it->c)); + xassert (it->glyphless_method == GLYPHLESS_DISPLAY_HEX_CODE); + len = (it->c < 0x100 ? sprintf (buf, "[U+%02X]", it->c) + : it->c < 0x10000 ? sprintf (buf, "[U+%04X]", it->c) + : it->c <= MAX_UNICODE_CHAR ? sprintf (buf, "[U+%06X]", it->c) + : sprintf (buf, "[E+%06X]", it->c)); } str = buf; } === modified file 'src/w32term.c' --- src/w32term.c 2010-11-06 08:28:31 +0000 +++ src/w32term.c 2010-11-13 13:29:31 +0000 @@ -1440,7 +1440,7 @@ str = (char *) SDATA (acronym); } } - else if (glyph->u.glyphless.method == GLYPHLESS_DISPLAY_HEXA_CODE) + else if (glyph->u.glyphless.method == GLYPHLESS_DISPLAY_HEX_CODE) { sprintf ((char *) buf, "%0*X", glyph->u.glyphless.ch < 0x10000 ? 4 : 6, @@ -1448,6 +1448,11 @@ str = buf; } + if (glyph->u.glyphless.method != GLYPHLESS_DISPLAY_THIN_SPACE) + w32_draw_rectangle (s->hdc, s->gc, + x, s->ybase - glyph->ascent, + glyph->pixel_width - 1, + glyph->ascent + glyph->descent - 1); if (str) { struct font *font = s->font; @@ -1456,7 +1461,7 @@ HFONT old_font; old_font = SelectObject (s->hdc, FONT_HANDLE (font)); - /* It is assured that all LEN characters in STR is ASCII. */ + /* It is certain that all LEN characters in STR are ASCII. */ for (j = 0; j < len; j++) { code = font->driver->encode_char (font, str[j]); @@ -1472,11 +1477,6 @@ with_background); SelectObject (s->hdc, old_font); } - if (glyph->u.glyphless.method != GLYPHLESS_DISPLAY_THIN_SPACE) - w32_draw_rectangle (s->hdc, s->gc, - x, s->ybase - glyph->ascent, - glyph->pixel_width - 1, - glyph->ascent + glyph->descent - 1); x += glyph->pixel_width; } } === modified file 'src/xdisp.c' --- src/xdisp.c 2010-11-09 20:07:10 +0000 +++ src/xdisp.c 2010-11-13 13:29:31 +0000 @@ -971,7 +971,7 @@ Lisp_Object Qglyphless_char_display; /* Method symbols for Vglyphless_char_display. */ -static Lisp_Object Qhexa_code, Qempty_box, Qthin_space, Qzero_width; +static Lisp_Object Qhex_code, Qempty_box, Qthin_space, Qzero_width; /* Default pixel width of `thin-space' display method. */ #define THIN_SPACE_WIDTH 1 @@ -5813,8 +5813,8 @@ it->glyphless_method = GLYPHLESS_DISPLAY_THIN_SPACE; else if (EQ (glyphless_method, Qempty_box)) it->glyphless_method = GLYPHLESS_DISPLAY_EMPTY_BOX; - else if (EQ (glyphless_method, Qhexa_code)) - it->glyphless_method = GLYPHLESS_DISPLAY_HEXA_CODE; + else if (EQ (glyphless_method, Qhex_code)) + it->glyphless_method = GLYPHLESS_DISPLAY_HEX_CODE; else if (STRINGP (glyphless_method)) it->glyphless_method = GLYPHLESS_DISPLAY_ACRONYM; else @@ -12871,10 +12871,10 @@ || (row->truncated_on_left_p && pt_old < bpos_min) || (row->truncated_on_right_p && pt_old > bpos_max) /* Zero-width characters produce no glyphs. */ - || ((row->reversed_p - ? glyph_after > glyphs_end - : glyph_after < glyphs_end) - && eabs (glyph_after - glyph_before) == 1)) + || (!string_seen + && (row->reversed_p + ? glyph_after > glyphs_end + : glyph_after < glyphs_end))) { cursor = glyph_after; x = -1; @@ -22292,7 +22292,7 @@ and only if this is for a character for which no font was found. If the display method (it->glyphless_method) is - GLYPHLESS_DISPLAY_ACRONYM or GLYPHLESS_DISPLAY_HEXA_CODE, LEN is a + GLYPHLESS_DISPLAY_ACRONYM or GLYPHLESS_DISPLAY_HEX_CODE, LEN is a length of the acronym or the hexadecimal string, UPPER_XOFF and UPPER_YOFF are pixel offsets for the upper part of the string, LOWER_XOFF and LOWER_YOFF are for the lower part. @@ -22441,7 +22441,7 @@ } else { - xassert (it->glyphless_method == GLYPHLESS_DISPLAY_HEXA_CODE); + xassert (it->glyphless_method == GLYPHLESS_DISPLAY_HEX_CODE); sprintf (buf, "%0*X", it->c < 0x10000 ? 4 : 6, it->c); str = buf; } @@ -27057,7 +27057,7 @@ hourglass_shown_p = 0; DEFSYM (Qglyphless_char, "glyphless-char"); - DEFSYM (Qhexa_code, "hexa-code"); + DEFSYM (Qhex_code, "hex-code"); DEFSYM (Qempty_box, "empty-box"); DEFSYM (Qthin_space, "thin-space"); DEFSYM (Qzero_width, "zero-width"); @@ -27073,13 +27073,13 @@ doc: /* Char-table to control displaying of glyphless characters. Each element, if non-nil, is an ASCII acronym string (displayed in a box) or one of these symbols: - hexa-code: display with hexadecimal character code in a box - empty-box: display with an empty box - thin-space: display with 1-pixel width space + hex-code: display the hexadecimal code of a character in a box + empty-box: display as an empty box + thin-space: display as 1-pixel width space zero-width: don't display It has one extra slot to control the display of a character for which -no font is found. The value of the slot is `hexa-code' or `empty-box'. +no font is found. The value of the slot is `hex-code' or `empty-box'. The default is `empty-box'. */); Vglyphless_char_display = Fmake_char_table (Qglyphless_char_display, Qnil); Fset_char_table_extra_slot (Vglyphless_char_display, make_number (0), === modified file 'src/xterm.c' --- src/xterm.c 2010-11-12 09:31:44 +0000 +++ src/xterm.c 2010-11-13 13:29:31 +0000 @@ -1369,7 +1369,7 @@ str = (char *) SDATA (acronym); } } - else if (glyph->u.glyphless.method == GLYPHLESS_DISPLAY_HEXA_CODE) + else if (glyph->u.glyphless.method == GLYPHLESS_DISPLAY_HEX_CODE) { sprintf ((char *) buf, "%0*X", glyph->u.glyphless.ch < 0x10000 ? 4 : 6, ------------------------------------------------------------ revno: 102372 committer: Michael Albinus branch nick: trunk timestamp: Sat 2010-11-13 11:42:32 +0100 message: * net/tramp-compat.el (tramp-compat-line-beginning-position) (tramp-compat-line-end-position): Remove them. * net/tramp.el (tramp-parse-rhosts-group) (tramp-parse-shosts-group, tramp-parse-sconfig-group) (tramp-parse-hosts-group, tramp-parse-passwd-group) (tramp-parse-netrc-group, tramp-parse-putty-group) * net/tramp-cmds.el (tramp-append-tramp-buffers) * net/tramp-sh.el (tramp-do-file-attributes-with-ls) (tramp-sh-handle-file-selinux-context) (tramp-sh-handle-file-name-all-completions) (tramp-sh-handle-insert-directory) (tramp-sh-handle-expand-file-name, tramp-find-executable) (tramp-wait-for-output, tramp-send-command-and-read) * net/tramp-smb.el (tramp-smb-read-file-entry) (tramp-smb-get-cifs-capabilities): Use `point-at-eol'. * net/tramp-sh.el (tramp-sh-handle-insert-directory) Use `point-at-bol'. (tramp-remote-coding-commands): Add an alternative using "base64 -d -i". This is needed for older base64 versions from GNU coreutils. Reported by Klaus Reichl . diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-11-13 03:46:00 +0000 +++ lisp/ChangeLog 2010-11-13 10:42:32 +0000 @@ -1,3 +1,29 @@ +2010-11-13 Michael Albinus + + * net/tramp-compat.el (tramp-compat-line-beginning-position) + (tramp-compat-line-end-position): Remove them. + + * net/tramp.el (tramp-parse-rhosts-group) + (tramp-parse-shosts-group, tramp-parse-sconfig-group) + (tramp-parse-hosts-group, tramp-parse-passwd-group) + (tramp-parse-netrc-group, tramp-parse-putty-group) + * net/tramp-cmds.el (tramp-append-tramp-buffers) + * net/tramp-sh.el (tramp-do-file-attributes-with-ls) + (tramp-sh-handle-file-selinux-context) + (tramp-sh-handle-file-name-all-completions) + (tramp-sh-handle-insert-directory) + (tramp-sh-handle-expand-file-name, tramp-find-executable) + (tramp-wait-for-output, tramp-send-command-and-read) + * net/tramp-smb.el (tramp-smb-read-file-entry) + (tramp-smb-get-cifs-capabilities): Use `point-at-eol'. + + * net/tramp-sh.el (tramp-sh-handle-insert-directory) Use + `point-at-bol'. + (tramp-remote-coding-commands): Add an alternative using "base64 + -d -i". This is needed for older base64 versions from GNU + coreutils. Reported by Klaus Reichl + . + 2010-11-13 Hrvoje Niksic * simple.el (count-words-region): New function. @@ -1227,7 +1253,7 @@ * newcomment.el (comment-dwim): Fix the intentation in the doc string. -010-10-21 Michael Albinus +2010-10-21 Michael Albinus * net/tramp-sh.el (tramp-do-file-attributes-with-stat): Do not use space in stat format string. === modified file 'lisp/net/tramp-cmds.el' --- lisp/net/tramp-cmds.el 2010-10-02 13:21:43 +0000 +++ lisp/net/tramp-cmds.el 2010-11-13 10:42:32 +0000 @@ -298,8 +298,7 @@ (setq buffer-read-only nil) (goto-char (point-min)) (while (not (eobp)) - (if (re-search-forward - tramp-buf-regexp (tramp-compat-line-end-position) t) + (if (re-search-forward tramp-buf-regexp (point-at-eol) t) (forward-line 1) (forward-line 0) (let ((start (point))) @@ -372,5 +371,4 @@ ;; ordinary variable that gets its initial value from ;; tramp-default-user-alist and then is added to. (Pete Forman) -;; arch-tag: 190d4c33-76bb-4e99-8b6f-71741f23d98c ;;; tramp-cmds.el ends here === modified file 'lisp/net/tramp-compat.el' --- lisp/net/tramp-compat.el 2010-11-07 01:50:52 +0000 +++ lisp/net/tramp-compat.el 2010-11-13 10:42:32 +0000 @@ -199,29 +199,6 @@ (ignore-errors (tramp-compat-funcall 'font-lock-add-keywords mode keywords how))) -;; FIXME is this really necessary? Eg Emacs has both l-b-p and p-at-b -;; since at least 21.1. -(defsubst tramp-compat-line-beginning-position () - "Return point at beginning of line (compat function). -Calls `line-beginning-position' or `point-at-bol' if defined, else -own implementation." - (cond - ((fboundp 'line-beginning-position) - (tramp-compat-funcall 'line-beginning-position)) - ((fboundp 'point-at-bol) (tramp-compat-funcall 'point-at-bol)) - (t (save-excursion (beginning-of-line) (point))))) - -;; FIXME is this really necessary? Eg Emacs has both l-e-p and p-at-e -;; since at least 21.1. -(defsubst tramp-compat-line-end-position () - "Return point at end of line (compat function). -Calls `line-end-position' or `point-at-eol' if defined, else -own implementation." - (cond - ((fboundp 'line-end-position) (tramp-compat-funcall 'line-end-position)) - ((fboundp 'point-at-eol) (tramp-compat-funcall 'point-at-eol)) - (t (save-excursion (end-of-line) (point))))) - (defsubst tramp-compat-temporary-file-directory () "Return name of directory for temporary files (compat function). For Emacs, this is the variable `temporary-file-directory', for XEmacs === modified file 'lisp/net/tramp-sh.el' --- lisp/net/tramp-sh.el 2010-10-21 08:05:23 +0000 +++ lisp/net/tramp-sh.el 2010-11-13 10:42:32 +0000 @@ -1189,8 +1189,7 @@ ;; if symlink, find out file name pointed to (when symlinkp (search-forward "-> ") - (setq res-symlink-target - (buffer-substring (point) (tramp-compat-line-end-position)))) + (setq res-symlink-target (buffer-substring (point) (point-at-eol)))) ;; return data gathered (list ;; 0. t for directory, string (name linked to) for symbolic @@ -1438,7 +1437,7 @@ (tramp-shell-quote-argument localname)))) (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) - (when (re-search-forward regexp (tramp-compat-line-end-position) t) + (when (re-search-forward regexp (point-at-eol) t) (setq context (list (match-string 1) (match-string 2) (match-string 3) (match-string 4)))))) ;; Return the context. @@ -1746,8 +1745,7 @@ (tramp-error v 'file-error "tramp-sh-handle-file-name-all-completions: %s" - (buffer-substring - (point) (tramp-compat-line-end-position)))) + (buffer-substring (point) (point-at-eol)))) ;; For peace of mind, if buffer doesn't end in `fail' ;; then it should end in `ok'. If neither are in the ;; buffer something went seriously wrong on the remote @@ -1760,9 +1758,7 @@ (tramp-shell-quote-argument localname) (buffer-string)))) (while (zerop (forward-line -1)) - (push (buffer-substring - (point) (tramp-compat-line-end-position)) - result))) + (push (buffer-substring (point) (point-at-eol)) result))) ;; Because the remote op went through OK we know the ;; directory we `cd'-ed to exists @@ -2524,7 +2520,7 @@ (forward-line -1)) (when (looking-at "//DIRED//\\s-+") (let ((databeg (match-end 0)) - (end (tramp-compat-line-end-position))) + (end (point-at-eol))) ;; Now read the numeric positions of file names. (goto-char databeg) (while (< (point) end) @@ -2534,7 +2530,7 @@ ;; End is followed by \n or by " -> ". (put-text-property start end 'dired-filename t)))))) ;; Remove trailing lines. - (goto-char (tramp-compat-line-beginning-position)) + (goto-char (point-at-bol)) (while (looking-at "//") (forward-line 1) (delete-region (match-beginning 0) (point))) @@ -2593,8 +2589,7 @@ v (format "cd %s; pwd" (tramp-shell-quote-argument uname))) (with-current-buffer (tramp-get-buffer v) (goto-char (point-min)) - (buffer-substring - (point) (tramp-compat-line-end-position))))) + (buffer-substring (point) (point-at-eol))))) (setq localname (concat uname fname)))) ;; There might be a double slash, for example when "~/" ;; expands to "/". Remove this. @@ -3496,8 +3491,7 @@ (when (search-backward "tramp_executable " nil t) (skip-chars-forward "^ ") (skip-chars-forward " ") - (setq result (buffer-substring - (point) (tramp-compat-line-end-position))))) + (setq result (buffer-substring (point) (point-at-eol))))) result))) (defun tramp-set-remote-path (vec) @@ -3647,7 +3641,7 @@ ;; the single quotes makes it work under `rc', too. We also unset ;; the variable $ENV because that is read by some sh ;; implementations (eg, bash when called as sh) on startup; this - ;; way, we avoid the startup file clobbering $PS1. $PROMP_COMMAND + ;; way, we avoid the startup file clobbering $PS1. $PROMPT_COMMAND ;; is another way to set the prompt in /bin/bash, it must be ;; discarded as well. (tramp-open-shell @@ -3858,7 +3852,11 @@ with the encoded or decoded results, respectively.") (defconst tramp-remote-coding-commands - '((b64 "base64" "base64 -d") + '((b64 "base64" "base64 -d -i") + ;; "-i" is more robust with older base64 from GNU coreutils. + ;; However, I don't know whether all base64 versions do supports + ;; this option. + (b64 "base64" "base64 -d") (b64 "mimencode -b" "mimencode -u -b") (b64 "mmencode -b" "mmencode -u -b") (b64 "recode data..base64" "recode base64..data") @@ -4360,8 +4358,8 @@ (tramp-set-connection-property p "check-remote-echo" t) (setq command (format "%s%s%s" tramp-echo-mark command tramp-echo-mark))) (when (string-match "<<'EOF'" command) - ;; Unset $PS1 when using here documents, in order not to get - ;; several prompts. + ;; Unset $PS1 when using here documents, in order to avoid + ;; multiple prompts. (setq command (concat "(PS1= ; " command "\n)"))) ;; Send the command. (tramp-message vec 6 "%s" command) @@ -4387,8 +4385,7 @@ ;; A simple-minded busybox has sent " ^H" sequences. ;; Delete them. (goto-char (point-min)) - (when (re-search-forward - "^\\(.\b\\)+$" (tramp-compat-line-end-position) t) + (when (re-search-forward "^\\(.\b\\)+$" (point-at-eol) t) (forward-line 1) (delete-region (point-min) (point))) ;; Delete the prompt. @@ -4450,7 +4447,7 @@ (condition-case nil (prog1 (read (current-buffer)) ;; Error handling. - (when (re-search-forward "\\S-" (tramp-compat-line-end-position) t) + (when (re-search-forward "\\S-" (point-at-eol) t) (error nil))) (error (tramp-error vec 'file-error @@ -5042,5 +5039,6 @@ ;; rsync. ;; * Try telnet+curl as new method. It might be useful for busybox, ;; without built-in uuencode/uudecode. +;; * Try ssh+netcat as out-of-band method. ;;; tramp-sh.el ends here === modified file 'lisp/net/tramp-smb.el' --- lisp/net/tramp-smb.el 2010-10-05 14:20:24 +0000 +++ lisp/net/tramp-smb.el 2010-11-13 10:42:32 +0000 @@ -1079,7 +1079,7 @@ Result is the list (LOCALNAME MODE SIZE MTIME)." ;; We are called from `tramp-smb-get-file-entries', which sets the ;; current buffer. - (let ((line (buffer-substring (point) (tramp-compat-line-end-position))) + (let ((line (buffer-substring (point) (point-at-eol))) localname mode size month day hour min sec year mtime) (if (not share) @@ -1177,8 +1177,7 @@ (member "pathnames" (split-string - (buffer-substring - (point) (tramp-compat-line-end-position)) nil t))))))))) + (buffer-substring (point) (point-at-eol)) nil t))))))))) (defun tramp-smb-get-stat-capability (vec) "Check, whether the SMB server supports the STAT command." @@ -1396,5 +1395,4 @@ ;; regular again. ;; * Make it multi-hop capable. -;; arch-tag: fcc9dbec-7503-4d73-b638-3c8aa59575f5 ;;; tramp-smb.el ends here === modified file 'lisp/net/tramp.el' --- lisp/net/tramp.el 2010-11-09 20:07:10 +0000 +++ lisp/net/tramp.el 2010-11-13 10:42:32 +0000 @@ -2352,7 +2352,7 @@ (concat "^\\(" tramp-host-regexp "\\)" "\\([ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?"))) - (narrow-to-region (point) (tramp-compat-line-end-position)) + (narrow-to-region (point) (point-at-eol)) (when (re-search-forward regexp nil t) (setq result (append (list (match-string 3) (match-string 1))))) (widen) @@ -2379,7 +2379,7 @@ User is always nil." (let ((result) (regexp (concat "^\\(" tramp-host-regexp "\\)"))) - (narrow-to-region (point) (tramp-compat-line-end-position)) + (narrow-to-region (point) (point-at-eol)) (when (re-search-forward regexp nil t) (setq result (list nil (match-string 1)))) (widen) @@ -2408,7 +2408,7 @@ User is always nil." (let ((result) (regexp (concat "^[ \t]*Host[ \t]+" "\\(" tramp-host-regexp "\\)"))) - (narrow-to-region (point) (tramp-compat-line-end-position)) + (narrow-to-region (point) (point-at-eol)) (when (re-search-forward regexp nil t) (setq result (list nil (match-string 1)))) (widen) @@ -2469,7 +2469,7 @@ (let ((result) (regexp (concat "^\\(" tramp-ipv6-regexp "\\|" tramp-host-regexp "\\)"))) - (narrow-to-region (point) (tramp-compat-line-end-position)) + (narrow-to-region (point) (point-at-eol)) (when (re-search-forward regexp nil t) (setq result (list nil (match-string 1)))) (widen) @@ -2504,7 +2504,7 @@ Host is always \"localhost\"." (let ((result) (regexp (concat "^\\(" tramp-user-regexp "\\):"))) - (narrow-to-region (point) (tramp-compat-line-end-position)) + (narrow-to-region (point) (point-at-eol)) (when (re-search-forward regexp nil t) (setq result (list (match-string 1) "localhost"))) (widen) @@ -2534,7 +2534,7 @@ (concat "^[ \t]*machine[ \t]+" "\\(" tramp-host-regexp "\\)" "\\([ \t]+login[ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?"))) - (narrow-to-region (point) (tramp-compat-line-end-position)) + (narrow-to-region (point) (point-at-eol)) (when (re-search-forward regexp nil t) (setq result (list (match-string 3) (match-string 1)))) (widen) @@ -2560,7 +2560,7 @@ User is always nil." (let ((result) (regexp (concat (regexp-quote registry) "\\\\\\(.+\\)"))) - (narrow-to-region (point) (tramp-compat-line-end-position)) + (narrow-to-region (point) (point-at-eol)) (when (re-search-forward regexp nil t) (setq result (list nil (match-string 1)))) (widen) @@ -3662,7 +3662,6 @@ ;; expects English? Or just to set LC_MESSAGES to "C" if Tramp ;; expects only English messages? (Juri Linkov) ;; * Make shadowfile.el grok Tramp filenames. (Bug#4526, Bug#4846) -;; * Load ~/.emacs_SHELLNAME on the remote host for `shell'. ;; * I was wondering it it would be possible to use tramp even if I'm ;; actually using sshfs. But when I launch a command I would like ;; to get it executed on the remote machine where the files really @@ -3674,7 +3673,6 @@ ;; Functions for file-name-handler-alist: ;; diff-latest-backup-file -- in diff.el -;; arch-tag: 3a21a994-182b-48fa-b0cd-c1d9fede424a ;;; tramp.el ends here ;; Local Variables: ------------------------------------------------------------ revno: 102371 committer: Glenn Morris branch nick: trunk timestamp: Fri 2010-11-12 19:48:16 -0800 message: Document count-words-region. * doc/emacs/basic.texi (Position Info): Add M-x count-words-region. * doc/lispintro/emacs-lisp-intro.texi: Rename the `count-words-region' example, since there is now a standard command of that name. * etc/NEWS: Mention it. diff: === modified file 'doc/emacs/ChangeLog' --- doc/emacs/ChangeLog 2010-11-11 08:41:30 +0000 +++ doc/emacs/ChangeLog 2010-11-13 03:48:16 +0000 @@ -1,3 +1,7 @@ +2010-11-13 Glenn Morris + + * basic.texi (Position Info): Add M-x count-words-region. + 2010-11-11 Glenn Morris * msdog.texi (ls in Lisp): Update for ls-lisp changes. === modified file 'doc/emacs/basic.texi' --- doc/emacs/basic.texi 2010-07-10 18:52:53 +0000 +++ doc/emacs/basic.texi 2010-11-13 03:48:16 +0000 @@ -537,6 +537,8 @@ Display the number of lines in the current region. Normally bound to @kbd{M-=}, except in a few specialist modes. @xref{Mark}, for information about the region. +@item M-x count-words-region +Display the number of words in the current region. @item C-x = Display the character code of character after point, character position of point, and column of point (@code{what-cursor-position}). @@ -743,6 +745,3 @@ z z z}. The first @kbd{C-x z} repeats the command once, and each subsequent @kbd{z} repeats it once again. -@ignore - arch-tag: cda8952a-c439-41c1-aecf-4bc0d6482956 -@end ignore === modified file 'doc/lispintro/ChangeLog' --- doc/lispintro/ChangeLog 2010-10-11 01:57:48 +0000 +++ doc/lispintro/ChangeLog 2010-11-13 03:48:16 +0000 @@ -1,3 +1,8 @@ +2010-11-13 Glenn Morris + + * emacs-lisp-intro.texi: Rename the `count-words-region' example, + since there is now a standard command of that name. + 2010-10-11 Glenn Morris * Makefile.in (.dvi.ps): Remove unnecessary suffix rule. === modified file 'doc/lispintro/emacs-lisp-intro.texi' --- doc/lispintro/emacs-lisp-intro.texi 2010-06-23 02:51:01 +0000 +++ doc/lispintro/emacs-lisp-intro.texi 2010-11-13 03:48:16 +0000 @@ -704,23 +704,25 @@ * fwd-para while:: The forward motion @code{while} loop. Counting: Repetition and Regexps +@set COUNT-WORDS count-words-example +@c Length of variable name chosen so that things still line up when expanded. * Why Count Words:: -* count-words-region:: Use a regexp, but find a problem. +* @value{COUNT-WORDS}:: Use a regexp, but find a problem. * recursive-count-words:: Start with case of no words in region. * Counting Exercise:: -The @code{count-words-region} Function +The @code{@value{COUNT-WORDS}} Function -* Design count-words-region:: The definition using a @code{while} loop. -* Whitespace Bug:: The Whitespace Bug in @code{count-words-region}. +* Design @value{COUNT-WORDS}:: The definition using a @code{while} loop. +* Whitespace Bug:: The Whitespace Bug in @code{@value{COUNT-WORDS}}. Counting Words in a @code{defun} * Divide and Conquer:: * Words and Symbols:: What to count? * Syntax:: What constitutes a word or symbol? -* count-words-in-defun:: Very like @code{count-words}. +* count-words-in-defun:: Very like @code{@value{COUNT-WORDS}}. * Several defuns:: Counting several defuns in a file. * Find a File:: Do you want to look at a file? * lengths-list-file:: A list of the lengths of many definitions. @@ -13829,35 +13831,37 @@ @menu * Why Count Words:: -* count-words-region:: Use a regexp, but find a problem. +* @value{COUNT-WORDS}:: Use a regexp, but find a problem. * recursive-count-words:: Start with case of no words in region. * Counting Exercise:: @end menu -@node Why Count Words, count-words-region, Counting Words, Counting Words +@node Why Count Words, @value{COUNT-WORDS}, Counting Words, Counting Words @ifnottex @unnumberedsec Counting words @end ifnottex -The standard Emacs distribution contains a function for counting the -number of lines within a region. However, there is no corresponding -function for counting words. +The standard Emacs distribution contains functions for counting the +number of lines and words within a region. Certain types of writing ask you to count words. Thus, if you write an essay, you may be limited to 800 words; if you write a novel, you -may discipline yourself to write 1000 words a day. It seems odd to me -that Emacs lacks a word count command. Perhaps people use Emacs -mostly for code or types of documentation that do not require word -counts; or perhaps they restrict themselves to the operating system -word count command, @code{wc}. Alternatively, people may follow -the publishers' convention and compute a word count by dividing the -number of characters in a document by five. In any event, here are -commands to count words. - -@node count-words-region, recursive-count-words, Why Count Words, Counting Words +may discipline yourself to write 1000 words a day. It seems odd, but +for a long time, Emacs lacked a word count command. Perhaps people used +Emacs mostly for code or types of documentation that did not require +word counts; or perhaps they restricted themselves to the operating +system word count command, @code{wc}. Alternatively, people may have +followed the publishers' convention and computed a word count by +dividing the number of characters in a document by five. + +There are many ways to implement a command to count words. Here are +some examples, which you may wish to compare with the standard Emacs +command, @code{count-words-region}. + +@node @value{COUNT-WORDS}, recursive-count-words, Why Count Words, Counting Words @comment node-name, next, previous, up -@section The @code{count-words-region} Function -@findex count-words-region +@section The @code{@value{COUNT-WORDS}} Function +@findex @value{COUNT-WORDS} A word count command could count words in a line, paragraph, region, or buffer. What should the command cover? You could design the @@ -13865,7 +13869,7 @@ the Emacs tradition encourages flexibility---you may want to count words in just a section, rather than all of a buffer. So it makes more sense to design the command to count the number of words in a -region. Once you have a @code{count-words-region} command, you can, +region. Once you have a command to count words in a region, you can, if you wish, count words in a whole buffer by marking it with @w{@kbd{C-x h}} (@code{mark-whole-buffer}). @@ -13876,13 +13880,13 @@ or to a @code{while} loop. @menu -* Design count-words-region:: The definition using a @code{while} loop. -* Whitespace Bug:: The Whitespace Bug in @code{count-words-region}. +* Design @value{COUNT-WORDS}:: The definition using a @code{while} loop. +* Whitespace Bug:: The Whitespace Bug in @code{@value{COUNT-WORDS}}. @end menu -@node Design count-words-region, Whitespace Bug, count-words-region, count-words-region +@node Design @value{COUNT-WORDS}, Whitespace Bug, @value{COUNT-WORDS}, @value{COUNT-WORDS} @ifnottex -@unnumberedsubsec Designing @code{count-words-region} +@unnumberedsubsec Designing @code{@value{COUNT-WORDS}} @end ifnottex First, we will implement the word count command with a @code{while} @@ -13905,7 +13909,9 @@ The name of the function should be self-explanatory and similar to the existing @code{count-lines-region} name. This makes the name easier -to remember. @code{count-words-region} is a good choice. +to remember. @code{count-words-region} is the obvious choice. Since +that name is now used for the standard Emacs command to count words, we +will name our implementation @code{@value{COUNT-WORDS}}. The function counts words within a region. This means that the argument list must contain symbols that are bound to the two @@ -13923,7 +13929,7 @@ count words, second, to run the @code{while} loop, and third, to send a message to the user. -When a user calls @code{count-words-region}, point may be at the +When a user calls @code{@value{COUNT-WORDS}}, point may be at the beginning or the end of the region. However, the counting process must start at the beginning of the region. This means we will want to put point there if it is not already there. Executing @@ -14015,7 +14021,7 @@ @smallexample @group ;;; @r{First version; has bugs!} -(defun count-words-region (beginning end) +(defun @value{COUNT-WORDS} (beginning end) "Print number of words in the region. Words are defined as at least one word-constituent character followed by at least one character that @@ -14056,14 +14062,14 @@ @noindent As written, the function works, but not in all circumstances. -@node Whitespace Bug, , Design count-words-region, count-words-region +@node Whitespace Bug, , Design @value{COUNT-WORDS}, @value{COUNT-WORDS} @comment node-name, next, previous, up -@subsection The Whitespace Bug in @code{count-words-region} +@subsection The Whitespace Bug in @code{@value{COUNT-WORDS}} -The @code{count-words-region} command described in the preceding +The @code{@value{COUNT-WORDS}} command described in the preceding section has two bugs, or rather, one bug with two manifestations. First, if you mark a region containing only whitespace in the middle -of some text, the @code{count-words-region} command tells you that the +of some text, the @code{@value{COUNT-WORDS}} command tells you that the region contains one word! Second, if you mark a region containing only whitespace at the end of the buffer or the accessible portion of a narrowed buffer, the command displays an error message that looks @@ -14084,7 +14090,7 @@ @smallexample @group ;; @r{First version; has bugs!} -(defun count-words-region (beginning end) +(defun @value{COUNT-WORDS} (beginning end) "Print number of words in the region. Words are defined as at least one word-constituent character followed by at least one character that is not a word-constituent. The buffer's @@ -14123,12 +14129,12 @@ If you wish, you can also install this keybinding by evaluating it: @smallexample -(global-set-key "\C-c=" 'count-words-region) +(global-set-key "\C-c=" '@value{COUNT-WORDS}) @end smallexample To conduct the first test, set mark and point to the beginning and end of the following line and then type @kbd{C-c =} (or @kbd{M-x -count-words-region} if you have not bound @kbd{C-c =}): +@value{COUNT-WORDS}} if you have not bound @kbd{C-c =}): @smallexample one two three @@ -14139,7 +14145,7 @@ Repeat the test, but place mark at the beginning of the line and place point just @emph{before} the word @samp{one}. Again type the command -@kbd{C-c =} (or @kbd{M-x count-words-region}). Emacs should tell you +@kbd{C-c =} (or @kbd{M-x @value{COUNT-WORDS}}). Emacs should tell you that the region has no words, since it is composed only of the whitespace at the beginning of the line. But instead Emacs tells you that the region has one word! @@ -14148,7 +14154,7 @@ @file{*scratch*} buffer and then type several spaces at the end of the line. Place mark right after the word @samp{three} and point at the end of line. (The end of the line will be the end of the buffer.) -Type @kbd{C-c =} (or @kbd{M-x count-words-region}) as you did before. +Type @kbd{C-c =} (or @kbd{M-x @value{COUNT-WORDS}}) as you did before. Again, Emacs should tell you that the region has no words, since it is composed only of the whitespace at the end of the line. Instead, Emacs displays an error message saying @samp{Search failed}. @@ -14157,7 +14163,7 @@ Consider the first manifestation of the bug, in which the command tells you that the whitespace at the beginning of the line contains -one word. What happens is this: The @code{M-x count-words-region} +one word. What happens is this: The @code{M-x @value{COUNT-WORDS}} command moves point to the beginning of the region. The @code{while} tests whether the value of point is smaller than the value of @code{end}, which it is. Consequently, the regular expression search @@ -14191,7 +14197,7 @@ repeat count. (In Emacs, you can see a function's documentation by typing @kbd{C-h f}, the name of the function, and then @key{RET}.) -In the @code{count-words-region} definition, the value of the end of +In the @code{@value{COUNT-WORDS}} definition, the value of the end of the region is held by the variable @code{end} which is passed as an argument to the function. Thus, we can add @code{end} as an argument to the regular expression search expression: @@ -14200,7 +14206,7 @@ (re-search-forward "\\w+\\W*" end) @end smallexample -However, if you make only this change to the @code{count-words-region} +However, if you make only this change to the @code{@value{COUNT-WORDS}} definition and then test the new version of the definition on a stretch of whitespace, you will receive an error message saying @samp{Search failed}. @@ -14231,7 +14237,7 @@ than the value of end, since the @code{re-search-forward} expression did not move point. @dots{} and the cycle repeats @dots{} -The @code{count-words-region} definition requires yet another +The @code{@value{COUNT-WORDS}} definition requires yet another modification, to cause the true-or-false-test of the @code{while} loop to test false if the search fails. Put another way, there are two conditions that must be satisfied in the true-or-false-test before the @@ -14265,17 +14271,17 @@ found, point is moved through the region. When the search expression fails to find another word, or when point reaches the end of the region, the true-or-false-test tests false, the @code{while} loop -exits, and the @code{count-words-region} function displays one or +exits, and the @code{@value{COUNT-WORDS}} function displays one or other of its messages. -After incorporating these final changes, the @code{count-words-region} +After incorporating these final changes, the @code{@value{COUNT-WORDS}} works without bugs (or at least, without bugs that I have found!). Here is what it looks like: @smallexample @group ;;; @r{Final version:} @code{while} -(defun count-words-region (beginning end) +(defun @value{COUNT-WORDS} (beginning end) "Print number of words in the region." (interactive "r") (message "Counting words in region ... ") @@ -14309,7 +14315,7 @@ @end group @end smallexample -@node recursive-count-words, Counting Exercise, count-words-region, Counting Words +@node recursive-count-words, Counting Exercise, @value{COUNT-WORDS}, Counting Words @comment node-name, next, previous, up @section Count Words Recursively @cindex Count words recursively @@ -14319,7 +14325,7 @@ You can write the function for counting words recursively as well as with a @code{while} loop. Let's see how this is done. -First, we need to recognize that the @code{count-words-region} +First, we need to recognize that the @code{@value{COUNT-WORDS}} function has three jobs: it sets up the appropriate conditions for counting to occur; it counts the words in the region; and it sends a message to the user telling how many words there are. @@ -14333,7 +14339,7 @@ message; the other will return the word count. Let us start with the function that causes the message to be displayed. -We can continue to call this @code{count-words-region}. +We can continue to call this @code{@value{COUNT-WORDS}}. This is the function that the user will call. It will be interactive. Indeed, it will be similar to our previous versions of this @@ -14347,7 +14353,7 @@ @smallexample @group ;; @r{Recursive version; uses regular expression search} -(defun count-words-region (beginning end) +(defun @value{COUNT-WORDS} (beginning end) "@var{documentation}@dots{}" (@var{interactive-expression}@dots{}) @end group @@ -14388,7 +14394,7 @@ @smallexample @group -(defun count-words-region (beginning end) +(defun @value{COUNT-WORDS} (beginning end) "Print number of words in the region." (interactive "r") @end group @@ -14484,7 +14490,7 @@ Note that the search expression is part of the do-again-test---the function returns @code{t} if its search succeeds and @code{nil} if it fails. (@xref{Whitespace Bug, , The Whitespace Bug in -@code{count-words-region}}, for an explanation of how +@code{@value{COUNT-WORDS}}}, for an explanation of how @code{re-search-forward} works.) The do-again-test is the true-or-false test of an @code{if} clause. @@ -14657,7 +14663,7 @@ @smallexample @group ;;; @r{Recursive version} -(defun count-words-region (beginning end) +(defun @value{COUNT-WORDS} (beginning end) "Print number of words in the region. @end group @@ -14702,11 +14708,11 @@ Our next project is to count the number of words in a function definition. Clearly, this can be done using some variant of -@code{count-word-region}. @xref{Counting Words, , Counting Words: +@code{@value{COUNT-WORDS}}. @xref{Counting Words, , Counting Words: Repetition and Regexps}. If we are just going to count the words in one definition, it is easy enough to mark the definition with the @kbd{C-M-h} (@code{mark-defun}) command, and then call -@code{count-word-region}. +@code{@value{COUNT-WORDS}}. However, I am more ambitious: I want to count the words and symbols in every definition in the Emacs sources and then print a graph that @@ -14719,7 +14725,7 @@ * Divide and Conquer:: * Words and Symbols:: What to count? * Syntax:: What constitutes a word or symbol? -* count-words-in-defun:: Very like @code{count-words}. +* count-words-in-defun:: Very like @code{@value{COUNT-WORDS}}. * Several defuns:: Counting several defuns in a file. * Find a File:: Do you want to look at a file? * lengths-list-file:: A list of the lengths of many definitions. @@ -14793,11 +14799,11 @@ @noindent However, if we mark the @code{multiply-by-seven} definition with @kbd{C-M-h} (@code{mark-defun}), and then call -@code{count-words-region} on it, we will find that -@code{count-words-region} claims the definition has eleven words, not +@code{@value{COUNT-WORDS}} on it, we will find that +@code{@value{COUNT-WORDS}} claims the definition has eleven words, not ten! Something is wrong! -The problem is twofold: @code{count-words-region} does not count the +The problem is twofold: @code{@value{COUNT-WORDS}} does not count the @samp{*} as a word, and it counts the single symbol, @code{multiply-by-seven}, as containing three words. The hyphens are treated as if they were interword spaces rather than intraword @@ -14805,8 +14811,8 @@ @samp{multiply by seven}. The cause of this confusion is the regular expression search within -the @code{count-words-region} definition that moves point forward word -by word. In the canonical version of @code{count-words-region}, the +the @code{@value{COUNT-WORDS}} definition that moves point forward word +by word. In the canonical version of @code{@value{COUNT-WORDS}}, the regexp is: @smallexample @@ -14839,8 +14845,8 @@ Usually, a hyphen is not specified as a `word constituent character'. Instead, it is specified as being in the `class of characters that are part of symbol names but not words.' This means that the -@code{count-words-region} function treats it in the same way it treats -an interword white space, which is why @code{count-words-region} +@code{@value{COUNT-WORDS}} function treats it in the same way it treats +an interword white space, which is why @code{@value{COUNT-WORDS}} counts @samp{multiply-by-seven} as three words. There are two ways to cause Emacs to count @samp{multiply-by-seven} as @@ -14853,7 +14859,7 @@ constituent character; there are others, too. Alternatively, we can redefine the regular expression used in the -@code{count-words} definition so as to include symbols. This +@code{@value{COUNT-WORDS}} definition so as to include symbols. This procedure has the merit of clarity, but the task is a little tricky. @need 1200 @@ -14910,7 +14916,7 @@ @cindex Counting words in a @code{defun} We have seen that there are several ways to write a -@code{count-word-region} function. To write a +@code{count-words-region} function. To write a @code{count-words-in-defun}, we need merely adapt one of these versions. @@ -15044,7 +15050,7 @@ How to test this? The function is not interactive, but it is easy to put a wrapper around the function to make it interactive; we can use almost the same code as for the recursive version of -@code{count-words-region}: +@code{@value{COUNT-WORDS}}: @smallexample @group @@ -18885,7 +18891,7 @@ @itemize @bullet @item -Install the @code{count-words-region} function and then cause it to +Install the @code{@value{COUNT-WORDS}} function and then cause it to enter the built-in debugger when you call it. Run the command on a region containing two words. You will need to press @kbd{d} a remarkable number of times. On your system, is a `hook' called after @@ -18894,7 +18900,7 @@ Manual}.) @item -Copy @code{count-words-region} into the @file{*scratch*} buffer, +Copy @code{@value{COUNT-WORDS}} into the @file{*scratch*} buffer, instrument the function for Edebug, and walk through its execution. The function does not need to have a bug, although you can introduce one if you wish. If the function lacks a bug, the walk-through @@ -18909,7 +18915,7 @@ @item In the Edebug debugging buffer, use the @kbd{p} (@code{edebug-bounce-point}) command to see where in the region the -@code{count-words-region} is working. +@code{@value{COUNT-WORDS}} is working. @item Move point to some spot further down the function and then type the @@ -22272,6 +22278,3 @@ @bye -@ignore - arch-tag: da1a2154-531f-43a8-8e33-fc7faad10acf -@end ignore === modified file 'etc/NEWS' --- etc/NEWS 2010-11-12 14:13:48 +0000 +++ etc/NEWS 2010-11-13 03:48:16 +0000 @@ -213,6 +213,9 @@ * Editing Changes in Emacs 24.1 ++++ +** There is a new command `count-words-region', which does what you expect. + ** completion-at-point is now an alias for complete-symbol. ** Deletion changes