From 95da5522bbfacdcda9c0ef0dd85387bbdcacc71b Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sat, 30 Oct 2004 01:06:58 +0000 Subject: [PATCH 001/146] (variable-at-point): read -> intern. --- lisp/help-fns.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 57b0b39767e..8f2a1b7fa6e 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -473,7 +473,7 @@ Return 0 if there is no such symbol." (and (symbolp obj) (boundp obj) obj)))) (error nil)) (let* ((str (find-tag-default)) - (obj (if str (read str)))) + (obj (if str (intern str)))) (and (symbolp obj) (boundp obj) obj)) 0)) From d6288299d325714ac74a6cd792c9132e49b415a0 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sat, 30 Oct 2004 01:08:00 +0000 Subject: [PATCH 002/146] (function-called-at-point): read -> intern. --- lisp/ChangeLog | 5 +++++ lisp/help.el | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c22ab994eff..379136ee0a6 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2004-10-30 Juri Linkov + + * help.el (function-called-at-point): + * help-fns.el (variable-at-point): read -> intern. + 2004-10-30 Simon Josefsson * progmodes/autoconf.el (autoconf-font-lock-keywords): Recognize diff --git a/lisp/help.el b/lisp/help.el index ee35d007639..5ec9b1f5299 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -267,7 +267,7 @@ If that doesn't give a function, return nil." (and (symbolp obj) (fboundp obj) obj)))) (error nil)))) (let* ((str (find-tag-default)) - (obj (if str (read str)))) + (obj (if str (intern str)))) (and (symbolp obj) (fboundp obj) obj)))) From 5459bcdf38655e39b3762abcef1a5167d873a8e6 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 30 Oct 2004 16:43:18 +0000 Subject: [PATCH 003/146] (custom-deps, autoloads): Fix *-hooks -> *-hook. --- lisp/ChangeLog | 14 +++++++++----- lisp/makefile.w32-in | 4 ++-- 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 379136ee0a6..43f98adbef9 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,12 +1,16 @@ +2004-10-30 Stefan + + * makefile.w32-in (custom-deps, autoloads): Fix *-hooks -> *-hook. + 2004-10-30 Juri Linkov * help.el (function-called-at-point): - * help-fns.el (variable-at-point): read -> intern. + * help-fns.el (variable-at-point): Read -> intern. 2004-10-30 Simon Josefsson - * progmodes/autoconf.el (autoconf-font-lock-keywords): Recognize - AS_* too. + * progmodes/autoconf.el (autoconf-font-lock-keywords): + Recognize AS_* too. 2004-10-29 Simon Josefsson @@ -75,8 +79,8 @@ 2004-10-28 Kenichi Handa - * international/utf-8.el (utf-translate-cjk-charsets): Add - katakana-jisx0201. + * international/utf-8.el (utf-translate-cjk-charsets): + Add katakana-jisx0201. * international/subst-jis.el: Add data for JISX0201. diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in index b2694bc2b78..76a63a78b52 100644 --- a/lisp/makefile.w32-in +++ b/lisp/makefile.w32-in @@ -170,7 +170,7 @@ cus-load.el: touch $@ custom-deps: cus-load.el doit @echo Directories: $(WINS) - -$(emacs) -l cus-dep --eval $(ARGQUOTE)(setq find-file-hooks nil)$(ARGQUOTE) -f custom-make-dependencies $(lisp) $(WINS) + -$(emacs) -l cus-dep --eval $(ARGQUOTE)(setq find-file-hook nil)$(ARGQUOTE) -f custom-make-dependencies $(lisp) $(WINS) finder-data: doit @echo Directories: $(WINS) @@ -220,7 +220,7 @@ loaddefs.el-CMD: autoloads: loaddefs.el doit @echo Directories: $(WINS) $(emacs) -l autoload \ - --eval $(ARGQUOTE)(setq find-file-hooks nil \ + --eval $(ARGQUOTE)(setq find-file-hook nil \ find-file-suppress-same-file-warnings t \ generated-autoload-file \ $(DQUOTE)$(lisp)/loaddefs.el$(DQUOTE))$(ARGQUOTE) \ From be2038369e2df9fe3d6151b3ade7f7fc75e20d7e Mon Sep 17 00:00:00 2001 From: Luc Teirlinck Date: Sat, 30 Oct 2004 19:49:27 +0000 Subject: [PATCH 004/146] (help-at-pt-timer): Move defvar up to avoid compiler warning. (help-at-pt-timer-delay): Add :initialize and :version keywords. Simplify :set function. (help-at-pt-display-when-idle): Remove autoload. Add :version keyword. --- lisp/ChangeLog | 9 +++++++++ lisp/help-at-pt.el | 27 +++++++++++++++------------ 2 files changed, 24 insertions(+), 12 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 43f98adbef9..01ac54a8815 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2004-10-30 Luc Teirlinck + + * help-at-pt.el (help-at-pt-timer): Move defvar up to avoid + compiler warning. + (help-at-pt-timer-delay): Add :initialize and :version keywords. + Simplify :set function. + (help-at-pt-display-when-idle): Remove autoload. Add :version + keyword. + 2004-10-30 Stefan * makefile.w32-in (custom-deps, autoloads): Fix *-hooks -> *-hook. diff --git a/lisp/help-at-pt.el b/lisp/help-at-pt.el index d6ac6ec3fdc..d55a9a663df 100644 --- a/lisp/help-at-pt.el +++ b/lisp/help-at-pt.el @@ -1,6 +1,6 @@ ;;; help-at-pt.el --- local help through the keyboard -;; Copyright (C) 2003 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2004 Free Software Foundation, Inc. ;; Author: Luc Teirlinck ;; Keywords: help @@ -98,6 +98,13 @@ mainly meant for use from Lisp." (message "%s" help) (if (not arg) (message "No local help at point"))))) +(defvar help-at-pt-timer nil + "Non-nil means that a timer is set that checks for local help. +If non-nil, this is the value returned by the call of +`run-with-idle-timer' that set that timer. This variable is used +internally to enable `help-at-pt-display-when-idle'. Do not set it +yourself.") + (defcustom help-at-pt-timer-delay 1 "*Delay before displaying local help. This is used if `help-at-pt-display-when-idle' is enabled. @@ -112,17 +119,13 @@ active, but if one is already active, Custom will make it use the new value." :group 'help-at-pt :type 'number + :initialize 'custom-initialize-default :set (lambda (variable value) (set-default variable value) - (when (and (boundp 'help-at-pt-timer) help-at-pt-timer) - (timer-set-idle-time help-at-pt-timer value t)))) - -(defvar help-at-pt-timer nil - "Non-nil means that a timer is set that checks for local help. -If non-nil, this is the value returned by the call of -`run-with-idle-timer' that set that timer. This variable is used -internally to enable `help-at-pt-display-when-idle'. Do not set it -yourself.") + (and (boundp 'help-at-pt-timer) + help-at-pt-timer + (timer-set-idle-time help-at-pt-timer value t))) + :version "21.4") ;;;###autoload (defun help-at-pt-cancel-timer () @@ -144,7 +147,6 @@ This is done by setting a timer, if none is currently active." (run-with-idle-timer help-at-pt-timer-delay t #'help-at-pt-maybe-display)))) -;;;###autoload (defcustom help-at-pt-display-when-idle 'never "*Automatically show local help on point-over. If the value is t, the string obtained from any `kbd-help' or @@ -226,7 +228,8 @@ properties, to enable buffer local values." (help-at-pt-cancel-timer) (help-at-pt-set-timer))) :set-after '(help-at-pt-timer-delay) - :require 'help-at-pt) + :require 'help-at-pt + :version "21.4") ;; Function for use in `help-at-pt-set-timer'. (defun help-at-pt-maybe-display () From 0a306700325080346b2e48610d19f3160298288d Mon Sep 17 00:00:00 2001 From: Luc Teirlinck Date: Sat, 30 Oct 2004 20:30:31 +0000 Subject: [PATCH 005/146] (auto-revert-tail-mode-text): Add :version keyword. --- lisp/ChangeLog | 2 ++ lisp/autorevert.el | 3 ++- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 01ac54a8815..40e310beaed 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,7 @@ 2004-10-30 Luc Teirlinck + * autorevert.el (auto-revert-tail-mode-text): Add :version keyword. + * help-at-pt.el (help-at-pt-timer): Move defvar up to avoid compiler warning. (help-at-pt-timer-delay): Add :initialize and :version keywords. diff --git a/lisp/autorevert.el b/lisp/autorevert.el index 5f6d26bfabb..1900d43d9e5 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -172,7 +172,8 @@ When non-nil, a message is generated whenever a file is reverted." \(When the string is not empty, make sure that it has a leading space.)" :group 'auto-revert - :type 'string) + :type 'string + :version "21.4") (defcustom auto-revert-mode-hook nil "Functions to run when Auto-Revert Mode is activated." From 765153997df79fcec1dc8c3961917523bf9d7374 Mon Sep 17 00:00:00 2001 From: Luc Teirlinck Date: Sat, 30 Oct 2004 20:43:36 +0000 Subject: [PATCH 006/146] (help-at-pt-timer-delay, help-at-pt-display-when-idle): Remove erroneously added :version keywords. --- lisp/help-at-pt.el | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/lisp/help-at-pt.el b/lisp/help-at-pt.el index d55a9a663df..2266c8d5a2a 100644 --- a/lisp/help-at-pt.el +++ b/lisp/help-at-pt.el @@ -124,8 +124,7 @@ new value." (set-default variable value) (and (boundp 'help-at-pt-timer) help-at-pt-timer - (timer-set-idle-time help-at-pt-timer value t))) - :version "21.4") + (timer-set-idle-time help-at-pt-timer value t)))) ;;;###autoload (defun help-at-pt-cancel-timer () @@ -228,8 +227,7 @@ properties, to enable buffer local values." (help-at-pt-cancel-timer) (help-at-pt-set-timer))) :set-after '(help-at-pt-timer-delay) - :require 'help-at-pt - :version "21.4") + :require 'help-at-pt) ;; Function for use in `help-at-pt-set-timer'. (defun help-at-pt-maybe-display () From 7c26939b1248d124d3fea7e331e4f33319c4d147 Mon Sep 17 00:00:00 2001 From: Luc Teirlinck Date: Sat, 30 Oct 2004 20:49:41 +0000 Subject: [PATCH 007/146] *** empty log message *** --- lisp/ChangeLog | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 40e310beaed..55f022bf9c9 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -4,10 +4,9 @@ * help-at-pt.el (help-at-pt-timer): Move defvar up to avoid compiler warning. - (help-at-pt-timer-delay): Add :initialize and :version keywords. - Simplify :set function. - (help-at-pt-display-when-idle): Remove autoload. Add :version - keyword. + (help-at-pt-timer-delay): Add :initialize keyword. Simplify :set + function. + (help-at-pt-display-when-idle): Remove autoload. 2004-10-30 Stefan From 162acfa765d1ddd99b6bf97cedcc681a24e4be8b Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Sat, 30 Oct 2004 22:38:12 +0000 Subject: [PATCH 008/146] (group cua): Add :version keyword. (cua-mode): Remove :version keyword. --- lisp/emulation/cua-base.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index 00411c8ca4c..523a07d26de 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -267,6 +267,7 @@ :group 'editing-basics :group 'convenience :group 'emulations + :version "21.4" :link '(emacs-commentary-link :tag "Commentary" "cua-base.el") :link '(emacs-library-link :tag "Lisp File" "cua-base.el")) @@ -1338,7 +1339,6 @@ paste (in addition to the normal emacs bindings)." :set-after '(cua-enable-modeline-indications cua-use-hyper-key) :require 'cua-base :link '(emacs-commentary-link "cua-base.el") - :version "21.4" (setq mark-even-if-inactive t) (setq highlight-nonselected-windows nil) (make-variable-buffer-local 'cua--explicit-region-start) From ad1432eea187fc8092c48b8b07dd9c8955157420 Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Sat, 30 Oct 2004 22:39:27 +0000 Subject: [PATCH 009/146] (group ido): Add :version keyword. (ido-mode): Remove :version keyword. --- lisp/ChangeLog | 8 ++++++++ lisp/ido.el | 2 +- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 55f022bf9c9..ef580f180f4 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,11 @@ +2004-10-31 Kim F. Storm + + * ido.el (group ido): Add :version keyword. + (ido-mode): Remove :version keyword. + + * emulation/cua-base.el (group cua): Add :version keyword. + (cua-mode): Remove :version keyword. + 2004-10-30 Luc Teirlinck * autorevert.el (auto-revert-tail-mode-text): Add :version keyword. diff --git a/lisp/ido.el b/lisp/ido.el index f9066544e1f..8d55887eae5 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -338,6 +338,7 @@ "Switch between files using substrings." :group 'extensions :group 'convenience + :version "21.4" :link '(emacs-commentary-link :tag "Commentary" "ido.el") :link '(emacs-library-link :tag "Lisp File" "ido.el")) @@ -359,7 +360,6 @@ use either \\[customize] or the function `ido-mode'." :require 'ido :link '(emacs-commentary-link "ido.el") :set-after '(ido-save-directory-list-file) - :version "21.4" :type '(choice (const :tag "Turn on only buffer" buffer) (const :tag "Turn on only file" file) (const :tag "Turn on both buffer and file" both) From 1a1a0c4c7352752dcb2654ebd046fd7d2449a04e Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Sun, 31 Oct 2004 00:04:52 +0000 Subject: [PATCH 010/146] *** empty log message *** --- src/ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/ChangeLog b/src/ChangeLog index 8479a0f94ce..1357d586d7e 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2004-10-31 Kim F. Storm + + * dispnew.c (margin_glyphs_to_reserve): Don't use ncols_scale_factor. + 2004-10-28 Will * macterm.c: allow user to assign key modifiers to the Mac Option From 35ec832e6396e6c80aaa7954dacf1adfdb3a818a Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Sun, 31 Oct 2004 00:05:18 +0000 Subject: [PATCH 011/146] (margin_glyphs_to_reserve): Don't use ncols_scale_factor. --- src/dispnew.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dispnew.c b/src/dispnew.c index 903bdaabf3b..69e495d8d8b 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -579,7 +579,7 @@ margin_glyphs_to_reserve (w, total_glyphs, margin) int width = XFASTINT (w->total_cols); double d = max (0, XFLOATINT (margin)); d = min (width / 2 - 1, d); - n = (int) ((double) total_glyphs / width * d) * w->ncols_scale_factor; + n = (int) ((double) total_glyphs / width * d); } else n = 0; From d98410eddd80d95a7df447507b45dcac0269430f Mon Sep 17 00:00:00 2001 From: John Paul Wallington Date: Sun, 31 Oct 2004 01:09:18 +0000 Subject: [PATCH 012/146] (group ibuffer): Add :version keyword. --- lisp/ChangeLog | 4 ++++ lisp/ibuffer.el | 1 + 2 files changed, 5 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ef580f180f4..ff85283bcc9 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2004-10-31 John Paul Wallington + + * ibuffer.el (group ibuffer): Add :version keyword. + 2004-10-31 Kim F. Storm * ido.el (group ido): Add :version keyword. diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 30c97a383d3..6dce953df0f 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -45,6 +45,7 @@ Ibuffer allows you to operate on buffers in a manner much like Dired. Operations include sorting, marking by regular expression, and the ability to filter the displayed buffers by various criteria." + :version "21.4" :group 'convenience) (defcustom ibuffer-formats '((mark modified read-only " " (name 18 18 :left :elide) From 67156185a714845d5815edd518165dda5b297bf4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Sun, 31 Oct 2004 08:33:38 +0000 Subject: [PATCH 013/146] * x-dnd.el (x-dnd-test-function, x-dnd-protocol-alist) (x-dnd-types-alist, x-dnd-open-file-other-window) (x-dnd-known-types): Add :version. --- lisp/ChangeLog | 6 ++++++ lisp/x-dnd.el | 5 +++++ 2 files changed, 11 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ff85283bcc9..8e4994f1800 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2004-10-31 Jan Dj,Ad(Brv + + * x-dnd.el (x-dnd-test-function, x-dnd-protocol-alist) + (x-dnd-types-alist, x-dnd-open-file-other-window) + (x-dnd-known-types): Add :version. + 2004-10-31 John Paul Wallington * ibuffer.el (group ibuffer): Add :version keyword. diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index 0f9237f3409..f2b081fdcc5 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -47,6 +47,7 @@ The function shall return nil to reject the drop or a cons with two values, the wanted action as car and the wanted type as cdr. The wanted action can be copy, move, link, ask or private. The default value for this variable is `x-dnd-default-test-function'." + :version "21.4" :type 'symbol :group 'x) @@ -69,6 +70,7 @@ Insertion of text is not handeled by these functions, see `x-dnd-types-alist' for that. The function shall return the action done (move, copy, link or private) if some action was made, or nil if the URL is ignored." + :version "21.4" :type 'alist :group 'x) @@ -96,11 +98,13 @@ this drop (copy, move, link, private or ask) as determined by a previous call to `x-dnd-test-function'. DATA is the drop data. The function shall return the action used (copy, move, link or private) if drop is successful, nil if not." + :version "21.4" :type 'alist :group 'x) (defcustom x-dnd-open-file-other-window nil "If non-nil, always use find-file-other-window to open dropped files." + :version "21.4" :type 'boolean :group 'x) @@ -120,6 +124,7 @@ is successful, nil if not." ) "The types accepted by default for dropped data. The types are chosen in the order they appear in the list." + :version "21.4" :type '(repeat string) :group 'x ) From fcdb28b473b74bd2a2d79675280764d3abde0659 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Sun, 31 Oct 2004 12:25:46 +0000 Subject: [PATCH 014/146] * atimer.c (alarm_signal_handler): Do not call set_alarm if pending_atmers is non-zero. --- src/ChangeLog | 5 +++++ src/atimer.c | 3 ++- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/src/ChangeLog b/src/ChangeLog index 1357d586d7e..8de855df2e3 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2004-10-31 Jan Dj,Ad(Brv + + * atimer.c (alarm_signal_handler): Do not call set_alarm if + pending_atmers is non-zero. + 2004-10-31 Kim F. Storm * dispnew.c (margin_glyphs_to_reserve): Don't use ncols_scale_factor. diff --git a/src/atimer.c b/src/atimer.c index 9ec0238ff28..7410cad0244 100644 --- a/src/atimer.c +++ b/src/atimer.c @@ -397,7 +397,8 @@ alarm_signal_handler (signo) EMACS_GET_TIME (now); } - set_alarm (); + if (! pending_atimers) + set_alarm (); } From 12e6566a256a5c18a018645e6cbd461eb8662e62 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Sun, 31 Oct 2004 15:11:31 +0000 Subject: [PATCH 015/146] * xdisp.c (update_tool_bar): Pass a copy of f->tool_bar_items to tool_bar_items and assign the result to f->tool_bar_items if not equal. Move BLOCK/UNBLOCK_INPUT from around call to tool_bar_items to assignment of result. --- src/ChangeLog | 5 +++++ src/xdisp.c | 25 ++++++++++++++++--------- 2 files changed, 21 insertions(+), 9 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 8de855df2e3..76a6676a0cf 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,10 @@ 2004-10-31 Jan Dj,Ad(Brv + * xdisp.c (update_tool_bar): Pass a copy of f->tool_bar_items to + tool_bar_items and assign the result to f->tool_bar_items if + not equal. Move BLOCK/UNBLOCK_INPUT from around call to + tool_bar_items to assignment of result. + * atimer.c (alarm_signal_handler): Do not call set_alarm if pending_atmers is non-zero. diff --git a/src/xdisp.c b/src/xdisp.c index df68ab80eff..dfb2e8198a5 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -8416,7 +8416,8 @@ update_tool_bar (f, save_match_data) { struct buffer *prev = current_buffer; int count = SPECPDL_INDEX (); - Lisp_Object old_tool_bar; + Lisp_Object new_tool_bar; + int new_n_tool_bar; struct gcpro gcpro1; /* Set current_buffer to the buffer of the selected @@ -8435,18 +8436,24 @@ update_tool_bar (f, save_match_data) specbind (Qoverriding_local_map, Qnil); } - old_tool_bar = f->tool_bar_items; - GCPRO1 (old_tool_bar); + GCPRO1 (new_tool_bar); /* Build desired tool-bar items from keymaps. */ - BLOCK_INPUT; - f->tool_bar_items - = tool_bar_items (f->tool_bar_items, &f->n_tool_bar_items); - UNBLOCK_INPUT; + new_tool_bar = tool_bar_items (Fcopy_sequence (f->tool_bar_items), + &new_n_tool_bar); /* Redisplay the tool-bar if we changed it. */ - if (! NILP (Fequal (old_tool_bar, f->tool_bar_items))) - w->update_mode_line = Qt; + if (NILP (Fequal (new_tool_bar, f->tool_bar_items))) + { + /* Redisplay that happens asynchronously due to an expose event + may access f->tool_bar_items. Make sure we update both + variables within BLOCK_INPUT so no such event interrupts. */ + BLOCK_INPUT; + f->tool_bar_items = new_tool_bar; + f->n_tool_bar_items = new_n_tool_bar; + w->update_mode_line = Qt; + UNBLOCK_INPUT; + } UNGCPRO; From 495ef86be2c07050a83606ccc476fc3a2cf6479f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Sun, 31 Oct 2004 15:29:04 +0000 Subject: [PATCH 016/146] * xmenu.c: Add prototypes for forward function declarations. (popup_get_selection): Remove parameter do_timers, remove call to timer_check. (create_and_show_popup_menu, create_and_show_dialog): Remove parameter do_timers from call to popup_get_selection. --- src/ChangeLog | 6 ++++++ src/xmenu.c | 24 +++++++++--------------- 2 files changed, 15 insertions(+), 15 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 76a6676a0cf..77f6f2d073f 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,11 @@ 2004-10-31 Jan Dj,Ad(Brv + * xmenu.c: Add prototypes for forward function declarations. + (popup_get_selection): Remove parameter do_timers, remove call to + timer_check. + (create_and_show_popup_menu, create_and_show_dialog): Remove + parameter do_timers from call to popup_get_selection. + * xdisp.c (update_tool_bar): Pass a copy of f->tool_bar_items to tool_bar_items and assign the result to f->tool_bar_items if not equal. Move BLOCK/UNBLOCK_INPUT from around call to diff --git a/src/xmenu.c b/src/xmenu.c index b722b245af9..371ae14f12e 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -110,11 +110,12 @@ extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map; extern Lisp_Object Qmenu_bar_update_hook; #ifdef USE_X_TOOLKIT -extern void set_frame_menubar (); +extern void set_frame_menubar P_ ((FRAME_PTR, int, int)); extern XtAppContext Xt_app_con; -static Lisp_Object xdialog_show (); -static void popup_get_selection (); +static Lisp_Object xdialog_show P_ ((FRAME_PTR, int, Lisp_Object, char **)); +static void popup_get_selection P_ ((XEvent *, struct x_display_info *, + LWLIB_ID, int)); /* Define HAVE_BOXES if menus can handle radio and toggle buttons. */ @@ -124,8 +125,8 @@ static void popup_get_selection (); #ifdef USE_GTK #include "gtkutil.h" #define HAVE_BOXES 1 -extern void set_frame_menubar (); -static Lisp_Object xdialog_show (); +extern void set_frame_menubar P_ ((FRAME_PTR, int, int)); +static Lisp_Object xdialog_show P_ ((FRAME_PTR, int, Lisp_Object, char **)); #endif /* This is how to deal with multibyte text if HAVE_MULTILINGUAL_MENU @@ -156,7 +157,6 @@ static void single_keymap_panes P_ ((Lisp_Object, Lisp_Object, Lisp_Object, static void list_of_panes P_ ((Lisp_Object)); static void list_of_items P_ ((Lisp_Object)); -extern EMACS_TIME timer_check P_ ((int)); /* This holds a Lisp vector that holds the results of decoding the keymaps or alist-of-alists that specify a menu. @@ -1128,21 +1128,16 @@ on the left of the dialog box and all following items on the right. #ifdef USE_X_TOOLKIT static void -popup_get_selection (initial_event, dpyinfo, id, do_timers, down_on_keypress) +popup_get_selection (initial_event, dpyinfo, id, down_on_keypress) XEvent *initial_event; struct x_display_info *dpyinfo; LWLIB_ID id; - int do_timers; int down_on_keypress; { XEvent event; while (popup_activated_flag) { - /* If we have no events to run, consider timers. */ - if (do_timers && !XtAppPending (Xt_app_con)) - timer_check (1); - if (initial_event) { event = *initial_event; @@ -2489,7 +2484,7 @@ create_and_show_popup_menu (f, first_wv, x, y, for_click) popup_activated_flag = 1; /* Process events that apply to the menu. */ - popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), menu_id, 0, 0); + popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), menu_id, 0); /* fp turned off the following statement and wrote a comment that it is unnecessary--that the menu has already disappeared. @@ -2883,8 +2878,7 @@ create_and_show_dialog (f, first_wv) Fcons (make_number (dialog_id >> (fact)), make_number (dialog_id & ~(-1 << (fact))))); - popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), - dialog_id, 1, 1); + popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id, 1); unbind_to (count, Qnil); } From e0dc0c55b07dc64a13a90865beb403bad7dac672 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 31 Oct 2004 22:25:34 +0000 Subject: [PATCH 017/146] Use `button's. (bibtex-autokey-transcriptions): Translate TeX `\ ' to space. (bibtex-reference-keys): Distinguish between header keys and crossref keys. (bibtex-beginning-of-field): New function. (bibtex-url-map): Remove. (bibtex-font-lock-keywords): Use bibtex-font-lock-crossref. (bibtex-font-lock-url-regexp): Assume that field names begin at the beginning of a line. (bibtex-font-lock-url): Simplify. Do not use bibtex-enclosing-field. Remove field delimiters. Bugfix, point can be inside a field with a url. Use bibtex-beginning-of-field. (bibtex-font-lock-crossref, bibtex-button-action, bibtex-button): New funs. (bibtex-mark-active, bibtex-run-with-idle-timer): Remove. (bibtex-key-in-head): Simplify. (bibtex-current-line): Use bolp. (bibtex-parse-keys): Remove unused arg `add'. Use bibtex-type-in-head and bibtex-key-in-head. (bibtex-parse-entry, bibtex-autofill-entry): Use bibtex-type-in-head and bibtex-key-in-head. (bibtex-autokey-get-field): Do not alter case of replacement text. (bibtex-autokey-get-names): Do all processing of name list. (bibtex-autokey-get-year): New function. (bibtex-autokey-get-title): Do all processing of title words. (bibtex-generate-autokey): Simplify. (bibtex-string-files-init): Use default-directory. Allow for absolute file names in bibtex-string-files. (bibtex-files, bibtex-file-path): New variables. (bibtex-files-expand): New function. (bibtex-find-entry-globally): New command. (bibtex-summary-function): New variable. (bibtex-summary): Default value of bibtex-summary-function. (bibtex-find-crossref): New optional args pnt and split. (bibtex-complete-key-cleanup): Call bibtex-summary-function. (bibtex-copy-summary-as-kill): New command bound to C-cC-t. (bibtex-validate): Fix docstring. Check only abbreviated month fields. Fix handling of required and alternative fields. Identify duplicate keys even if bibtex-maintain-sorted-entries is nil. Use cons and display-buffer. (bibtex-validate-globally): New command. (bibtex-clean-entry): Use bibtex-files-expand. Do not call bibtex-parse-keys and bibtex-parse-strings for updating bibtex-reference-keys and bibtex-strings. (bibtex-realign): Remove blank lines past the last entry. (bibtex-reformat): Use bibtex-entry-format as default. (bibtex-choose-completion-string): Remove. (bibtex-complete): Do not use bibtex-choose-completion-string. (bibtex-url): Simplify. --- etc/NEWS | 22 +- lisp/ChangeLog | 52 ++ lisp/textmodes/bibtex.el | 1170 +++++++++++++++++++++++--------------- 3 files changed, 777 insertions(+), 467 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 27e3d815f3c..bb3d762f8b9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -643,14 +643,17 @@ version 4.7 or newer, compiles to Info pages with embedded images. ** BibTeX mode: *** The new command bibtex-url browses a URL for the BibTeX entry at -point (bound to C-c C-l and mouse-2 on clickable fields). +point (bound to C-c C-l and mouse-2, RET on clickable fields). + *** The new command bibtex-entry-update (bound to C-c C-u) updates an existing BibTeX entry. + *** New `bibtex-entry-format' option `required-fields', enabled by default. + *** bibtex-maintain-sorted-entries can take values `plain', `crossref', and `entry-class' which control the sorting scheme used -for BibTeX entries. `bibtex-sort-entry-class' controls the sorting -scheme `entry-class'. TAB completion for reference keys and +for BibTeX entries. `bibtex-sort-entry-class' controls the sorting +scheme `entry-class'. TAB completion for reference keys and automatic detection of duplicates does not require anymore that bibtex-maintain-sorted-entries is non-nil. @@ -667,11 +670,22 @@ types for which fields are filled automatically (if possible). point according to context (bound to M-tab). *** The new commands bibtex-find-entry and bibtex-find-crossref -locate entries and crossref'd entries. +locate entries and crossref'd entries. Crossref fields are clickable +(bound to mouse-2, RET). *** In BibTeX mode the command fill-paragraph (bound to M-q) fills individual fields of a BibTeX entry. +*** The new command bibtex-validate-globally checks for duplicate keys +in multiple BibTeX files. See also the new variables bibtex-files +and bibtex-file-path. + +*** The new command bibtex-find-entry-globally searches BibTeX entries +in multiple BibTeX files. + +*** The new command bibtex-copy-summary-as-kill pushes summary +of BibTeX entry to kill ring (bound to C-c C-t). + ** When display margins are present in a window, the fringes are now displayed between the margins and the buffer's text area, rather than at the edges of the window. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 8e4994f1800..88104f310d8 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,55 @@ +2004-10-31 Roland Winkler + + * textmodes/bibtex.el: Require button. + (bibtex-autokey-transcriptions): Translate TeX `\ ' to space. + (bibtex-reference-keys): Distinguish between header keys and + crossref keys. + (bibtex-beginning-of-field): New function. + (bibtex-url-map): Remove. + (bibtex-font-lock-keywords): Use bibtex-font-lock-crossref. + (bibtex-font-lock-url-regexp): Assume that field names begin at + the beginning of a line. + (bibtex-font-lock-url): Simplify. Do not use bibtex-enclosing-field. + Remove field delimiters. Use bibtex-beginning-of-field. + Bugfix, point can be inside a field with a url. + (bibtex-font-lock-crossref, bibtex-button-action, bibtex-button): + New functions. + (bibtex-mark-active, bibtex-run-with-idle-timer): Remove. + (bibtex-key-in-head): Simplify. + (bibtex-current-line): Use bolp. + (bibtex-parse-keys): Remove unused arg `add'. + Use bibtex-type-in-head and bibtex-key-in-head. + (bibtex-parse-entry, bibtex-autofill-entry): + Use bibtex-type-in-head and bibtex-key-in-head. + (bibtex-autokey-get-field): Do not alter case of replacement text. + (bibtex-autokey-get-names): Do all processing of name list. + (bibtex-autokey-get-year): New function. + (bibtex-autokey-get-title): Do all processing of title words. + (bibtex-generate-autokey): Simplify. + (bibtex-string-files-init): Use default-directory. + Allow for absolute file names in bibtex-string-files. + (bibtex-files, bibtex-file-path): New variables. + (bibtex-files-expand): New function. + (bibtex-find-entry-globally): New command. + (bibtex-summary-function): New variable. + (bibtex-summary): Default value of bibtex-summary-function. + (bibtex-find-crossref): New optional args pnt and split. + (bibtex-complete-key-cleanup): Call bibtex-summary-function. + (bibtex-copy-summary-as-kill): New command bound to C-cC-t. + (bibtex-validate): Fix docstring. Check only abbreviated month fields. + Fix handling of required and alternative fields. + Identify duplicate keys even if bibtex-maintain-sorted-entries is nil. + Use cons and display-buffer. + (bibtex-validate-globally): New command. + (bibtex-clean-entry): Use bibtex-files-expand. Do not call + bibtex-parse-keys and bibtex-parse-strings for updating + bibtex-reference-keys and bibtex-strings. + (bibtex-realign): Remove blank lines past the last entry. + (bibtex-reformat): Use bibtex-entry-format as default. + (bibtex-choose-completion-string): Remove. + (bibtex-complete): Do not use bibtex-choose-completion-string. + (bibtex-url): Simplify. + 2004-10-31 Jan Dj,Ad(Brv * x-dnd.el (x-dnd-test-function, x-dnd-protocol-alist) diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index ddc1d4ecb62..3601fbd7d26 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -42,6 +42,8 @@ ;;; Code: +(require 'button) + ;; User Options: @@ -496,7 +498,7 @@ Each element is a pair of strings (ABBREVIATION . EXPANSION)." (defcustom bibtex-string-files nil "*List of BibTeX files containing string definitions. -Those files must be specified using pathnames relative to the +List elements can be absolute file names or file names relative to the directories specified in `bibtex-string-file-path'." :group 'bibtex :type '(repeat file)) @@ -504,6 +506,18 @@ directories specified in `bibtex-string-file-path'." (defvar bibtex-string-file-path (getenv "BIBINPUTS") "*Colon separated list of paths to search for `bibtex-string-files'.") +(defcustom bibtex-files nil + "*List of BibTeX files checked for duplicate keys. +List elements can be absolute file names or file names relative to the +directories specified in `bibtex-file-path'. If an element is a directory, +check all BibTeX files in this directory. If an element is the symbol +`bibtex-file-path', check all BibTeX files in `bibtex-file-path'." + :group 'bibtex + :type '(repeat file)) + +(defvar bibtex-file-path (getenv "BIBINPUTS") + "*Colon separated list of paths to search for `bibtex-files'.") + (defcustom bibtex-help-message t "*If non-nil print help messages in the echo area on entering a new field." :group 'bibtex @@ -557,7 +571,7 @@ See `bibtex-generate-autokey' for details." ;; braces, quotes, concatenation. ("[`'\"{}#]" . "") ;; spaces - ("[ \t\n]+" . " ")) + ("\\\\?[ \t\n]+\\|~" . " ")) "Alist of (OLD-REGEXP . NEW-STRING) pairs. Used by the default values of `bibtex-autokey-name-change-strings' and `bibtex-autokey-titleword-change-strings'. Defaults to translating some @@ -756,12 +770,22 @@ If non-nil, the column for the equal sign is the value of (defcustom bibtex-autoadd-commas t "If non-nil automatically add missing commas at end of BibTeX fields." + :group 'bibtex :type 'boolean) (defcustom bibtex-autofill-types '("Proceedings") "Automatically fill fields if possible for those BibTeX entry types." + :group 'bibtex :type '(repeat string)) +(defcustom bibtex-summary-function 'bibtex-summary + "Function to call for generating a one-line summary of a BibTeX entry. +It takes one argument, the key of the entry. +Used by `bibtex-complete-key-cleanup' and `bibtex-copy-summary-as-kill'." + :group 'bibtex + :type '(choice (const :tag "Default" bibtex-summary) + (function :tag "Personalized function"))) + (defcustom bibtex-generate-url-list '((("url" . ".*:.*")) ;; Example of a complex setup. @@ -778,7 +802,7 @@ These schemes are used by `bibtex-url'. Each scheme is of the form ((FIELD . REGEXP) STEP...). FIELD is a field name as returned by `bibtex-parse-entry'. -REGEXP is matched against the text of FIELD. If the match succeed, then +REGEXP is matched against the text of FIELD. If the match succeeds, then this scheme will be used. If no STEPS are specified the matched text is used as the URL, otherwise the URL is built by concatenating the STEPS. @@ -838,6 +862,7 @@ Case is always ignored. Always remove the field delimiters." (define-key km "\C-c\C-c" 'bibtex-clean-entry) (define-key km "\C-c\C-q" 'bibtex-fill-entry) (define-key km "\C-c\C-s" 'bibtex-find-entry) + (define-key km "\C-c\C-t" 'bibtex-copy-summary-as-kill) (define-key km "\C-c?" 'bibtex-print-help-message) (define-key km "\C-c\C-p" 'bibtex-pop-previous) (define-key km "\C-c\C-n" 'bibtex-pop-next) @@ -892,7 +917,9 @@ Case is always ignored. Always remove the field delimiters." ("Moving in BibTeX Buffer" ["Find Entry" bibtex-find-entry t] ["Find Crossref Entry" bibtex-find-crossref t]) - "--" + ("Moving between BibTeX Buffers" + ["Find Entry Globally" bibtex-find-entry-globally t]) + "--" ("Operating on Current Field" ["Fill Field" fill-paragraph t] ["Remove Delimiters" bibtex-remove-delimiters t] @@ -922,6 +949,8 @@ Case is always ignored. Always remove the field delimiters." ["Paste Most Recently Killed Entry" bibtex-yank t] ["Paste Previously Killed Entry" bibtex-yank-pop t] "--" + ["Copy Summary to Kill Ring" bibtex-copy-summary-as-kill t] + "--" ["Ispell Entry" bibtex-ispell-entry t] ["Ispell Entry Abstract" bibtex-ispell-abstract t] ["Narrow to Entry" bibtex-narrow-to-entry t] @@ -934,7 +963,9 @@ Case is always ignored. Always remove the field delimiters." ["Reformat Entries" bibtex-reformat t] ["Count Entries" bibtex-count-entries t] "--" - ["Convert Alien Buffer" bibtex-convert-alien t]))) + ["Convert Alien Buffer" bibtex-convert-alien t]) + ("Operating on Multiple Buffers" + ["Validate Entries" bibtex-validate-globally t]))) (easy-menu-define bibtex-entry-menu bibtex-mode-map "Entry-Types Menu in BibTeX mode" @@ -955,13 +986,6 @@ Case is always ignored. Always remove the field delimiters." ["String" bibtex-String t] ["Preamble" bibtex-Preamble t])) -(defvar bibtex-url-map - (let ((km (make-sparse-keymap))) - (define-key km [(mouse-2)] 'bibtex-url) - km) - "Local keymap for clickable URLs.") -(fset 'bibtex-url-map bibtex-url-map) - ;; Internal Variables @@ -996,8 +1020,9 @@ Initialized from `bibtex-predefined-strings' and `bibtex-string-files'.") (make-variable-buffer-local 'bibtex-strings) (defvar bibtex-reference-keys - (lazy-completion-table bibtex-reference-keys bibtex-parse-keys nil nil t) - "Completion table for BibTeX reference keys.") + (lazy-completion-table bibtex-reference-keys bibtex-parse-keys nil t) + "Completion table for BibTeX reference keys. +The CDRs of the elements are t for header keys and nil for crossref keys.") (make-variable-buffer-local 'bibtex-reference-keys) (defvar bibtex-buffer-last-parsed-tick nil @@ -1103,13 +1128,13 @@ Initialized from `bibtex-predefined-strings' and `bibtex-string-files'.") (,(concat "^[ \t]*\\(" bibtex-field-name "\\)[ \t]*=") 1 font-lock-variable-name-face) ;; url - (bibtex-font-lock-url 0 '(face nil mouse-face highlight - keymap bibtex-url-map))) + bibtex-font-lock-url bibtex-font-lock-crossref) "*Default expressions to highlight in BibTeX mode.") (defvar bibtex-font-lock-url-regexp - (concat "\\<" (regexp-opt (mapcar 'caar bibtex-generate-url-list) t) - "\\>[ \t]*=[ \t]*") + ;; Assume that field names begin at the beginning of a line. + (concat "^[ \t]*" (regexp-opt (mapcar 'caar bibtex-generate-url-list) t) + "[ \t]*=[ \t]*") "Regexp for `bibtex-font-lock-url'.") (defvar bibtex-field-name-for-parsing nil @@ -1127,33 +1152,13 @@ Passed by dynamic scoping.") Auto-generated from `bibtex-sort-entry-class'. Used when `bibtex-maintain-sorted-entries' is `entry-class'.") - -;; Special support taking care of variants -(defvar zmacs-regions) -(defalias 'bibtex-mark-active - (if (boundp 'mark-active) - ;; In Emacs mark-active indicates if mark is active. - (lambda () mark-active) - ;; In XEmacs (mark) returns nil when not active. - (lambda () (if zmacs-regions (mark) (mark t))))) - -(defalias 'bibtex-run-with-idle-timer - (if (fboundp 'run-with-idle-timer) - ;; timer.el is distributed with Emacs - 'run-with-idle-timer - ;; timer.el is not distributed with XEmacs - ;; Notice that this does not (yet) pass the arguments, but they - ;; are not used (yet) in bibtex.el. Fix if needed. - (lambda (secs repeat function &rest args) - (start-itimer "bibtex" function secs (if repeat secs nil) t)))) - ;; Support for hideshow minor mode (defun bibtex-hs-forward-sexp (arg) "Replacement for `forward-sexp' to be used by `hs-minor-mode'. ARG is ignored." (if (looking-at "@\\S(*\\s(") - (goto-char (1- (match-end 0)))) + (goto-char (1- (match-end 0)))) (forward-sexp 1)) (add-to-list @@ -1471,12 +1476,10 @@ delimiters if present." (buffer-substring-no-properties (1+ (match-beginning bibtex-type-in-head)) (match-end bibtex-type-in-head))) -(defun bibtex-key-in-head (&optional empty) +(defsubst bibtex-key-in-head (&optional empty) "Extract BibTeX key in head. Return optional arg EMPTY if key is empty." - (if (match-beginning bibtex-key-in-head) - (buffer-substring-no-properties (match-beginning bibtex-key-in-head) - (match-end bibtex-key-in-head)) - empty)) + (or (match-string-no-properties bibtex-key-in-head) + empty)) ;; Helper Functions @@ -1492,7 +1495,7 @@ delimiters if present." (defun bibtex-current-line () "Compute line number of point regardless whether the buffer is narrowed." (+ (count-lines 1 (point)) - (if (equal (current-column) 0) 1 0))) + (if (bolp) 1 0))) (defun bibtex-skip-to-valid-entry (&optional backward) "Move point to beginning of the next valid BibTeX entry. @@ -1525,24 +1528,25 @@ entry is found, nil otherwise." found)) (defun bibtex-map-entries (fun) - "Call FUN for each BibTeX entry starting with the current. -Do this to the end of the file. FUN is called with three arguments, the key of -the entry and the buffer positions (marker) of beginning and end of entry. -Point is inside the entry. If `bibtex-sort-ignore-string-entries' is non-nil, -FUN will not be called for @String entries." + "Call FUN for each BibTeX entry in buffer (possibly narrowed). +FUN is called with three arguments, the key of the entry and the buffer +positions (marker) of beginning and end of entry. Point is inside the entry. +If `bibtex-sort-ignore-string-entries' is non-nil, FUN will not be called for +@String entries." (let ((case-fold-search t)) - (bibtex-beginning-of-entry) - (while (re-search-forward bibtex-entry-head nil t) - (let ((entry-type (bibtex-type-in-head)) - (key (bibtex-key-in-head "")) - (beg (copy-marker (match-beginning 0))) - (end (copy-marker (save-excursion (bibtex-end-of-entry))))) - (save-excursion - (if (or (and (not bibtex-sort-ignore-string-entries) - (bibtex-string= entry-type "string")) - (assoc-string entry-type bibtex-entry-field-alist t)) - (funcall fun key beg end))) - (goto-char end))))) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward bibtex-entry-head nil t) + (let ((entry-type (bibtex-type-in-head)) + (key (bibtex-key-in-head "")) + (beg (copy-marker (match-beginning 0))) + (end (copy-marker (save-excursion (bibtex-end-of-entry))))) + (save-excursion + (if (or (and (not bibtex-sort-ignore-string-entries) + (bibtex-string= entry-type "string")) + (assoc-string entry-type bibtex-entry-field-alist t)) + (funcall fun key beg end))) + (goto-char end)))))) (defun bibtex-progress-message (&optional flag interval) "Echo a message about progress of current buffer. @@ -1581,13 +1585,13 @@ If FLAG is nil, a message is echoed if point was incremented at least "\"")) (defun bibtex-entry-left-delimiter () - "Return a string dependent on `bibtex-field-delimiters'." + "Return a string dependent on `bibtex-entry-delimiters'." (if (equal bibtex-entry-delimiters 'braces) "{" "(")) (defun bibtex-entry-right-delimiter () - "Return a string dependent on `bibtex-field-delimiters'." + "Return a string dependent on `bibtex-entry-delimiters'." (if (equal bibtex-entry-delimiters 'braces) "}" ")")) @@ -1641,7 +1645,7 @@ are defined, but only for the head part of the entry (setq infix-start (bibtex-end-of-field bounds)) (setq finished t)) (goto-char infix-start)) - ;; This matches the infix* part. The AND construction assures + ;; This matches the infix* part. The AND construction assures ;; that BOUND is respected. (when (and (looking-at bibtex-entry-postfix) (eq (char-before (match-end 0)) entry-closer) @@ -1826,8 +1830,8 @@ Formats current entry according to variable `bibtex-entry-format'." (cdr field))) (cdr field)) req-field-list (if crossref-key - (nth 0 (nth 2 entry-list)) ; crossref part - (nth 0 (nth 1 entry-list)))) ; required part + (nth 0 (nth 2 entry-list)) ; crossref part + (nth 0 (nth 1 entry-list)))) ; required part (dolist (rfield req-field-list) (when (nth 3 rfield) ; we should have an alternative @@ -1864,9 +1868,9 @@ Formats current entry according to variable `bibtex-entry-format'." deleted) ;; We have more elegant high-level functions for several - ;; tasks done by bibtex-format-entry. However, they contain + ;; tasks done by bibtex-format-entry. However, they contain ;; quite some redundancy compared with what we need to do - ;; anyway. So for speed-up we avoid using them. + ;; anyway. So for speed-up we avoid using them. (if (memq 'opts-or-alts format) (cond ((and empty-field @@ -1875,8 +1879,8 @@ Formats current entry according to variable `bibtex-entry-format'." field-name req-field-list t))) (or (not field) ; OPT field (nth 3 field))))) ; ALT field - ;; Either it is an empty ALT field. Then we have checked - ;; already that we have one non-empty alternative. Or it + ;; Either it is an empty ALT field. Then we have checked + ;; already that we have one non-empty alternative. Or it ;; is an empty OPT field that we do not miss anyway. ;; So we can safely delete this field. (delete-region beg-field end-field) @@ -2041,19 +2045,33 @@ applied to the content of FIELD. It is an alist with pairs (dolist (pattern change-list content) (setq content (replace-regexp-in-string (car pattern) (cdr pattern) - content))))) + content t))))) (defun bibtex-autokey-get-names () "Get contents of the name field of the current entry. -Do some modifications based on `bibtex-autokey-name-change-strings' -and return results as a list." - (let ((case-fold-search t) - (names (bibtex-autokey-get-field "author\\|editor" +Do some modifications based on `bibtex-autokey-name-change-strings'. +Return the names as a concatenated string obeying `bibtex-autokey-names' +and `bibtex-autokey-names-stretch'." + (let ((names (bibtex-autokey-get-field "author\\|editor" bibtex-autokey-name-change-strings))) ;; Some entries do not have a name field. (unless (string= "" names) - (mapcar 'bibtex-autokey-demangle-name - (split-string names "[ \t\n]+and[ \t\n]+"))))) + (let* ((case-fold-search t) + (name-list (mapcar 'bibtex-autokey-demangle-name + (split-string names "[ \t\n]+and[ \t\n]+"))) + additional-names) + (unless (or (not (numberp bibtex-autokey-names)) + (<= (length name-list) + (+ bibtex-autokey-names + bibtex-autokey-names-stretch))) + ;; Take bibtex-autokey-names elements from beginning of name-list + (setq name-list (nreverse (nthcdr (- (length name-list) + bibtex-autokey-names) + (nreverse name-list))) + additional-names bibtex-autokey-additional-names)) + (concat (mapconcat 'identity name-list + bibtex-autokey-name-separator) + additional-names))))) (defun bibtex-autokey-demangle-name (fullname) "Get the last part from a well-formed FULLNAME and perform abbreviations." @@ -2082,8 +2100,15 @@ and return results as a list." (funcall bibtex-autokey-name-case-convert name) bibtex-autokey-name-length))) +(defun bibtex-autokey-get-year () + "Return year field contents as a string obeying `bibtex-autokey-year-length'." + (let ((yearfield (bibtex-autokey-get-field "year"))) + (substring yearfield (max 0 (- (length yearfield) + bibtex-autokey-year-length))))) + (defun bibtex-autokey-get-title () - "Get title field contents up to a terminator." + "Get title field contents up to a terminator. +Return the result as a string" (let ((case-fold-search t) (titlestring (bibtex-autokey-get-field "title" @@ -2092,35 +2117,37 @@ and return results as a list." (dolist (terminator bibtex-autokey-title-terminators) (if (string-match terminator titlestring) (setq titlestring (substring titlestring 0 (match-beginning 0))))) - ;; gather words from titlestring into a list. Ignore + ;; gather words from titlestring into a list. Ignore ;; specific words and use only a specific amount of words. (let ((counter 0) - titlewords titlewords-extra titleword end-match) + titlewords titlewords-extra word) (while (and (or (not (numberp bibtex-autokey-titlewords)) (< counter (+ bibtex-autokey-titlewords bibtex-autokey-titlewords-stretch))) (string-match "\\b\\w+" titlestring)) - (setq end-match (match-end 0) - titleword (substring titlestring - (match-beginning 0) end-match)) + (setq word (match-string 0 titlestring) + titlestring (substring titlestring (match-end 0))) + ;; Ignore words matched by one of the elements of + ;; bibtex-autokey-titleword-ignore (unless (let ((lst bibtex-autokey-titleword-ignore)) (while (and lst (not (string-match (concat "\\`\\(?:" (car lst) - "\\)\\'") titleword))) + "\\)\\'") word))) (setq lst (cdr lst))) lst) - (setq titleword - (funcall bibtex-autokey-titleword-case-convert titleword)) + (setq word (funcall bibtex-autokey-titleword-case-convert word) + counter (1+ counter)) (if (or (not (numberp bibtex-autokey-titlewords)) (< counter bibtex-autokey-titlewords)) - (setq titlewords (append titlewords (list titleword))) - (setq titlewords-extra - (append titlewords-extra (list titleword)))) - (setq counter (1+ counter))) - (setq titlestring (substring titlestring end-match))) + (push word titlewords) + (push word titlewords-extra)))) + ;; Obey bibtex-autokey-titlewords-stretch: + ;; If by now we have processed all words in titlestring, we include + ;; titlewords-extra in titlewords. Otherwise, we ignore titlewords-extra. (unless (string-match "\\b\\w+" titlestring) - (setq titlewords (append titlewords titlewords-extra))) - (mapcar 'bibtex-autokey-demangle-title titlewords)))) + (setq titlewords (append titlewords-extra titlewords))) + (mapconcat 'bibtex-autokey-demangle-title (nreverse titlewords) + bibtex-autokey-titleword-separator)))) (defun bibtex-autokey-demangle-title (titleword) "Do some abbreviations on TITLEWORD. @@ -2211,65 +2238,36 @@ The generation algorithm works as follows: the key is then presented in the minibuffer to the user, where it can be edited. The key given by the user is then used." - (let* ((name-etal "") - (namelist - (let ((nl (bibtex-autokey-get-names)) - nnl) - (if (or (not (numberp bibtex-autokey-names)) - (<= (length nl) - (+ bibtex-autokey-names - bibtex-autokey-names-stretch))) - nl - (setq name-etal bibtex-autokey-additional-names) - (while (< (length nnl) bibtex-autokey-names) - (setq nnl (append nnl (list (car nl))) - nl (cdr nl))) - nnl))) - (namepart (concat (mapconcat 'identity - namelist - bibtex-autokey-name-separator) - name-etal)) - (yearfield (bibtex-autokey-get-field "year")) - (yearpart (if (equal yearfield "") - "" - (substring yearfield - (- (length yearfield) - bibtex-autokey-year-length)))) - (titlepart (mapconcat 'identity - (bibtex-autokey-get-title) - bibtex-autokey-titleword-separator)) + (let* ((names (bibtex-autokey-get-names)) + (year (bibtex-autokey-get-year)) + (title (bibtex-autokey-get-title)) (autokey (concat bibtex-autokey-prefix-string - namepart - (unless (or (equal namepart "") - (equal yearpart "")) + names + (unless (or (equal names "") + (equal year "")) bibtex-autokey-name-year-separator) - yearpart - (unless (or (and (equal namepart "") - (equal yearpart "")) - (equal titlepart "")) + year + (unless (or (and (equal names "") + (equal year "")) + (equal title "")) bibtex-autokey-year-title-separator) - titlepart))) + title))) (if bibtex-autokey-before-presentation-function (funcall bibtex-autokey-before-presentation-function autokey) autokey))) -(defun bibtex-parse-keys (&optional add abortable verbose) +(defun bibtex-read-key (prompt &optional key) + "Read BibTeX key from minibuffer using PROMPT and default KEY." + (completing-read prompt bibtex-reference-keys + nil nil key 'bibtex-key-history)) + +(defun bibtex-parse-keys (&optional abortable verbose) "Set `bibtex-reference-keys' to the keys used in the whole buffer. -The buffer might possibly be restricted. -Find both entry keys and crossref entries. -If ADD is non-nil add the new keys to `bibtex-reference-keys' instead of -simply resetting it. If ADD is an alist of keys, also add ADD to -`bibtex-reference-keys'. If ABORTABLE is non-nil abort on user -input. If VERBOSE is non-nil gives messages about progress. -Return alist of keys if parsing was completed, `aborted' otherwise." - (let ((reference-keys (if (and add - (listp bibtex-reference-keys)) - bibtex-reference-keys))) - (if (listp add) - (dolist (key add) - (unless (assoc (car key) reference-keys) - (push key reference-keys)))) +Find both entry keys and crossref entries. If ABORTABLE is non-nil abort on +user input. If VERBOSE is non-nil gives messages about progress. Return alist +of keys if parsing was completed, `aborted' otherwise." + (let (ref-keys crossref-keys) (save-excursion (save-match-data (if verbose @@ -2286,22 +2284,24 @@ Return alist of keys if parsing was completed, `aborted' otherwise." (if (and abortable (input-pending-p)) ;; user has aborted by typing a key --> return `aborted' (throw 'userkey 'aborted)) - (let ((key (cond ((match-end 3) - ;; This is a crossref. - (buffer-substring-no-properties - (1+ (match-beginning 3)) (1- (match-end 3)))) - ((assoc-string (bibtex-type-in-head) - bibtex-entry-field-alist t) - ;; This is an entry. - (match-string-no-properties bibtex-key-in-head))))) - (if (and (stringp key) - (not (assoc key reference-keys))) - (push (list key) reference-keys))))) + (cond ((match-end 3) + ;; This is a crossref. + (let ((key (buffer-substring-no-properties + (1+ (match-beginning 3)) (1- (match-end 3))))) + (unless (assoc key crossref-keys) + (push (list key) crossref-keys)))) + ;; only keys of known entries + ((assoc-string (bibtex-type-in-head) + bibtex-entry-field-alist t) + ;; This is an entry. + (let ((key (bibtex-key-in-head))) + (unless (assoc key ref-keys) + (push (cons key t) ref-keys))))))) (let (;; ignore @String entries because they are handled ;; separately by bibtex-parse-strings (bibtex-sort-ignore-string-entries t) - crossref-key bounds) + bounds) (bibtex-map-entries (lambda (key beg end) (if (and abortable @@ -2309,17 +2309,19 @@ Return alist of keys if parsing was completed, `aborted' otherwise." ;; user has aborted by typing a key --> return `aborted' (throw 'userkey 'aborted)) (if verbose (bibtex-progress-message)) - (unless (assoc key reference-keys) - (push (list key) reference-keys)) + (unless (assoc key ref-keys) + (push (cons key t) ref-keys)) (if (and (setq bounds (bibtex-search-forward-field "crossref" end)) - (setq crossref-key (bibtex-text-in-field-bounds bounds t)) - (not (assoc crossref-key reference-keys))) - (push (list crossref-key) reference-keys)))))) + (setq key (bibtex-text-in-field-bounds bounds t)) + (not (assoc key crossref-keys))) + (push (list key) crossref-keys)))))) + (dolist (key crossref-keys) + (unless (assoc (car key) ref-keys) (push key ref-keys))) (if verbose (bibtex-progress-message 'done)) ;; successful operation --> return `bibtex-reference-keys' - (setq bibtex-reference-keys reference-keys)))))) + (setq bibtex-reference-keys ref-keys)))))) (defun bibtex-parse-strings (&optional add abortable) "Set `bibtex-strings' to the string definitions in the whole buffer. @@ -2355,39 +2357,44 @@ Return alist of strings if parsing was completed, `aborted' otherwise." (defun bibtex-string-files-init () "Return initialization for `bibtex-strings'. -Use `bibtex-predefined-strings' and bib files `bibtex-string-files'." +Use `bibtex-predefined-strings' and BibTeX files `bibtex-string-files'." (save-match-data - ;; collect pathnames - (let ((dirlist (split-string (or bibtex-string-file-path ".") + (let ((dirlist (split-string (or bibtex-string-file-path default-directory) ":+")) (case-fold-search) - compl) + string-files fullfilename compl bounds found) + ;; collect absolute file names of valid string files (dolist (filename bibtex-string-files) (unless (string-match "\\.bib\\'" filename) (setq filename (concat filename ".bib"))) ;; test filenames - (let (fullfilename bounds found) + (if (file-name-absolute-p filename) + (if (file-readable-p filename) + (push filename string-files) + (error "BibTeX strings file %s not found" filename)) (dolist (dir dirlist) (when (file-readable-p (setq fullfilename (expand-file-name filename dir))) - ;; file was found - (with-temp-buffer - (insert-file-contents fullfilename) - (goto-char (point-min)) - (while (setq bounds (bibtex-search-forward-string)) - (push (cons (bibtex-reference-key-in-string bounds) - (bibtex-text-in-string bounds t)) - compl) - (goto-char (bibtex-end-of-string bounds)))) + (push fullfilename string-files) (setq found t))) (unless found (error "File %s not in paths defined via bibtex-string-file-path" filename)))) + ;; parse string files + (dolist (filename string-files) + (with-temp-buffer + (insert-file-contents filename) + (goto-char (point-min)) + (while (setq bounds (bibtex-search-forward-string)) + (push (cons (bibtex-reference-key-in-string bounds) + (bibtex-text-in-string bounds t)) + compl) + (goto-char (bibtex-end-of-string bounds))))) (append bibtex-predefined-strings (nreverse compl))))) (defun bibtex-parse-buffers-stealthily () "Parse buffer in the background during idle time. -Called by `bibtex-run-with-idle-timer'. Whenever Emacs has been idle +Called by `run-with-idle-timer'. Whenever Emacs has been idle for `bibtex-parse-keys-timeout' seconds, all BibTeX buffers (starting with the current) are parsed." (save-excursion @@ -2402,7 +2409,7 @@ with the current) are parsed." (widen) ;; Output no progress messages in bibtex-parse-keys ;; because when in y-or-n-p that can hide the question. - (if (and (listp (bibtex-parse-keys nil t)) + (if (and (listp (bibtex-parse-keys t)) ;; update bibtex-strings (listp (bibtex-parse-strings strings-init t))) @@ -2410,6 +2417,51 @@ with the current) are parsed." (setq bibtex-buffer-last-parsed-tick (buffer-modified-tick))))) (setq buffers (cdr buffers)))))) +(defun bibtex-files-expand (&optional current) + "Return an expanded list of BibTeX buffers based on `bibtex-files'. +Initialize in these buffers `bibtex-reference-keys' if not yet set. +List includes current buffer if CURRENT is non-nil." + (let ((file-path (split-string (or bibtex-file-path default-directory) ":+")) + file-list dir-list buffer-list) + (dolist (file bibtex-files) + (cond ((eq file 'bibtex-file-path) + (setq dir-list (append dir-list file-path))) + ((file-accessible-directory-p file) + (push file dir-list)) + ((progn (unless (string-match "\\.bib\\'" file) + (setq file (concat file ".bib"))) + (file-name-absolute-p file)) + (push file file-list)) + (t + (let (fullfilename found) + (dolist (dir file-path) + (when (file-readable-p + (setq fullfilename (expand-file-name file dir))) + (push fullfilename file-list) + (setq found t))) + (unless found + (error "File %s not in paths defined via bibtex-file-path" + file)))))) + (dolist (file file-list) + (unless (file-readable-p file) + (error "BibTeX file %s not found" file))) + ;; expand dir-list + (dolist (dir dir-list) + (setq file-list + (append file-list (directory-files dir t "\\.bib\\'" t)))) + (delete-dups file-list) + (dolist (file file-list) + (when (file-readable-p file) + (push (find-file-noselect file) buffer-list) + (with-current-buffer (car buffer-list) + (unless (listp bibtex-reference-keys) + (bibtex-parse-keys))))) + (cond ((and current (not (memq (current-buffer) buffer-list))) + (push (current-buffer) buffer-list)) + ((and (not current) (memq (current-buffer) buffer-list)) + (setq buffer-list (delq (current-buffer) buffer-list)))) + buffer-list)) + (defun bibtex-complete-internal (completions) "Complete word fragment before point to longest prefix of COMPLETIONS. COMPLETIONS should be a list of strings. If point is not after the part @@ -2459,58 +2511,59 @@ expansion of STR using expansion list STRINGS-ALIST." (bibtex-remove-delimiters)))))))) (defun bibtex-complete-key-cleanup (key) - "Display message on entry KEY after completion of a crossref key." + "Display summary message on entry KEY after completion of a crossref key. +Use `bibtex-summary-function' to generate summary." (save-excursion ;; Don't do anything if we completed the key of an entry. (let ((pnt (bibtex-beginning-of-entry))) (if (and (stringp key) (bibtex-find-entry key) (/= pnt (point))) - (let* ((bibtex-autokey-name-case-convert 'identity) - (bibtex-autokey-name-length 'infty) - (nl (bibtex-autokey-get-names)) - (name (concat (nth 0 nl) (if (nth 1 nl) " etal"))) - (year (bibtex-autokey-get-field "year")) - (bibtex-autokey-titlewords 5) - (bibtex-autokey-titlewords-stretch 2) - (bibtex-autokey-titleword-case-convert 'identity) - (bibtex-autokey-titleword-length 5) - (title (mapconcat 'identity - (bibtex-autokey-get-title) " ")) - (journal (bibtex-autokey-get-field - "journal" bibtex-autokey-transcriptions)) - (volume (bibtex-autokey-get-field "volume")) - (pages (bibtex-autokey-get-field "pages" '(("-.*\\'" . ""))))) - (message "Ref:%s" - (mapconcat (lambda (arg) - (if (not (string= "" (cdr arg))) - (concat (car arg) (cdr arg)))) - `((" " . ,name) (" " . ,year) - (": " . ,title) (", " . ,journal) - (" " . ,volume) (":" . ,pages)) - ""))))))) + (message "Ref: %s" (funcall bibtex-summary-function key)))))) -(defun bibtex-choose-completion-string (choice buffer mini-p base-size) - ;; Code borrowed from choose-completion-string: - ;; We must duplicate the code from choose-completion-string - ;; because it runs the hook choose-completion-string-functions - ;; before it inserts the completion. But we want to do something - ;; after the completion has been inserted. - ;; - ;; Insert the completion into the buffer where it was requested. - (set-buffer buffer) - (if base-size - (delete-region (+ base-size (point-min)) - (point)) - ;; Delete the longest partial match for CHOICE - ;; that can be found before point. - (choose-completion-delete-max-match choice)) - (insert choice) - (remove-text-properties (- (point) (length choice)) (point) - '(mouse-face nil)) - ;; Update point in the window that BUFFER is showing in. - (let ((window (get-buffer-window buffer t))) - (set-window-point window (point)))) +(defun bibtex-copy-summary-as-kill (key) + "Push summery of BibTeX entry KEY to kill ring. +Use `bibtex-summary-function' to generate summary." + (interactive + (list (bibtex-read-key + "Key: " (save-excursion + (bibtex-beginning-of-entry) + (when (re-search-forward bibtex-entry-head nil t) + (bibtex-key-in-head)))))) + (kill-new (message "%s" (funcall bibtex-summary-function key)))) + +(defun bibtex-summary (key) + "Return summary of BibTeX entry KEY. +Used as default value of `bibtex-summary-function'." + ;; It would be neat to customize this function. How? + (save-excursion + (if (bibtex-find-entry key) + (let* ((bibtex-autokey-name-case-convert 'identity) + (bibtex-autokey-name-length 'infty) + (bibtex-autokey-names 1) + (bibtex-autokey-names-stretch 0) + (bibtex-autokey-name-separator " ") + (bibtex-autokey-additional-names " etal") + (names (bibtex-autokey-get-names)) + (bibtex-autokey-year-length 4) + (year (bibtex-autokey-get-year)) + (bibtex-autokey-titlewords 5) + (bibtex-autokey-titlewords-stretch 2) + (bibtex-autokey-titleword-case-convert 'identity) + (bibtex-autokey-titleword-length 5) + (bibtex-autokey-titleword-separator " ") + (title (bibtex-autokey-get-title)) + (journal (bibtex-autokey-get-field + "journal" bibtex-autokey-transcriptions)) + (volume (bibtex-autokey-get-field "volume")) + (pages (bibtex-autokey-get-field "pages" '(("-.*\\'" . ""))))) + (mapconcat (lambda (arg) + (if (not (string= "" (cdr arg))) + (concat (car arg) (cdr arg)))) + `((" " . ,names) (" " . ,year) (": " . ,title) + (", " . ,journal) (" " . ,volume) (":" . ,pages)) + "")) + (error "Key `%s' not found." key)))) (defun bibtex-pop (arg direction) "Fill current field from the ARG'th same field's text in DIRECTION. @@ -2550,7 +2603,7 @@ Generic function used by `bibtex-pop-previous' and `bibtex-pop-next'." (if failure (error "No %s matching BibTeX field" (if (eq direction 'previous) "previous" "next")) - ;; Found a matching field. Remember boundaries. + ;; Found a matching field. Remember boundaries. (setq bibtex-pop-previous-search-point (bibtex-start-of-field bounds) bibtex-pop-next-search-point (bibtex-end-of-field bounds) new-text (bibtex-text-in-field-bounds bounds)) @@ -2563,10 +2616,82 @@ Generic function used by `bibtex-pop-previous' and `bibtex-pop-next'." (bibtex-find-text nil)) (setq this-command 'bibtex-pop)) -(defsubst bibtex-read-key (prompt &optional key) - "Read BibTeX key from minibuffer using PROMPT and default KEY." - (completing-read prompt bibtex-reference-keys - nil nil key 'bibtex-key-history)) +(defun bibtex-beginning-of-field () + "Move point backward to beginning of field. +This function uses a simple, fast algorithm assuming that the field +begins at the beginning of a line. We use this function for font-locking." + (let ((field-reg (concat "^[ \t]*" bibtex-field-name "[ \t]*="))) + (beginning-of-line) + (unless (looking-at field-reg) + (re-search-backward field-reg nil t)))) + +(defun bibtex-font-lock-url (bound) + "Font-lock for URLs." + (let ((case-fold-search t) + (pnt (point)) + field bounds start end found) + (bibtex-beginning-of-field) + (while (and (not found) + (prog1 (re-search-forward bibtex-font-lock-url-regexp bound t) + (setq field (match-string-no-properties 1))) + (setq bounds (bibtex-parse-field-text)) + (progn + (setq start (car bounds) end (cdr bounds)) + ;; Always ignore field delimiters + (if (memq (char-before end) '(?\} ?\")) + (setq end (1- end))) + (if (memq (char-after start) '(?\{ ?\")) + (setq start (1+ start))) + (>= bound start))) + (let ((lst bibtex-generate-url-list) url) + (goto-char start) + (while (and (not found) + (setq url (caar lst))) + (setq found (and (bibtex-string= field (car url)) + (re-search-forward (cdr url) end t) + (>= (match-beginning 0) pnt)) + lst (cdr lst)))) + (goto-char end)) + (if found (bibtex-button (match-beginning 0) (match-end 0) + 'bibtex-url (match-beginning 0))) + found)) + +(defun bibtex-font-lock-crossref (bound) + "Font-lock for crossref fields." + (let ((case-fold-search t) + (pnt (point)) + (crossref-reg (concat "^[ \t]*crossref[ \t]*=[ \t\n]*" + "\\(\"[^\"]*\"\\|{[^}]*}\\)[ \t\n]*[,})]")) + start end found) + (bibtex-beginning-of-field) + (while (and (not found) + (re-search-forward crossref-reg bound t)) + (setq start (1+ (match-beginning 1)) + end (1- (match-end 1)) + found (>= start pnt))) + (if found (bibtex-button start end 'bibtex-find-crossref + (buffer-substring-no-properties start end) + start t)) + found)) + +(defun bibtex-button-action (button) + "Call BUTTON's BibTeX function." + (apply (button-get button 'bibtex-function) + (button-get button 'bibtex-args))) + +(define-button-type 'bibtex-url + 'action 'bibtex-button-action + 'bibtex-function 'bibtex-url + 'help-echo (purecopy "mouse-2, RET: follow URL")) + +(define-button-type 'bibtex-find-crossref + 'action 'bibtex-button-action + 'bibtex-function 'bibtex-find-crossref + 'help-echo (purecopy "mouse-2, RET: follow crossref")) + +(defun bibtex-button (beg end type &rest args) + (make-text-button beg end 'type type 'bibtex-args args)) + ;; Interactive Functions: @@ -2668,7 +2793,7 @@ non-nil. (make-local-variable 'bibtex-buffer-last-parsed-tick) ;; Install stealthy parse function if not already installed (unless bibtex-parse-idle-timer - (setq bibtex-parse-idle-timer (bibtex-run-with-idle-timer + (setq bibtex-parse-idle-timer (run-with-idle-timer bibtex-parse-keys-timeout t 'bibtex-parse-buffers-stealthily))) (set (make-local-variable 'paragraph-start) "[ \f\n\t]*$") @@ -2680,8 +2805,8 @@ non-nil. (set (make-local-variable 'outline-regexp) "[ \t]*@") (set (make-local-variable 'fill-paragraph-function) 'bibtex-fill-field) (set (make-local-variable 'fill-prefix) (make-string (+ bibtex-entry-offset - bibtex-contline-indentation) - ? )) + bibtex-contline-indentation) + ? )) (set (make-local-variable 'font-lock-defaults) '(bibtex-font-lock-keywords nil t ((?$ . "\"") @@ -2693,7 +2818,7 @@ non-nil. ) nil (font-lock-syntactic-keywords . bibtex-font-lock-syntactic-keywords) - (font-lock-extra-managed-props . (mouse-face keymap)) + (font-lock-extra-managed-props . (category)) (font-lock-mark-block-function . (lambda () (set-mark (bibtex-end-of-entry)) @@ -2776,8 +2901,7 @@ according to `bibtex-entry-field-alist', but are not yet present." ;; bibtex-parse-entry moves point to the end of the last field. (let* ((fields-alist (bibtex-parse-entry)) (field-list (bibtex-field-list - (substring (cdr (assoc "=type=" fields-alist)) - 1)))) ; don't want @ + (cdr (assoc "=type=" fields-alist))))) (dolist (field (car field-list)) (unless (assoc-string (car field) fields-alist t) (bibtex-make-field field))) @@ -2793,8 +2917,8 @@ TEXT may be nil. Remove \"OPT\" and \"ALT\" from FIELD. Move point to the end of the last field." (let (alist bounds) (when (looking-at bibtex-entry-maybe-empty-head) - (push (cons "=type=" (match-string bibtex-type-in-head)) alist) - (push (cons "=key=" (match-string bibtex-key-in-head)) alist) + (push (cons "=type=" (bibtex-type-in-head)) alist) + (push (cons "=key=" (bibtex-key-in-head)) alist) (goto-char (match-end 0)) (while (setq bounds (bibtex-parse-field bibtex-field-name)) (push (cons (bibtex-name-in-field bounds t) @@ -2809,8 +2933,8 @@ Move point to the end of the last field." (undo-boundary) ;So you can easily undo it, if it didn't work right. (bibtex-beginning-of-entry) (when (looking-at bibtex-entry-head) - (let ((type (match-string bibtex-type-in-head)) - (key (match-string bibtex-key-in-head)) + (let ((type (bibtex-type-in-head)) + (key (bibtex-key-in-head)) (key-end (match-end bibtex-key-in-head)) (case-fold-search t) tmp other-key other bounds) @@ -2823,9 +2947,9 @@ Move point to the end of the last field." (bibtex-beginning-of-entry) (when (and (looking-at bibtex-entry-head) - (bibtex-string= type (match-string bibtex-type-in-head)) + (bibtex-string= type (bibtex-type-in-head)) ;; In case we found ourselves :-( - (not (equal key (setq tmp (match-string bibtex-key-in-head))))) + (not (equal key (setq tmp (bibtex-key-in-head))))) (setq other-key tmp) (setq other (point)))) (save-excursion @@ -2833,9 +2957,9 @@ Move point to the end of the last field." (bibtex-skip-to-valid-entry) (when (and (looking-at bibtex-entry-head) - (bibtex-string= type (match-string bibtex-type-in-head)) + (bibtex-string= type (bibtex-type-in-head)) ;; In case we found ourselves :-( - (not (equal key (setq tmp (match-string bibtex-key-in-head)))) + (not (equal key (setq tmp (bibtex-key-in-head)))) (or (not other-key) ;; Check which is the best match. (< (length (try-completion "" (list key other-key))) @@ -2892,9 +3016,9 @@ If CALLED-BY-YANK is non-nil, don't insert delimiters." (interactive (list (let ((completion-ignore-case t) (field-list (bibtex-field-list - (save-excursion - (bibtex-enclosing-entry-maybe-empty-head) - (bibtex-type-in-head))))) + (save-excursion + (bibtex-enclosing-entry-maybe-empty-head) + (bibtex-type-in-head))))) (completing-read "BibTeX field name: " (append (car field-list) (cdr field-list)) nil nil nil bibtex-field-history)))) @@ -3003,17 +3127,13 @@ If mark is active it counts entries in region, if not in whole buffer." (not count-string-entries))) (save-excursion (save-restriction - (narrow-to-region (if (bibtex-mark-active) - (region-beginning) + (narrow-to-region (if mark-active (region-beginning) (bibtex-beginning-of-first-entry)) - (if (bibtex-mark-active) - (region-end) - (point-max))) - (goto-char (point-min)) + (if mark-active (region-end) (point-max))) (bibtex-map-entries (lambda (key beg end) (setq number (1+ number)))))) (message "%s contains %d entries." - (if (bibtex-mark-active) "Region" "Buffer") + (if mark-active "Region" "Buffer") number))) (defun bibtex-ispell-entry () @@ -3110,12 +3230,39 @@ will be ignored." nil ; ENDKEY function 'bibtex-lessp))) ; PREDICATE -(defun bibtex-find-crossref (crossref-key) +(defun bibtex-find-entry-globally (key) + "Move point to the beginning of BibTeX entry named KEY in `bibtex-files'." + (interactive + (list (let (key-alist) + (dolist (buffer (bibtex-files-expand t)) + (with-current-buffer buffer + (setq key-alist (append bibtex-reference-keys key-alist)))) + (completing-read "Find key: " key-alist + nil nil nil 'bibtex-key-history)))) + (let ((buffer-list (bibtex-files-expand t)) + buffer found) + (while (and (not found) + (setq buffer (pop buffer-list))) + (with-current-buffer buffer + (if (cdr (assoc-string key bibtex-reference-keys)) + (setq found t)))) + (if found + (progn + (let ((same-window-buffer-names + (cons (buffer-name buffer) same-window-buffer-names))) + (pop-to-buffer buffer)) + (bibtex-find-entry key)) + (message "Key `%s' not found" key)))) + +(defun bibtex-find-crossref (crossref-key &optional pnt split) "Move point to the beginning of BibTeX entry CROSSREF-KEY. Return position of entry if CROSSREF-KEY is found and nil otherwise. If position of current entry is after CROSSREF-KEY an error is signaled. +Optional arg PNT is the position of the referencing entry. +If optional arg SPLIT is non-nil, split window so that both the referencing +and the crossrefed entry are displayed. If called interactively, CROSSREF-KEY defaults to crossref key of current -entry." +entry and SPLIT is t." (interactive (let ((crossref-key (save-excursion @@ -3123,11 +3270,23 @@ entry." (let ((bounds (bibtex-search-forward-field "crossref" t))) (if bounds (bibtex-text-in-field-bounds bounds t)))))) - (list (bibtex-read-key "Find crossref key: " crossref-key)))) + (list (bibtex-read-key "Find crossref key: " crossref-key) (point) t))) (let ((pos (save-excursion (bibtex-find-entry crossref-key)))) - (if (and pos (> (point) pos)) - (error "This entry must not follow the crossrefed entry!")) - (goto-char pos))) + (unless pnt (setq pnt (point))) + (cond ((not pos) + (message "Crossref key `%s' not found" crossref-key)) + (split + (goto-char pnt) + (select-window (split-window)) + (goto-char pos) + (beginning-of-line) + (set-window-start (selected-window) (point)) + (if (> pnt pos) + (error "The referencing entry must preceed the crossrefed entry!"))) + ((> pnt pos) + (error "The referencing entry must preceed the crossrefed entry!")) + (t (goto-char pos))) + pos)) (defun bibtex-find-entry (key &optional start) "Move point to the beginning of BibTeX entry named KEY. @@ -3212,23 +3371,21 @@ Return t if preparation was successful or nil if entry KEY already exists." (defun bibtex-validate (&optional test-thoroughly) "Validate if buffer or region is syntactically correct. -Only known entry types are checked, so you can put comments -outside of entries. -With optional argument TEST-THOROUGHLY non-nil it checks for absence of -required fields and questionable month fields as well. +Check also for duplicate keys and correct sort order provided +`bibtex-maintain-sorted-entries' is non-nil. +With optional argument TEST-THOROUGHLY non-nil check also for +the absence of required fields and for questionable month fields. If mark is active, validate current region, if not the whole buffer. -Returns t if test was successful, nil otherwise." +Only check known entry types, so you can put comments outside of entries. +Return t if test was successful, nil otherwise." (interactive "P") (let* ((case-fold-search t) error-list syntax-error) (save-excursion (save-restriction - (narrow-to-region (if (bibtex-mark-active) - (region-beginning) + (narrow-to-region (if mark-active (region-beginning) (bibtex-beginning-of-first-entry)) - (if (bibtex-mark-active) - (region-end) - (point-max))) + (if mark-active (region-end) (point-max))) ;; looking if entries fit syntactical structure (goto-char (point-min)) @@ -3244,41 +3401,54 @@ Returns t if test was successful, nil otherwise." (if (equal (point) pnt) (forward-char) (goto-char pnt) - (push (list (bibtex-current-line) + (push (cons (bibtex-current-line) "Syntax error (check esp. commas, braces, and quotes)") error-list) (forward-char)))))) (bibtex-progress-message 'done) (if error-list + ;; proceed only if there were no syntax errors. (setq syntax-error t) - ;; looking for correct sort order and duplicates (only if - ;; there were no syntax errors) - (if bibtex-maintain-sorted-entries - (let (previous current) - (goto-char (point-min)) - (bibtex-progress-message "Checking correct sort order") - (bibtex-map-entries - (lambda (key beg end) - (bibtex-progress-message) - (goto-char beg) - (setq current (bibtex-entry-index)) - (cond ((or (not previous) - (bibtex-lessp previous current)) - (setq previous current)) - ((string-equal (car previous) (car current)) - (push (list (bibtex-current-line) - "Duplicate key with previous") - error-list)) - (t - (setq previous current) - (push (list (bibtex-current-line) - "Entries out of order") - error-list))))) - (bibtex-progress-message 'done))) + + ;; looking for duplicate keys and correct sort order + (let (previous current key-list) + (bibtex-progress-message "Checking for duplicate keys") + (bibtex-map-entries + (lambda (key beg end) + (bibtex-progress-message) + (goto-char beg) + (setq current (bibtex-entry-index)) + (cond ((not previous)) + ((member key key-list) + (push (cons (bibtex-current-line) + (format "Duplicate key `%s'" key)) + error-list)) + ((and bibtex-maintain-sorted-entries + (not (bibtex-lessp previous current))) + (push (cons (bibtex-current-line) + "Entries out of order") + error-list))) + (push key key-list) + (setq previous current))) + (bibtex-progress-message 'done)) + + ;; Check for duplicate keys in `bibtex-files'. + (bibtex-parse-keys) + (dolist (buffer (bibtex-files-expand)) + (dolist (key (with-current-buffer buffer + ;; We don't want to be fooled by outdated + ;; bibtex-reference-keys. + (bibtex-parse-keys) bibtex-reference-keys)) + (when (and (cdr key) + (cdr (assoc-string (car key) bibtex-reference-keys))) + (bibtex-find-entry (car key)) + (push (cons (bibtex-current-line) + (format "Duplicate key `%s' in %s" (car key) + (abbreviate-file-name (buffer-file-name buffer)))) + error-list)))) (when test-thoroughly - (goto-char (point-min)) (bibtex-progress-message "Checking required fields and month fields") (let ((bibtex-sort-ignore-string-entries t)) @@ -3292,73 +3462,135 @@ Returns t if test was successful, nil otherwise." bibtex-entry-field-alist t))) (req (copy-sequence (elt (elt entry-list 1) 0))) (creq (copy-sequence (elt (elt entry-list 2) 0))) - crossref-there bounds) + crossref-there bounds alt-there field) (goto-char beg) (while (setq bounds (bibtex-search-forward-field bibtex-field-name end)) (goto-char (bibtex-start-of-text-in-field bounds)) (let ((field-name (bibtex-name-in-field bounds))) (if (and (bibtex-string= field-name "month") - (not (assoc-string (bibtex-text-in-field-bounds bounds) - bibtex-predefined-month-strings t))) - (push (list (bibtex-current-line) + ;; Check only abbreviated month fields. + (let ((month (bibtex-text-in-field-bounds bounds))) + (not (or (string-match "\\`[\"{].+[\"}]\\'" month) + (assoc-string + month + bibtex-predefined-month-strings t))))) + (push (cons (bibtex-current-line) "Questionable month field") error-list)) - (setq req (delete (assoc-string field-name req t) req) + (setq field (assoc-string field-name req t)) + (if (nth 3 field) + (if alt-there (push (cons (bibtex-current-line) + "More than one non-empty alternative") + error-list) + (setq alt-there t))) + (setq req (delete field req) creq (delete (assoc-string field-name creq t) creq)) (if (bibtex-string= field-name "crossref") (setq crossref-there t)))) (if crossref-there (setq req creq)) - (if (or (> (length req) 1) - (and (= (length req) 1) - (not (elt (car req) 3)))) - ;; two (or more) fields missed or one field - ;; missed and this isn't flagged alternative - ;; (notice that this fails if there are more - ;; than two alternatives in a BibTeX entry, - ;; which isn't the case momentarily) - (push (list (save-excursion - (bibtex-beginning-of-entry) - (bibtex-current-line)) - (concat "Required field `" (caar req) "' missing")) - error-list)))))) + (let (alt) + (dolist (field req) + (if (nth 3 field) + (push (car field) alt) + (push (cons (save-excursion (goto-char beg) + (bibtex-current-line)) + (format "Required field `%s' missing" + (car field))) + error-list))) + ;; The following fails if there are more than two + ;; alternatives in a BibTeX entry, which isn't + ;; the case momentarily. + (if (cdr alt) + (push (cons (save-excursion (goto-char beg) + (bibtex-current-line)) + (format "Alternative fields `%s'/`%s' missing" + (car alt) (cadr alt))) + error-list))))))) (bibtex-progress-message 'done))))) + (if error-list - (let ((bufnam (buffer-name)) - (dir default-directory)) - (setq error-list - (sort error-list - (lambda (a b) - (< (car a) (car b))))) - (let ((pop-up-windows t)) - (pop-to-buffer nil t)) - (switch-to-buffer - (get-buffer-create "*BibTeX validation errors*") t) - ;; don't use switch-to-buffer-other-window, since this - ;; doesn't allow the second parameter NORECORD - (setq default-directory dir) - (toggle-read-only -1) - (compilation-mode) - (delete-region (point-min) (point-max)) - (goto-char (point-min)) - (insert "BibTeX mode command `bibtex-validate'\n" - (if syntax-error - "Maybe undetected errors due to syntax errors. Correct and validate again." - "") - "\n") - (dolist (err error-list) - (insert bufnam ":" (number-to-string (elt err 0)) - ": " (elt err 1) "\n")) - (set-buffer-modified-p nil) - (toggle-read-only 1) - (goto-char (point-min)) - (other-window -1) + (let ((file (file-name-nondirectory (buffer-file-name))) + (dir default-directory) + (err-buf "*BibTeX validation errors*")) + (setq error-list (sort error-list 'car-less-than-car)) + (with-current-buffer (get-buffer-create err-buf) + (setq default-directory dir) + (unless (eq major-mode 'compilation-mode) (compilation-mode)) + (toggle-read-only -1) + (delete-region (point-min) (point-max)) + (insert "BibTeX mode command `bibtex-validate'\n" + (if syntax-error + "Maybe undetected errors due to syntax errors. Correct and validate again.\n" + "\n")) + (dolist (err error-list) + (insert (format "%s:%d: %s\n" file (car err) (cdr err)))) + (set-buffer-modified-p nil) + (toggle-read-only 1) + (goto-line 3)) ; first error message + (display-buffer err-buf) ;; return nil nil) - (if (bibtex-mark-active) - (message "Region is syntactically correct") - (message "Buffer is syntactically correct")) + (message "%s is syntactically correct" + (if mark-active "Region" "Buffer")) + t))) + +(defun bibtex-validate-globally (&optional strings) + "Check for duplicate keys in `bibtex-files'. +With prefix arg STRINGS, check for duplicate strings, too. +Return t if test was successful, nil otherwise." + (interactive "P") + (let ((buffer-list (bibtex-files-expand t)) + buffer-key-list current-buf current-keys error-list) + ;; Check for duplicate keys within BibTeX buffer + (dolist (buffer buffer-list) + (save-excursion + (set-buffer buffer) + (let (entry-type key key-list) + (goto-char (point-min)) + (while (re-search-forward bibtex-entry-head nil t) + (setq entry-type (bibtex-type-in-head) + key (bibtex-key-in-head)) + (if (or (and strings (bibtex-string= entry-type "string")) + (assoc-string entry-type bibtex-entry-field-alist t)) + (if (member key key-list) + (push (format "%s:%d: Duplicate key `%s'\n" + (buffer-file-name) + (bibtex-current-line) key) + error-list) + (push key key-list)))) + (push (cons buffer key-list) buffer-key-list)))) + + ;; Check for duplicate keys among BibTeX buffers + (while (setq current-buf (pop buffer-list)) + (setq current-keys (cdr (assq current-buf buffer-key-list))) + (with-current-buffer current-buf + (dolist (buffer buffer-list) + (dolist (key (cdr (assq buffer buffer-key-list))) + (when (assoc-string key current-keys) + (bibtex-find-entry key) + (push (format "%s:%d: Duplicat key `%s' in %s\n" + (buffer-file-name) (bibtex-current-line) key + (abbreviate-file-name (buffer-file-name buffer))) + error-list)))))) + + ;; Process error list + (if error-list + (let ((err-buf "*BibTeX validation errors*")) + (with-current-buffer (get-buffer-create err-buf) + (unless (eq major-mode 'compilation-mode) (compilation-mode)) + (toggle-read-only -1) + (delete-region (point-min) (point-max)) + (insert "BibTeX mode command `bibtex-validate-globally'\n\n") + (dolist (err (sort error-list 'string-lessp)) (insert err)) + (set-buffer-modified-p nil) + (toggle-read-only 1) + (goto-line 3)) ; first error message + (display-buffer err-buf) + ;; return nil + nil) + (message "No duplicate keys.") t))) (defun bibtex-next-field (arg) @@ -3404,7 +3636,7 @@ Returns t if test was successful, nil otherwise." (match-end 0)))) (t (unless no-error - (error "Not on BibTeX field"))))))) + (error "Not on BibTeX field"))))))) (defun bibtex-remove-OPT-or-ALT () "Remove the string starting optional/alternative fields. @@ -3470,6 +3702,7 @@ but do not actually kill it." (setq bibtex-last-kill-command 'field)) (defun bibtex-copy-field-as-kill () + "Copy the field at point to the kill ring." (interactive) (bibtex-kill-field t)) @@ -3492,9 +3725,9 @@ With prefix arg COPY-ONLY the current entry to (setcdr (nthcdr (1- bibtex-entry-kill-ring-max) bibtex-entry-kill-ring) nil)) - (setq bibtex-entry-kill-ring-yank-pointer bibtex-entry-kill-ring) - (unless copy-only - (delete-region beg end)))) + (setq bibtex-entry-kill-ring-yank-pointer bibtex-entry-kill-ring) + (unless copy-only + (delete-region beg end)))) (setq bibtex-last-kill-command 'entry)) (defun bibtex-copy-entry-as-kill () @@ -3584,7 +3817,7 @@ At end of the cleaning process, the functions in ;; (bibtex-format-preamble) (error "No clean up of @Preamble entries")) ((bibtex-string= entry-type "string")) - ;; (bibtex-format-string) + ;; (bibtex-format-string) (t (bibtex-format-entry))) ;; set key (when (or new-key (not key)) @@ -3597,7 +3830,7 @@ At end of the cleaning process, the functions in (delete-region (match-beginning bibtex-key-in-head) (match-end bibtex-key-in-head))) (insert key)) - ;; sorting + (unless called-by-reformat (let* ((start (bibtex-beginning-of-entry)) (end (progn (bibtex-end-of-entry) @@ -3606,9 +3839,12 @@ At end of the cleaning process, the functions in (goto-char (match-beginning 0))) (point))) (entry (buffer-substring start end)) - (index (progn (goto-char start) - (bibtex-entry-index))) + ;; include the crossref key in index + (index (let ((bibtex-maintain-sorted-entries 'crossref)) + (goto-char start) + (bibtex-entry-index))) error) + ;; sorting (if (and bibtex-maintain-sorted-entries (not (and bibtex-sort-ignore-string-entries (bibtex-string= entry-type "string")))) @@ -3623,17 +3859,37 @@ At end of the cleaning process, the functions in (setq error (or (/= (point) start) (bibtex-find-entry key end)))) (if error - (error "New inserted entry yields duplicate key")))) - ;; final clean up - (unless called-by-reformat - (save-excursion - (save-restriction - (bibtex-narrow-to-entry) - ;; Only update the list of keys if it has been built already. - (cond ((bibtex-string= entry-type "string") - (if (listp bibtex-strings) (bibtex-parse-strings t))) - ((listp bibtex-reference-keys) (bibtex-parse-keys t))) - (run-hooks 'bibtex-clean-entry-hook)))))) + (error "New inserted entry yields duplicate key")) + (dolist (buffer (bibtex-files-expand)) + (with-current-buffer buffer + (if (cdr (assoc-string key bibtex-reference-keys)) + (error "Duplicate key in %s" (buffer-file-name))))) + + ;; Only update the list of keys if it has been built already. + (cond ((bibtex-string= entry-type "string") + (if (and (listp bibtex-strings) + (not (assoc key bibtex-strings))) + (push (list key) bibtex-strings))) + ;; We have a normal entry. + ((listp bibtex-reference-keys) + (cond ((not (assoc key bibtex-reference-keys)) + (push (cons key t) bibtex-reference-keys)) + ((not (cdr (assoc key bibtex-reference-keys))) + ;; Turn a crossref key into a header key + (setq bibtex-reference-keys + (cons (cons key t) + (delete (list key) bibtex-reference-keys))))) + ;; Handle crossref key. + (if (and (nth 1 index) + (not (assoc (nth 1 index) bibtex-reference-keys))) + (push (list (nth 1 index)) bibtex-reference-keys))))) + + ;; final clean up + (if bibtex-clean-entry-hook + (save-excursion + (save-restriction + (bibtex-narrow-to-entry) + (run-hooks 'bibtex-clean-entry-hook))))))) (defun bibtex-fill-field-bounds (bounds justify &optional move) "Fill BibTeX field delimited by BOUNDS. @@ -3705,13 +3961,24 @@ If `bibtex-align-at-equal-sign' is non-nil, align equal signs, too." "Realign BibTeX entries such that they are separated by one blank line." (goto-char (point-min)) (let ((case-fold-search t)) + ;; No blank lines prior to the first valid entry if there no + ;; non-white characters in front of it. (when (looking-at bibtex-valid-entry-whitespace-re) (replace-match "\\1")) + ;; Valid entries are separated by one blank line. (while (re-search-forward bibtex-valid-entry-whitespace-re nil t) - (replace-match "\n\n\\1")))) + (replace-match "\n\n\\1")) + ;; One blank line past the last valid entry if it is followed by + ;; non-white characters, no blank line otherwise. + (beginning-of-line) + (when (re-search-forward bibtex-valid-entry-re nil t) + (bibtex-end-of-entry) + (bibtex-delete-whitespace) + (open-line (if (eobp) 1 2))))) (defun bibtex-reformat (&optional read-options) "Reformat all BibTeX entries in buffer or region. +Without prefix argument, reformatting is based on `bibtex-entry-format'. With prefix argument, read options for reformatting from minibuffer. With \\[universal-argument] \\[universal-argument] prefix argument, reuse previous answers (if any) again. If mark is active reformat entries in region, if not in whole buffer." @@ -3722,55 +3989,54 @@ If mark is active reformat entries in region, if not in whole buffer." (or bibtex-reformat-previous-options bibtex-reformat-previous-reference-keys))) (bibtex-entry-format - (if read-options - (if use-previous-options - bibtex-reformat-previous-options - (setq bibtex-reformat-previous-options - (mapcar (lambda (option) - (if (y-or-n-p (car option)) (cdr option))) - `(("Realign entries (recommended)? " . 'realign) - ("Remove empty optional and alternative fields? " . 'opts-or-alts) - ("Remove delimiters around pure numerical fields? " . 'numerical-fields) - (,(concat (if bibtex-comma-after-last-field "Insert" "Remove") - " comma at end of entry? ") . 'last-comma) - ("Replace double page dashes by single ones? " . 'page-dashes) - ("Force delimiters? " . 'delimiters) - ("Unify case of entry types and field names? " . 'unify-case))))) - '(realign))) + (cond (read-options + (if use-previous-options + bibtex-reformat-previous-options + (setq bibtex-reformat-previous-options + (mapcar (lambda (option) + (if (y-or-n-p (car option)) (cdr option))) + `(("Realign entries (recommended)? " . 'realign) + ("Remove empty optional and alternative fields? " . 'opts-or-alts) + ("Remove delimiters around pure numerical fields? " . 'numerical-fields) + (,(concat (if bibtex-comma-after-last-field "Insert" "Remove") + " comma at end of entry? ") . 'last-comma) + ("Replace double page dashes by single ones? " . 'page-dashes) + ("Inherit booktitle? " . 'inherit-booktitle) + ("Force delimiters? " . 'delimiters) + ("Unify case of entry types and field names? " . 'unify-case)))))) + ;; Do not include required-fields because `bibtex-reformat' + ;; cannot handle the error messages of `bibtex-format-entry'. + ;; Use `bibtex-validate' to check for required fields. + ((eq t bibtex-entry-format) + '(realign opts-or-alts numerical-fields delimiters + last-comma page-dashes unify-case inherit-booktitle)) + (t + (remove 'required-fields (push 'realign bibtex-entry-format))))) (reformat-reference-keys (if read-options (if use-previous-options bibtex-reformat-previous-reference-keys (setq bibtex-reformat-previous-reference-keys (y-or-n-p "Generate new reference keys automatically? "))))) - (start-point (if (bibtex-mark-active) - (region-beginning) - (point-min))) - (end-point (if (bibtex-mark-active) - (region-end) - (point-max))) (bibtex-sort-ignore-string-entries t) bibtex-autokey-edit-before-use) (save-restriction - (narrow-to-region start-point end-point) + (narrow-to-region (if mark-active (region-beginning) (point-min)) + (if mark-active (region-end) (point-max))) (if (memq 'realign bibtex-entry-format) - (bibtex-realign)) - (goto-char start-point) + (bibtex-realign)) (bibtex-progress-message "Formatting" 1) (bibtex-map-entries (lambda (key beg end) (bibtex-progress-message) (bibtex-clean-entry reformat-reference-keys t))) - (when (memq 'realign bibtex-entry-format) - (bibtex-delete-whitespace) - (open-line (if (eobp) 1 2))) (bibtex-progress-message 'done)) - (when (and reformat-reference-keys - bibtex-maintain-sorted-entries) - (bibtex-progress-message "Sorting" 1) - (bibtex-sort-buffer) + (when reformat-reference-keys (kill-local-variable 'bibtex-reference-keys) - (bibtex-progress-message 'done)) + (when bibtex-maintain-sorted-entries + (bibtex-progress-message "Sorting" 1) + (bibtex-sort-buffer) + (bibtex-progress-message 'done))) (goto-char pnt))) (defun bibtex-convert-alien (&optional read-options) @@ -3837,21 +4103,23 @@ signaled if point is outside key or BibTeX field." ;; key completion (setq choose-completion-string-functions (lambda (choice buffer mini-p base-size) - (bibtex-choose-completion-string choice buffer mini-p base-size) + (let ((choose-completion-string-functions nil)) + (choose-completion-string choice buffer base-size)) (bibtex-complete-key-cleanup choice) ;; return t (required by choose-completion-string-functions) t)) - (bibtex-complete-key-cleanup (bibtex-complete-internal + (bibtex-complete-key-cleanup (bibtex-complete-internal bibtex-reference-keys))) (compl ;; string completion (setq choose-completion-string-functions `(lambda (choice buffer mini-p base-size) - (bibtex-choose-completion-string choice buffer mini-p base-size) - (bibtex-complete-string-cleanup choice ',compl) - ;; return t (required by choose-completion-string-functions) - t)) + (let ((choose-completion-string-functions nil)) + (choose-completion-string choice buffer base-size)) + (bibtex-complete-string-cleanup choice ',compl) + ;; return t (required by choose-completion-string-functions) + t)) (bibtex-complete-string-cleanup (bibtex-complete-internal compl) compl)) @@ -3960,80 +4228,56 @@ signaled if point is outside key or BibTeX field." "\n") (goto-char endpos))) -(defun bibtex-url (&optional event) - "Browse a URL for the BibTeX entry at position PNT. +(defun bibtex-url (&optional pos) + "Browse a URL for the BibTeX entry at point. +Optional POS is the location of the BibTeX entry. The URL is generated using the schemes defined in `bibtex-generate-url-list' \(see there\). Then the URL is passed to `browse-url'." - (interactive (list last-input-event)) + (interactive) (save-excursion - (if event (posn-set-point (event-end event))) + (if pos (goto-char pos)) (bibtex-beginning-of-entry) (let ((fields-alist (bibtex-parse-entry)) + ;; Always ignore case, (case-fold-search t) (lst bibtex-generate-url-list) + (delim-regexp "\\`[{\"]\\(.*\\)[}\"]\\'") field url scheme) - (while (setq scheme (car lst)) + (while (setq scheme (pop lst)) (when (and (setq field (cdr (assoc-string (caar scheme) fields-alist t))) - (progn - (if (string-match "\\`[{\"]\\(.*\\)[}\"]\\'" field) - (setq field (match-string 1 field))) - (string-match (cdar scheme) field))) - (setq lst nil) + ;; Always remove field delimiters + (progn (if (string-match delim-regexp field) + (setq field (match-string 1 field))) + (string-match (cdar scheme) field))) + (setq lst nil) (if (null (cdr scheme)) (setq url (match-string 0 field))) (dolist (step (cdr scheme)) - (cond ((stringp step) - (setq url (concat url step))) - ((setq field (assoc-string (car step) fields-alist t)) - ;; always remove field delimiters - (let* ((text (if (string-match "\\`[{\"]\\(.*\\)[}\"]\\'" - (cdr field)) - (match-string 1 (cdr field)) - (cdr field))) - (str (if (string-match (nth 1 step) text) - (cond - ((functionp (nth 2 step)) - (funcall (nth 2 step) text)) - ((numberp (nth 2 step)) - (match-string (nth 2 step) text)) - (t - (replace-match (nth 2 step) nil nil text))) - ;; If the scheme is set up correctly, - ;; we should never reach this point - (error "Match failed: %s" text)))) - (setq url (concat url str)))) - ;; If the scheme is set up correctly, - ;; we should never reach this point - (t (error "Step failed: %s" step)))) - (message "%s" url) - (browse-url url)) - (setq lst (cdr lst))) - (unless url (message "No URL known."))))) - -(defun bibtex-font-lock-url (bound) - "Font-lock for URLs." - (let ((case-fold-search t) - (bounds (bibtex-enclosing-field t)) - (pnt (point)) - found field) - ;; We use start-of-field as syntax-begin - (goto-char (if bounds (bibtex-start-of-field bounds) pnt)) - (while (and (not found) - (prog1 (re-search-forward bibtex-font-lock-url-regexp bound t) - (setq field (match-string-no-properties 1))) - (setq bounds (bibtex-parse-field-text)) - (>= bound (car bounds)) - (>= (car bounds) pnt)) - (let ((lst bibtex-generate-url-list) url) - (goto-char (car bounds)) - (while (and (not found) - (setq url (caar lst))) - (when (bibtex-string= field (car url)) - (setq found (re-search-forward (cdr url) (cdr bounds) t))) - (setq lst (cdr lst)))) - (goto-char (cdr bounds))) - found)) + (cond ((stringp step) + (setq url (concat url step))) + ((setq field (cdr (assoc-string (car step) fields-alist t))) + ;; Always remove field delimiters + (if (string-match delim-regexp field) + (setq field (match-string 1 field))) + (if (string-match (nth 1 step) field) + (setq field (cond + ((functionp (nth 2 step)) + (funcall (nth 2 step) field)) + ((numberp (nth 2 step)) + (match-string (nth 2 step) field)) + (t + (replace-match (nth 2 step) nil nil field)))) + ;; If the scheme is set up correctly, + ;; we should never reach this point + (error "Match failed: %s" field)) + (setq url (concat url field))) + ;; If the scheme is set up correctly, + ;; we should never reach this point + (t (error "Step failed: %s" step)))) + (message "%s" url) + (browse-url url))) + (unless url (message "No URL known."))))) ;; Make BibTeX a Feature From 40a45facf30e2ddf7ae3172946cef66d9fa9d4f7 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 31 Oct 2004 22:52:54 +0000 Subject: [PATCH 018/146] (reveal-last-tick): New var. (reveal-post-command): Use it to avoid closing overlays when we're appending text to them. --- lisp/reveal.el | 79 ++++++++++++++++++++++++++++++-------------------- 1 file changed, 47 insertions(+), 32 deletions(-) diff --git a/lisp/reveal.el b/lisp/reveal.el index 2809db23e2e..393400071a6 100644 --- a/lisp/reveal.el +++ b/lisp/reveal.el @@ -1,6 +1,6 @@ ;;; reveal.el --- Automatically reveal hidden text at point -;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2004 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; Keywords: outlines @@ -59,6 +59,9 @@ (defvar reveal-open-spots nil) (make-variable-buffer-local 'reveal-open-spots) +(defvar reveal-last-tick nil) +(make-variable-buffer-local 'reveal-last-tick) + ;; Actual code (defun reveal-post-command () @@ -90,16 +93,16 @@ (overlays-at (point)))) (push (cons (selected-window) ol) reveal-open-spots) (setq old-ols (delq ol old-ols)) - (let ((open (overlay-get ol 'reveal-toggle-invisible))) + (let ((open (overlay-get ol 'reveal-toggle-invisible)) inv) (when (or open - (let ((inv (overlay-get ol 'invisible))) - (and inv (symbolp inv) - (or (setq open (or (get inv 'reveal-toggle-invisible) - (overlay-get ol 'isearch-open-invisible-temporary))) - (overlay-get ol 'isearch-open-invisible) - (and (consp buffer-invisibility-spec) - (assq inv buffer-invisibility-spec))) - (overlay-put ol 'reveal-invisible inv)))) + (and (setq inv (overlay-get ol 'invisible)) + (symbolp inv) + (or (setq open (or (get inv 'reveal-toggle-invisible) + (overlay-get ol 'isearch-open-invisible-temporary))) + (overlay-get ol 'isearch-open-invisible) + (and (consp buffer-invisibility-spec) + (assq inv buffer-invisibility-spec))) + (overlay-put ol 'reveal-invisible inv))) (if (null open) (overlay-put ol 'invisible nil) ;; Use the provided opening function and repeat (since the @@ -113,27 +116,39 @@ (setq repeat nil) (overlay-put ol 'invisible nil)))))))) ;; Close old overlays. - (dolist (ol old-ols) - (when (and (eq (current-buffer) (overlay-buffer ol)) - (not (rassq ol reveal-open-spots))) - (if (and (>= (point) (save-excursion - (goto-char (overlay-start ol)) - (line-beginning-position 1))) - (<= (point) (save-excursion - (goto-char (overlay-end ol)) - (line-beginning-position 2)))) - ;; Still near the overlay: keep it open. - (push (cons (selected-window) ol) reveal-open-spots) - ;; Really close it. - (let ((open (overlay-get ol 'reveal-toggle-invisible)) inv) - (if (or open - (and (setq inv (overlay-get ol 'reveal-invisible)) - (setq open (or (get inv 'reveal-toggle-invisible) - (overlay-get ol 'isearch-open-invisible-temporary))))) - (condition-case err - (funcall open ol t) - (error (message "!!Reveal-hide: %s !!" err))) - (overlay-put ol 'invisible inv))))))) + (if (not (eq reveal-last-tick + (setq reveal-last-tick (buffer-modified-tick)))) + ;; The buffer was modified since last command: let's refrain from + ;; closing any overlay because it tends to behave poorly when + ;; inserting text at the end of an overlay (basically the overlay + ;; should be rear-advance when it's open, but things like + ;; outline-minor-mode make it non-rear-advance because it's + ;; a better choice when it's closed). + (dolist (ol old-ols) + (push (cons (selected-window) ol) reveal-open-spots)) + ;; The last command was only a point motion or some such + ;; non-buffer-modifying command. Let's close whatever can be closed. + (dolist (ol old-ols) + (when (and (eq (current-buffer) (overlay-buffer ol)) + (not (rassq ol reveal-open-spots))) + (if (and (>= (point) (save-excursion + (goto-char (overlay-start ol)) + (line-beginning-position 1))) + (<= (point) (save-excursion + (goto-char (overlay-end ol)) + (line-beginning-position 2)))) + ;; Still near the overlay: keep it open. + (push (cons (selected-window) ol) reveal-open-spots) + ;; Really close it. + (let ((open (overlay-get ol 'reveal-toggle-invisible)) inv) + (if (or open + (and (setq inv (overlay-get ol 'reveal-invisible)) + (setq open (or (get inv 'reveal-toggle-invisible) + (overlay-get ol 'isearch-open-invisible-temporary))))) + (condition-case err + (funcall open ol t) + (error (message "!!Reveal-hide: %s !!" err))) + (overlay-put ol 'invisible inv)))))))) (error (message "Reveal: %s" err))))) ;;;###autoload @@ -171,5 +186,5 @@ With zero or negative ARG turn mode off." (provide 'reveal) -;;; arch-tag: 96ba0242-2274-4ed7-8e10-26bc0707b4d8 +;; arch-tag: 96ba0242-2274-4ed7-8e10-26bc0707b4d8 ;;; reveal.el ends here From 5bad605398b31113672736c0d3c2137fcb5cf9b9 Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Sun, 31 Oct 2004 23:44:57 +0000 Subject: [PATCH 019/146] *** empty log message *** --- lisp/ChangeLog | 4 ++++ lisp/man.el | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 88104f310d8..ae115a20c12 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2004-11-01 Kim F. Storm + + * man.el (Man-xref-normal-file): Fix help-echo. + 2004-10-31 Roland Winkler * textmodes/bibtex.el: Require button. diff --git a/lisp/man.el b/lisp/man.el index afd183fa720..e4573748fcb 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -426,7 +426,7 @@ Otherwise, the value is whatever the function (view-file f) (error "Cannot read a file: %s" f)) (error "Cannot find a file: %s" f)))) - 'help-echo "mouse-2: mouse-2: display this file") + 'help-echo "mouse-2: display this file") ;; ====================================================================== From 65970d645c7d3574a9b34533c9cb744ed3cfd6da Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Mon, 1 Nov 2004 07:32:17 +0000 Subject: [PATCH 020/146] (allout group): Add :version. (allout-init): Don't use interactive-p. (allout-ascend-to-depth, allout-ascend, allout-end-of-level) (allout-forward-current-level, allout-backward-current-level): Don't use interactive-p. --- lisp/allout.el | 63 ++++++++++++++++++++++---------------------------- 1 file changed, 28 insertions(+), 35 deletions(-) diff --git a/lisp/allout.el b/lisp/allout.el index 903574e4ade..fa88588ec36 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -68,7 +68,8 @@ (defgroup allout nil "Extensive outline mode for use alone and with other modes." :prefix "allout-" - :group 'editing) + :group 'editing + :version "21.4") ;;;_ + Layout, Mode, and Topic Header Configuration @@ -507,7 +508,7 @@ behavior." ;;;_ : Version ;;;_ = allout-version (defvar allout-version - (let ((rcs-rev "$Revision: 1.49 $")) + (let ((rcs-rev "$Revision$")) (condition-case err (save-match-data (string-match "Revision: \\([0-9]+\\.[0-9]+\\)" rcs-rev) @@ -954,20 +955,16 @@ the following two lines in your Emacs init file: \(require 'allout) \(allout-init t)" - (interactive) - (if (interactive-p) - (progn - (setq mode - (completing-read - (concat "Select outline auto setup mode " - "(empty for report, ? for options) ") - '(("nil")("full")("activate")("deactivate") - ("ask") ("report") ("")) - nil - t)) - (if (string= mode "") - (setq mode 'report) - (setq mode (intern-soft mode))))) + (interactive + (let ((m (completing-read + (concat "Select outline auto setup mode " + "(empty for report, ? for options) ") + '(("nil")("full")("activate")("deactivate") + ("ask") ("report") ("")) + nil + t))) + (if (string= m "") 'report + (intern-soft m)))) (let ;; convenience aliases, for consistent ref to respective vars: ((hook 'allout-find-file-hook) @@ -1902,16 +1899,12 @@ If already there, move cursor to bullet for hot-spot operation. (if (= (allout-recent-depth) depth) (progn (goto-char allout-recent-prefix-beginning) depth) - (goto-char last-good) - nil)) - (if (interactive-p) (allout-end-of-prefix)))) + (goto-char last-good))))) ;;;_ > allout-ascend () (defun allout-ascend () "Ascend one level, returning t if successful, nil if not." - (prog1 - (if (allout-beginning-of-level) - (allout-previous-heading)) - (if (interactive-p) (allout-end-of-prefix)))) + (if (allout-beginning-of-level) + (allout-previous-heading))) ;;;_ > allout-descend-to-depth (depth) (defun allout-descend-to-depth (depth) "Descend to depth DEPTH within current topic. @@ -1931,13 +1924,13 @@ Returning depth if successful, nil if not." nil)) ) ;;;_ > allout-up-current-level (arg &optional dont-complain) -(defun allout-up-current-level (arg &optional dont-complain) +(defun allout-up-current-level (arg &optional dont-complain interactive) "Move out ARG levels from current visible topic. Positions on heading line of containing topic. Error if unable to ascend that far, or nil if unable to ascend but optional arg DONT-COMPLAIN is non-nil." - (interactive "p") + (interactive "p\np") (allout-back-to-current-heading) (let ((present-level (allout-recent-depth)) (last-good (point)) @@ -1958,12 +1951,12 @@ DONT-COMPLAIN is non-nil." (if (or failed (> arg 0)) (progn (goto-char last-good) - (if (interactive-p) (allout-end-of-prefix)) + (if interactive (allout-end-of-prefix)) (if (not dont-complain) (error "Can't ascend past outermost level") - (if (interactive-p) (allout-end-of-prefix)) + (if interactive (allout-end-of-prefix)) nil)) - (if (interactive-p) (allout-end-of-prefix)) + (if interactive (allout-end-of-prefix)) allout-recent-prefix-beginning))) ;;;_ - Linear @@ -2029,7 +2022,7 @@ Presumes point is at the start of a topic prefix." (let ((depth (allout-depth))) (while (allout-previous-sibling depth nil)) (prog1 (allout-recent-depth) - (if (interactive-p) (allout-end-of-prefix))))) + (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. @@ -2067,13 +2060,13 @@ matches)." (interactive "p") (allout-next-visible-heading (- arg))) ;;;_ > allout-forward-current-level (arg) -(defun allout-forward-current-level (arg) +(defun allout-forward-current-level (arg &optional interactive) "Position point at the next heading of the same level. Takes optional repeat-count, goes backward if count is negative. Returns resulting position, else nil if none found." - (interactive "p") + (interactive "p\np") (let ((start-depth (allout-current-depth)) (start-point (point)) (start-arg arg) @@ -2101,7 +2094,7 @@ Returns resulting position, else nil if none found." (= (allout-recent-depth) start-depth))) allout-recent-prefix-beginning (goto-char last-good) - (if (not (interactive-p)) + (if (not interactive) nil (allout-end-of-prefix) (error "Hit %s level %d topic, traversed %d of %d requested" @@ -2110,10 +2103,10 @@ Returns resulting position, else nil if none found." (- (abs start-arg) arg) (abs start-arg)))))) ;;;_ > allout-backward-current-level (arg) -(defun allout-backward-current-level (arg) +(defun allout-backward-current-level (arg &optional interactive) "Inverse of `allout-forward-current-level'." - (interactive "p") - (if (interactive-p) + (interactive "p\np") + (if interactive (let ((current-prefix-arg (* -1 arg))) (call-interactively 'allout-forward-current-level)) (allout-forward-current-level (* -1 arg)))) From 3f3ed959289a3ea8a74c5f20c69cdbcfcd2eb5f4 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Mon, 1 Nov 2004 07:35:47 +0000 Subject: [PATCH 021/146] (bibtex-make-field): Don't use interactive-p. (bibtex-find-text): Likewise. --- lisp/textmodes/bibtex.el | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 3601fbd7d26..92614c02d27 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -3007,12 +3007,13 @@ Move point to the end of the last field." (message (nth 1 comment)) (message "No comment available"))))) -(defun bibtex-make-field (field &optional called-by-yank) +(defun bibtex-make-field (field &optional called-by-yank interactive) "Make a field named FIELD in current BibTeX entry. FIELD is either a string or a list of the form \(FIELD-NAME COMMENT-STRING INIT ALTERNATIVE-FLAG) as in `bibtex-entry-field-alist'. -If CALLED-BY-YANK is non-nil, don't insert delimiters." +If CALLED-BY-YANK is non-nil, don't insert delimiters. +In that case, or when called interactively, also don't do (WHAT?)." (interactive (list (let ((completion-ignore-case t) (field-list (bibtex-field-list @@ -3021,10 +3022,11 @@ If CALLED-BY-YANK is non-nil, don't insert delimiters." (bibtex-type-in-head))))) (completing-read "BibTeX field name: " (append (car field-list) (cdr field-list)) - nil nil nil bibtex-field-history)))) + nil nil nil bibtex-field-history)) + t)) (unless (consp field) (setq field (list field))) - (if (or (interactive-p) called-by-yank) + (if (or interactive called-by-yank) (let (bibtex-help-message) (bibtex-find-text nil t t) (if (looking-at "[}\"]") @@ -3047,7 +3049,7 @@ If CALLED-BY-YANK is non-nil, don't insert delimiters." ((fboundp init) (insert (funcall init))))) (unless called-by-yank (insert (bibtex-field-right-delimiter))) - (when (interactive-p) + (when interactivw (forward-char -1) (bibtex-print-help-message))) @@ -3610,10 +3612,9 @@ Return t if test was successful, nil otherwise." (defun bibtex-find-text (arg &optional as-if-interactive no-error) "Go to end of text of current field; with ARG, go to beginning." - (interactive "P") + (interactive "P\np") (bibtex-inside-field) - (let ((bounds (bibtex-enclosing-field (or (interactive-p) - as-if-interactive)))) + (let ((bounds (bibtex-enclosing-field as-if-interactive))) (if bounds (progn (if arg (progn (goto-char (bibtex-start-of-text-in-field bounds)) From 8d422bd5a55cb1e97fdcf8a1af36f3a845326331 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Mon, 1 Nov 2004 07:37:24 +0000 Subject: [PATCH 022/146] (vhdl-fill-region, vhdl-beginning-of-statement): Don't use interactive-p. --- lisp/progmodes/vhdl-mode.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 42aabace4d2..cb2a3e2dfcc 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -6120,17 +6120,17 @@ stops due to beginning or end of buffer." (vhdl-keep-region-active) foundp)) -(defun vhdl-beginning-of-statement (&optional count lim) +(defun vhdl-beginning-of-statement (&optional count lim interactive) "Go to the beginning of the innermost VHDL statement. With prefix arg, go back N - 1 statements. If already at the beginning of a statement then go to the beginning of the preceding one. If within a string or comment, or next to a comment (only whitespace between), move by sentences instead of statements. -When called from a program, this function takes 2 optional args: the +When called from a program, this function takes 3 optional args: the prefix arg, and a buffer position limit which is the farthest back to -search." - (interactive "p") +search, and something whose meaning I don't understand." + (interactive "p\np") (let ((count (or count 1)) (case-fold-search t) (lim (or lim (point-min))) @@ -6139,7 +6139,7 @@ search." (save-excursion (goto-char lim) (setq state (parse-partial-sexp (point) here nil nil))) - (if (and (interactive-p) + (if (and interactive (or (nth 3 state) (nth 4 state) (looking-at (concat "[ \t]*" comment-start-skip)))) @@ -7531,10 +7531,10 @@ buffer." (defun vhdl-fill-region (beg end &optional arg) "Fill lines for a region of code." - (interactive "r") + (interactive "r\np") (save-excursion (goto-char beg) - (let ((margin (if (interactive-p) (current-indentation) (current-column)))) + (let ((margin (if interactive (current-indentation) (current-column)))) (goto-char end) (setq end (point-marker)) ;; remove inline comments, newlines and whitespace From 751adbdeccb326c6f04da69f01dbfef527e739c4 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Mon, 1 Nov 2004 07:39:44 +0000 Subject: [PATCH 023/146] (idlwave-update-routine-info): Don't use interactive-p. --- lisp/progmodes/idlwave.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index a49f70aa0b0..a5e07049843 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -4231,7 +4231,7 @@ will re-read the catalog." (defvar idlwave-load-rinfo-idle-timer) -(defun idlwave-update-routine-info (&optional arg) +(defun idlwave-update-routine-info (&optional arg dont-concentrate) "Update the internal routine-info lists. These lists are used by `idlwave-routine-info' (\\[idlwave-routine-info]) and by `idlwave-complete' (\\[idlwave-complete]) to provide information @@ -4248,10 +4248,12 @@ Scans all IDLWAVE-mode buffers of the current editing session (see When an IDL shell is running, this command also queries the IDL program for currently compiled routines. +???Document what DONT-CONCENTRATE means??? + With prefix ARG, also reload the system and library lists. With two prefix ARG's, also rescans the library tree. With three prefix args, dispatch asynchronous process to do the update." - (interactive "P") + (interactive "P\np") ;; Stop any idle processing (if (or (and (fboundp 'itimerp) (itimerp idlwave-load-rinfo-idle-timer)) @@ -4300,7 +4302,7 @@ With three prefix args, dispatch asynchronous process to do the update." idlwave-query-shell-for-routine-info))) (if (or (not ask-shell) - (not (interactive-p))) + (not dont-concentrate)) ;; 1. If we are not going to ask the shell, we need to do the ;; concatenation now. ;; 2. When this function is called non-interactively, it means From 6db31cbc79b4e5251b2b9b2e4e6b9349d57410c1 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Mon, 1 Nov 2004 07:41:08 +0000 Subject: [PATCH 024/146] (idlwave-shell-send-char): Don't use interactive-p. --- lisp/progmodes/idlw-shell.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index ae0c43c2730..692fce0234e 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -1137,10 +1137,10 @@ prompt is present and if `idlwave-shell-ready' is non-nil." (goto-char save-point)) (set-buffer save-buffer)))) -(defun idlwave-shell-send-char (c &optional no-error) +(defun idlwave-shell-send-char (c &optional error) "Send one character to the shell, without a newline." - (interactive "cChar to send to IDL: ") - (let ((errf (if (interactive-p) 'error 'message)) + (interactive "cChar to send to IDL: \np") + (let ((errf (if error 'error 'message)) buf proc) (if (or (not (setq buf (get-buffer (idlwave-shell-buffer)))) (not (setq proc (get-buffer-process buf)))) From 21df56d56b86b88565ebe9f05f1acbbfd676670f Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Mon, 1 Nov 2004 07:42:19 +0000 Subject: [PATCH 025/146] (cperl-switch-to-doc-buffer): Don't use interactive-p. --- lisp/progmodes/cperl-mode.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index e679a48d642..94458df56e8 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -6664,11 +6664,11 @@ prototype \&SUB Returns prototype of the function given a reference. =pod Switch from Perl to POD. ") -(defun cperl-switch-to-doc-buffer () +(defun cperl-switch-to-doc-buffer (&optional interactive) "Go to the perl documentation buffer and insert the documentation." - (interactive) + (interactive "p") (let ((buf (get-buffer-create cperl-doc-buffer))) - (if (interactive-p) + (if interactive (switch-to-buffer-other-window buf) (set-buffer buf)) (if (= (buffer-size) 0) From 2dccd96f17987622cd76ca46708ed6cbc67d3255 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Mon, 1 Nov 2004 07:44:08 +0000 Subject: [PATCH 026/146] (ada-make-body-gnatstub): Don't use interactive-p. --- lisp/progmodes/ada-xref.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el index fc1d2d46ab3..472cfc3053e 100644 --- a/lisp/progmodes/ada-xref.el +++ b/lisp/progmodes/ada-xref.el @@ -2154,17 +2154,17 @@ This is a GNAT specific function that uses gnatkrunch." adaname ) -(defun ada-make-body-gnatstub () +(defun ada-make-body-gnatstub (&optional interactive) "Create an Ada package body in the current buffer. This function uses the `gnatstub' program to create the body. This function typically is to be hooked into `ff-file-created-hooks'." - (interactive) + (interactive "p") (save-some-buffers nil nil) ;; If the current buffer is the body (as is the case when calling this ;; function from ff-file-created-hooks), then kill this temporary buffer - (unless (interactive-p) + (unless interactive (progn (set-buffer-modified-p nil) (kill-buffer (current-buffer)))) From 1d4408c8ebf209bd83bae5745bc273d5d484c745 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Mon, 1 Nov 2004 07:45:18 +0000 Subject: [PATCH 027/146] (fortune-to-signature): Don't use interactive-p. (fortune-in-buffer): Doc fix. --- lisp/play/fortune.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/play/fortune.el b/lisp/play/fortune.el index 306cf7daac1..3919f57e78c 100644 --- a/lisp/play/fortune.el +++ b/lisp/play/fortune.el @@ -271,7 +271,7 @@ and choose the directory as the fortune-file." (fortune-ask-file) fortune-file))) (save-excursion - (fortune-in-buffer (interactive-p) file) + (fortune-in-buffer t file) (set-buffer fortune-buffer-name) (let* ((fortune (buffer-string)) (signature (concat fortune-sigstart fortune fortune-sigend))) @@ -285,7 +285,7 @@ and choose the directory as the fortune-file." (defun fortune-in-buffer (interactive &optional file) "Put a fortune cookie in the *fortune* buffer. -When INTERACTIVE is nil, don't display it. Optional argument FILE, +INTERACTIVE is ignored. Optional argument FILE, when supplied, specifies the file to choose the fortune from." (let ((fortune-buffer (or (get-buffer fortune-buffer-name) (generate-new-buffer fortune-buffer-name))) From ca5f43fa079964246af32562774a6dbd462622a8 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Mon, 1 Nov 2004 07:46:16 +0000 Subject: [PATCH 028/146] (5x5-new-game): Set up the buffer even if not interactive. --- lisp/play/5x5.el | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el index 886e53a6afa..83d67958f44 100644 --- a/lisp/play/5x5.el +++ b/lisp/play/5x5.el @@ -224,9 +224,8 @@ Quit current game \\[5x5-quit-game]" 5x5-y-pos (/ 5x5-grid-size 2) 5x5-moves 0 5x5-grid (5x5-make-move (5x5-make-new-grid) 5x5-y-pos 5x5-x-pos)) - (when (interactive-p) - (5x5-draw-grid (list 5x5-grid)) - (5x5-position-cursor)))) + (5x5-draw-grid (list 5x5-grid)) + (5x5-position-cursor))) (defun 5x5-quit-game () "Quit the current game of `5x5'." From 9d0d10708496729d062ae04fe2f191c16dc831b3 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Mon, 1 Nov 2004 07:47:08 +0000 Subject: [PATCH 029/146] (Interactive Call): Add called-interactively-p. --- lispref/commands.texi | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/lispref/commands.texi b/lispref/commands.texi index f1f94e11838..3c9612e5186 100644 --- a/lispref/commands.texi +++ b/lispref/commands.texi @@ -617,7 +617,7 @@ This function returns @code{t} if the containing function (the one whose code includes the call to @code{interactive-p}) was called in direct response to user input. This means that it was called with the function @code{call-interactively}, and that a keyboard macro is -not running. +not running, and that Emacs is not running in batch mode. If the containing function was called by Lisp evaluation (or with @code{apply} or @code{funcall}), then it was not called interactively. @@ -679,6 +679,15 @@ Defined in this way, the function does display the message when called from a keyboard macro. We use @code{"p"} because the numeric prefix argument is never @code{nil}. +@defun called-interactively-p +This function returns @code{t} when the calling function was called +using @code{call-interactively}. + +When possible, instead of using this function, you should use the +method in the example above; that method makes it possible for a +caller to ``pretend'' that the function was called interactively. +@end defun + @node Command Loop Info @comment node-name, next, previous, up @section Information from the Command Loop From e2c76fd857e1174126d92b134fd76def53c65b40 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Mon, 1 Nov 2004 07:47:18 +0000 Subject: [PATCH 030/146] (eudc-display-records): Use with-output-to-temp-buffer; don't select the temporary buffer. (eudc-get-email): New optional arg ERROR; don't use interactive-p. (eudc-get-phone): Likewise. --- lisp/net/eudc.el | 142 ++++++++++++++++++++++++----------------------- 1 file changed, 72 insertions(+), 70 deletions(-) diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index 6d12d5e6364..bcdd1d195bf 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -462,73 +462,73 @@ attribute name ATTR." "Display the record list RECORDS in a formatted buffer. If RAW-ATTR-NAMES is non-nil, the raw attribute names are displayed otherwise they are formatted according to `eudc-user-attribute-names-alist'." - (let ((buffer (get-buffer-create "*Directory Query Results*")) - inhibit-read-only + (let (inhibit-read-only precords (width 0) beg first-record attribute-name) - (switch-to-buffer buffer) - (setq buffer-read-only t) - (setq inhibit-read-only t) - (erase-buffer) - (insert "Directory Query Result\n") - (insert "======================\n\n\n") - (if (null records) - (insert "No match found.\n" - (if eudc-strict-return-matches - "Try setting `eudc-strict-return-matches' to nil or change `eudc-default-return-attributes'.\n" - "")) - ;; Replace field names with user names, compute max width - (setq precords - (mapcar - (function - (lambda (record) + (with-output-to-temp-buffer "*Directory Query Results*" + (with-current-buffer standard-output + (setq buffer-read-only t) + (setq inhibit-read-only t) + (erase-buffer) + (insert "Directory Query Result\n") + (insert "======================\n\n\n") + (if (null records) + (insert "No match found.\n" + (if eudc-strict-return-matches + "Try setting `eudc-strict-return-matches' to nil or change `eudc-default-return-attributes'.\n" + "")) + ;; Replace field names with user names, compute max width + (setq precords (mapcar (function - (lambda (field) - (setq attribute-name - (if raw-attr-names - (symbol-name (car field)) - (eudc-format-attribute-name-for-display (car field)))) - (if (> (length attribute-name) width) - (setq width (length attribute-name))) - (cons attribute-name (cdr field)))) - record))) - records)) - ;; Display the records - (setq first-record (point)) - (mapcar - (function - (lambda (record) - (setq beg (point)) - ;; Map over the record fields to print the attribute/value pairs - (mapcar (function - (lambda (field) - (eudc-print-record-field field width))) - record) - ;; Store the record internal format in some convenient place - (overlay-put (make-overlay beg (point)) - 'eudc-record - (car records)) - (setq records (cdr records)) - (insert "\n"))) - precords)) - (insert "\n") - (widget-create 'push-button - :notify (lambda (&rest ignore) - (eudc-query-form)) - "New query") - (widget-insert " ") - (widget-create 'push-button - :notify (lambda (&rest ignore) - (kill-this-buffer)) - "Quit") - (eudc-mode) - (widget-setup) - (if first-record - (goto-char first-record)))) + (lambda (record) + (mapcar + (function + (lambda (field) + (setq attribute-name + (if raw-attr-names + (symbol-name (car field)) + (eudc-format-attribute-name-for-display (car field)))) + (if (> (length attribute-name) width) + (setq width (length attribute-name))) + (cons attribute-name (cdr field)))) + record))) + records)) + ;; Display the records + (setq first-record (point)) + (mapcar + (function + (lambda (record) + (setq beg (point)) + ;; Map over the record fields to print the attribute/value pairs + (mapcar (function + (lambda (field) + (eudc-print-record-field field width))) + record) + ;; Store the record internal format in some convenient place + (overlay-put (make-overlay beg (point)) + 'eudc-record + (car records)) + (setq records (cdr records)) + (insert "\n"))) + precords)) + (insert "\n") + (widget-create 'push-button + :notify (lambda (&rest ignore) + (eudc-query-form)) + "New query") + (widget-insert " ") + (widget-create 'push-button + :notify (lambda (&rest ignore) + (kill-this-buffer)) + "Quit") + (eudc-mode) + (widget-setup) + (if first-record + (goto-char first-record)))))) (defun eudc-process-form () "Process the query form in current buffer and display the results." @@ -709,34 +709,36 @@ server for future sessions." (eudc-save-options))) ;;;###autoload -(defun eudc-get-email (name) - "Get the email field of NAME from the directory server." - (interactive "sName: ") +(defun eudc-get-email (name &optional error) + "Get the email field of NAME from the directory server. +If ERROR is non-nil, report an error if there is none." + (interactive "sName: \np") (or eudc-server (call-interactively 'eudc-set-server)) (let ((result (eudc-query (list (cons 'name name)) '(email))) email) (if (null (cdr result)) (setq email (eudc-cdaar result)) - (error "Multiple match. Use the query form")) - (if (interactive-p) + (error "Multiple match--use the query form")) + (if error (if email (message "%s" email) (error "No record matching %s" name))) email)) ;;;###autoload -(defun eudc-get-phone (name) - "Get the phone field of NAME from the directory server." - (interactive "sName: ") +(defun eudc-get-phone (name &optional error) + "Get the phone field of NAME from the directory server. +If ERROR is non-nil, report an error if there is none." + (interactive "sName: \np") (or eudc-server (call-interactively 'eudc-set-server)) (let ((result (eudc-query (list (cons 'name name)) '(phone))) phone) (if (null (cdr result)) (setq phone (eudc-cdaar result)) - (error "Multiple match. Use the query form")) - (if (interactive-p) + (error "Multiple match--use the query form")) + (if error (if phone (message "%s" phone) (error "No record matching %s" name))) From 2d1ef312c83d551dab1416d532652492bf7aead0 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Mon, 1 Nov 2004 07:48:44 +0000 Subject: [PATCH 031/146] *** empty log message *** --- admin/FOR-RELEASE | 6 ++++++ etc/NEWS | 7 +++++++ etc/TODO | 2 ++ lisp/ChangeLog | 36 ++++++++++++++++++++++++++++++++++++ lispref/ChangeLog | 4 ++++ 5 files changed, 55 insertions(+) diff --git a/admin/FOR-RELEASE b/admin/FOR-RELEASE index 1898cf4dea4..864f0285ab2 100644 --- a/admin/FOR-RELEASE +++ b/admin/FOR-RELEASE @@ -18,11 +18,17 @@ redisplay uses an invalidated face_id with FACE_FROM_ID which then returns a NULL pointer. Said to happen with isearch faces. +* LOSSAGE + +** Clean up flymake.el to follow Emacs Lisp conventions. * GTK RELATED BUGS ** Make GTK scrollbars behave like others w.r.t. overscrolling. +** Make GTK update the menu bar in two stages, as with Xt, + so that the first can run Lisp code, while only the second + needs BLOCK_INPUT. * DOCUMENTATION diff --git a/etc/NEWS b/etc/NEWS index bb3d762f8b9..0d5adfdc98c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2312,6 +2312,13 @@ configuration files. * Lisp Changes in Emacs 21.4 ++++ +** The new function `called-interactively-p' does what many people +have mistakenly believed `interactively-p' did: it returns t if the +calling function was called through `call-interactively'. +This should only be used when you cannot add a new "interactively" +argument to the command. + +++ ** An interactive specification may now use the code letter 'U' to get the up-event that was discarded in case the last key sequence read for a diff --git a/etc/TODO b/etc/TODO index defc43892c2..21a7c7d8dc0 100644 --- a/etc/TODO +++ b/etc/TODO @@ -85,6 +85,8 @@ to the FSF. at the same time and do it in a context-sensitive way. *** ability to add mode-specific data to the partial-parse-state. +** Add a way to convert a keyboard macro to equivalent Lisp code. + ** Have a command suggestion help system that recognizes patterns of commands which could be replaced with a simpler common command. It should not make more than one suggestion per 10 minutes. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ae115a20c12..e5dd9b7f3fa 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,39 @@ +2004-11-01 Richard M. Stallman + + * allout.el (allout group): Add :version. + (allout-init): Don't use interactive-p. + (allout-ascend-to-depth, allout-ascend, allout-end-of-level) + (allout-forward-current-level, allout-backward-current-level): + Don't use interactive-p. + + * textmodes/bibtex.el (bibtex-make-field): Don't use interactive-p. + (bibtex-find-text): Likewise. + + * progmodes/vhdl-mode.el (vhdl-fill-region) + (vhdl-beginning-of-statement): Don't use interactive-p. + + * progmodes/idlwave.el (idlwave-update-routine-info): + Don't use interactive-p. + + * progmodes/idlw-shell.el (idlwave-shell-send-char): + Don't use interactive-p. + + * progmodes/cperl-mode.el (cperl-switch-to-doc-buffer): + Don't use interactive-p. + + * progmodes/ada-xref.el (ada-make-body-gnatstub): + Don't use interactive-p. + + * play/fortune.el (fortune-to-signature): Don't use interactive-p. + (fortune-in-buffer): Doc fix. + + * play/5x5.el (5x5-new-game): Set up the buffer even if not interactive. + + * net/eudc.el (eudc-display-records): Use with-output-to-temp-buffer; + don't select the temporary buffer. + (eudc-get-email): New optional arg ERROR; don't use interactive-p. + (eudc-get-phone): Likewise. + 2004-11-01 Kim F. Storm * man.el (Man-xref-normal-file): Fix help-echo. diff --git a/lispref/ChangeLog b/lispref/ChangeLog index c47ad2f889d..d1bb65d3358 100644 --- a/lispref/ChangeLog +++ b/lispref/ChangeLog @@ -1,3 +1,7 @@ +2004-11-01 Richard M. Stallman + + * commands.texi (Interactive Call): Add called-interactively-p. + 2004-10-29 Simon Josefsson * minibuf.texi (Reading a Password): Revert. From bb8eaf670558c4b670ec8fa6bd3d368e1483cfe3 Mon Sep 17 00:00:00 2001 From: John Paul Wallington Date: Mon, 1 Nov 2004 07:56:17 +0000 Subject: [PATCH 032/146] (large-file-warning-threshold): Add :version keyword. (kill-some-buffers): Doc fix. --- lisp/files.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/files.el b/lisp/files.el index a4f846fbdee..5ff80615050 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1225,6 +1225,7 @@ suppresses this warning." When nil, never request confirmation." :group 'files :group 'find-file + :version "21.4" :type '(choice integer (const :tag "Never request confirmation" nil))) (defun find-file-noselect (filename &optional nowarn rawfile wildcards) @@ -3813,7 +3814,7 @@ This command is used in the special Dired buffer created by (defun kill-some-buffers (&optional list) "Kill some buffers. Asks the user whether to kill each one of them. -Non-interactively, if optional argument LIST is non-`nil', it +Non-interactively, if optional argument LIST is non-nil, it specifies the list of buffers to kill, asking for approval for each one." (interactive) (if (null list) From 2b601e1ccd453ca72f7dc31b31cb33c1342872a6 Mon Sep 17 00:00:00 2001 From: John Paul Wallington Date: Mon, 1 Nov 2004 08:01:14 +0000 Subject: [PATCH 033/146] (group thumbs): Add :version keyword. --- lisp/ChangeLog | 7 +++++++ lisp/thumbs.el | 7 ++++--- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index e5dd9b7f3fa..020d20a23b6 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,10 @@ +2004-11-01 John Paul Wallington + + * files.el (large-file-warning-threshold): Add :version keyword. + (kill-some-buffers): Doc fix. + + * thumbs.el (group thumbs): Add :version keyword. + 2004-11-01 Richard M. Stallman * allout.el (allout group): Add :version. diff --git a/lisp/thumbs.el b/lisp/thumbs.el index 13970e59ee8..b6a68df33c4 100644 --- a/lisp/thumbs.el +++ b/lisp/thumbs.el @@ -30,8 +30,8 @@ ;;; Commentary: ;; This package create two new mode: thumbs-mode and -;; thumbs-view-image-mode. It is used for images browsing and viewing -;; from within emacs. Minimal image manipulation functions are also +;; thumbs-view-image-mode. It is used for images browsing and viewing +;; from within Emacs. Minimal image manipulation functions are also ;; available via external programs. ;; ;; The 'convert' program from 'ImageMagick' @@ -62,6 +62,7 @@ (defgroup thumbs nil "Thumbnails previewer." + :version "21.4" :group 'multimedia) (defcustom thumbs-thumbsdir @@ -416,7 +417,7 @@ and SAME-WINDOW to show thumbs in the same window." (defalias 'thumbs 'thumbs-show-all-from-dir) (defun thumbs-find-image (img &optional num otherwin) - (funcall + (funcall (if otherwin 'switch-to-buffer-other-window 'switch-to-buffer) (concat "*Image: " (file-name-nondirectory img) " - " (number-to-string (or num 0)) "*")) From 2c10c0f0639616bfb7ade19f6b40fdd1b71f9aeb Mon Sep 17 00:00:00 2001 From: John Paul Wallington Date: Mon, 1 Nov 2004 08:13:50 +0000 Subject: [PATCH 034/146] (bibtex-make-field): Fix typo. --- lisp/ChangeLog | 2 ++ lisp/textmodes/bibtex.el | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 020d20a23b6..64ac6903651 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -5,6 +5,8 @@ * thumbs.el (group thumbs): Add :version keyword. + * textmodes/bibtex.el (bibtex-make-field): Fix typo. + 2004-11-01 Richard M. Stallman * allout.el (allout group): Add :version. diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 92614c02d27..dd989fbea81 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -3049,7 +3049,7 @@ In that case, or when called interactively, also don't do (WHAT?)." ((fboundp init) (insert (funcall init))))) (unless called-by-yank (insert (bibtex-field-right-delimiter))) - (when interactivw + (when interactive (forward-char -1) (bibtex-print-help-message))) From 1a99fe1a39c8e20040ed1961284625395d51210f Mon Sep 17 00:00:00 2001 From: Jason Rumney Date: Mon, 1 Nov 2004 08:51:57 +0000 Subject: [PATCH 035/146] *** empty log message *** --- src/ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/ChangeLog b/src/ChangeLog index 77f6f2d073f..3e3a60158a9 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2004-11-01 Andy Petrusenco (tiny change) + + * w32term.c (x_scroll_run): Delete region objects after use. + 2004-10-31 Jan Dj,Ad(Brv * xmenu.c: Add prototypes for forward function declarations. From e8ac5d8824ce3faaaa20b4a137166bdb5b517e25 Mon Sep 17 00:00:00 2001 From: Jason Rumney Date: Mon, 1 Nov 2004 08:52:47 +0000 Subject: [PATCH 036/146] Delete region objects after use. --- src/w32term.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/w32term.c b/src/w32term.c index 3e2e566adc5..fea57849ad2 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -2763,9 +2763,13 @@ x_scroll_run (w, run) /* If the dirty region is not what we expected, redraw the entire frame. */ if (!EqualRgn (combined, expect_dirty)) SET_FRAME_GARBAGED (f); + + DeleteObject (dirty); + DeleteObject (combined); } UNBLOCK_INPUT; + DeleteObject (expect_dirty); } From 2a95505b3e67a4080a93b3371eee6d5dfbc89048 Mon Sep 17 00:00:00 2001 From: Miles Bader Date: Mon, 1 Nov 2004 10:41:03 +0000 Subject: [PATCH 037/146] Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-658 Merge from gnus--rel--5.10 Patches applied: * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-64 Update from CVS 2004-10-29 Katsumi Yamaoka * lisp/gnus/gnus-msg.el (gnus-configure-posting-styles): Work with empty signature file. Suggested by Manoj Srivastava . --- lisp/gnus/ChangeLog | 4 ++++ lisp/gnus/gnus-msg.el | 5 +++-- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 2c658a4c562..0484057a4fb 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,5 +1,9 @@ 2004-10-29 Katsumi Yamaoka + * gnus-msg.el (gnus-configure-posting-styles): Work with empty + signature file. Suggested by Manoj Srivastava + . + * mm-util.el (mm-coding-system-priorities): Prefer iso-8859-1 than iso-2022-jp even in the Japanese language environment. Suggested by Jason Rumney . diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index 7dcef4b813b..886aa80368f 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -1871,8 +1871,9 @@ this is a reply." (setq v (with-temp-buffer (insert-file-contents v) (goto-char (point-max)) - (while (bolp) - (delete-char -1)) + (skip-chars-backward "\n") + (delete-region (+ (point) (if (bolp) 0 1)) + (point-max)) (buffer-string)))) (setq results (delq (assoc element results) results)) (push (cons element v) results)))) From f6749d5d75ab07f8e63781ee396c1a89d8bd4305 Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Mon, 1 Nov 2004 11:03:51 +0000 Subject: [PATCH 038/146] *** empty log message *** --- src/ChangeLog | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/ChangeLog b/src/ChangeLog index 3e3a60158a9..354746d242a 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,12 @@ +2004-11-01 Kim F. Storm + + * process.c (connect_wait_mask, num_pending_connects): Only + declare and use them if NON_BLOCKING_CONNECT is defined. + (IF_NON_BLOCKING_CONNECT): New helper macro. + (wait_reading_process_output): Only declare and use local vars + Connecting and check_connect when NON_BLOCKING_CONNECT is defined. + (init_process): Initialize them if NON_BLOCKING_CONNECT defined. + 2004-11-01 Andy Petrusenco (tiny change) * w32term.c (x_scroll_run): Delete region objects after use. @@ -7,7 +16,7 @@ * xmenu.c: Add prototypes for forward function declarations. (popup_get_selection): Remove parameter do_timers, remove call to timer_check. - (create_and_show_popup_menu, create_and_show_dialog): Remove + (create_and_show_popup_menu, create_and_show_dialog): Remove parameter do_timers from call to popup_get_selection. * xdisp.c (update_tool_bar): Pass a copy of f->tool_bar_items to From bad49fc7c2a55bd614979cf0e9c59b396ac2beb7 Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Mon, 1 Nov 2004 11:04:37 +0000 Subject: [PATCH 039/146] (connect_wait_mask, num_pending_connects): Only declare and use them if NON_BLOCKING_CONNECT is defined. (IF_NON_BLOCKING_CONNECT): New helper macro. (wait_reading_process_output): Only declare and use local vars Connecting and check_connect when NON_BLOCKING_CONNECT is defined. (init_process): Initialize them if NON_BLOCKING_CONNECT defined. --- src/ChangeLog | 2 +- src/process.c | 48 +++++++++++++++++++++++++++++++++++++++++------- 2 files changed, 42 insertions(+), 8 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 354746d242a..527b16382da 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -2,10 +2,10 @@ * process.c (connect_wait_mask, num_pending_connects): Only declare and use them if NON_BLOCKING_CONNECT is defined. + (init_process): Initialize them if NON_BLOCKING_CONNECT defined. (IF_NON_BLOCKING_CONNECT): New helper macro. (wait_reading_process_output): Only declare and use local vars Connecting and check_connect when NON_BLOCKING_CONNECT is defined. - (init_process): Initialize them if NON_BLOCKING_CONNECT defined. 2004-11-01 Andy Petrusenco (tiny change) diff --git a/src/process.c b/src/process.c index b63c730b480..bebcd577e9e 100644 --- a/src/process.c +++ b/src/process.c @@ -310,6 +310,7 @@ static SELECT_TYPE non_keyboard_wait_mask; static SELECT_TYPE non_process_wait_mask; +#ifdef NON_BLOCKING_CONNECT /* Mask of bits indicating the descriptors that we wait for connect to complete on. Once they complete, they are removed from this mask and added to the input_wait_mask and non_keyboard_wait_mask. */ @@ -319,6 +320,11 @@ static SELECT_TYPE connect_wait_mask; /* Number of bits set in connect_wait_mask. */ static int num_pending_connects; +#define IF_NON_BLOCKING_CONNECT(s) s +#else +#define IF_NON_BLOCKING_CONNECT(s) +#endif + /* The largest descriptor currently in use for a process object. */ static int max_process_desc; @@ -3672,12 +3678,14 @@ deactivate_process (proc) chan_process[inchannel] = Qnil; FD_CLR (inchannel, &input_wait_mask); FD_CLR (inchannel, &non_keyboard_wait_mask); +#ifdef NON_BLOCKING_CONNECT if (FD_ISSET (inchannel, &connect_wait_mask)) { FD_CLR (inchannel, &connect_wait_mask); if (--num_pending_connects < 0) abort (); } +#endif if (inchannel == max_process_desc) { int i; @@ -4038,8 +4046,11 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display, { register int channel, nfds; SELECT_TYPE Available; +#ifdef NON_BLOCKING_CONNECT SELECT_TYPE Connecting; - int check_connect, check_delay, no_avail; + int check_connect; +#endif + int check_delay, no_avail; int xerrno; Lisp_Object proc; EMACS_TIME timeout, end_time; @@ -4050,7 +4061,9 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display, int saved_waiting_for_user_input_p = waiting_for_user_input_p; FD_ZERO (&Available); +#ifdef NON_BLOCKING_CONNECT FD_ZERO (&Connecting); +#endif /* If wait_proc is a process to watch, set wait_channel accordingly. */ if (wait_proc != NULL) @@ -4187,7 +4200,10 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display, timeout to get our attention. */ if (update_tick != process_tick && do_display) { - SELECT_TYPE Atemp, Ctemp; + SELECT_TYPE Atemp; +#ifdef NON_BLOCKING_CONNECT + SELECT_TYPE Ctemp; +#endif Atemp = input_wait_mask; #if 0 @@ -4199,11 +4215,16 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display, */ FD_CLR (0, &Atemp); #endif - Ctemp = connect_wait_mask; + IF_NON_BLOCKING_CONNECT (Ctemp = connect_wait_mask); + EMACS_SET_SECS_USECS (timeout, 0, 0); if ((select (max (max_process_desc, max_keyboard_desc) + 1, &Atemp, +#ifdef NON_BLOCKING_CONNECT (num_pending_connects > 0 ? &Ctemp : (SELECT_TYPE *)0), +#else + (SELECT_TYPE *)0, +#endif (SELECT_TYPE *)0, &timeout) <= 0)) { @@ -4263,12 +4284,14 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display, if (XINT (wait_proc->infd) < 0) /* Terminated */ break; FD_SET (XINT (wait_proc->infd), &Available); - check_connect = check_delay = 0; + check_delay = 0; + IF_NON_BLOCKING_CONNECT (check_connect = 0); } else if (!NILP (wait_for_cell)) { Available = non_process_wait_mask; - check_connect = check_delay = 0; + check_delay = 0; + IF_NON_BLOCKING_CONNECT (check_connect = 0); } else { @@ -4276,7 +4299,7 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display, Available = non_keyboard_wait_mask; else Available = input_wait_mask; - check_connect = (num_pending_connects > 0); + IF_NON_BLOCKING_CONNECT (check_connect = (num_pending_connects > 0)); check_delay = wait_channel >= 0 ? 0 : process_output_delay_count; } @@ -4301,8 +4324,10 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display, } else { +#ifdef NON_BLOCKING_CONNECT if (check_connect) Connecting = connect_wait_mask; +#endif #ifdef ADAPTIVE_READ_BUFFERING if (process_output_skip && check_delay > 0) @@ -4333,7 +4358,11 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display, nfds = select (max (max_process_desc, max_keyboard_desc) + 1, &Available, +#ifdef NON_BLOCKING_CONNECT (check_connect ? &Connecting : (SELECT_TYPE *)0), +#else + (SELECT_TYPE *)0, +#endif (SELECT_TYPE *)0, &timeout); } @@ -4389,7 +4418,7 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display, if (no_avail) { FD_ZERO (&Available); - check_connect = 0; + IF_NON_BLOCKING_CONNECT (check_connect = 0); } #if defined(sun) && !defined(USG5_4) @@ -6628,6 +6657,11 @@ init_process () FD_ZERO (&non_process_wait_mask); max_process_desc = 0; +#ifdef NON_BLOCKING_CONNECT + FD_ZERO (&connect_wait_mask); + num_pending_connects = 0; +#endif + #ifdef ADAPTIVE_READ_BUFFERING process_output_delay_count = 0; process_output_skip = 0; From 03a693b48abb72239e081a1a583e1e21aa07638f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Mon, 1 Nov 2004 12:20:45 +0000 Subject: [PATCH 040/146] * xlwmenu.c (find_first_selectable, find_next_selectable) (find_prev_selectable): Rename parameter skip_no_call_data to skip_titles. Recognize titles as having no call_data and no contents. (Down, Up): Comment update. --- lwlib/ChangeLog | 7 +++++++ lwlib/xlwmenu.c | 25 ++++++++++++------------- 2 files changed, 19 insertions(+), 13 deletions(-) diff --git a/lwlib/ChangeLog b/lwlib/ChangeLog index 923f52debdd..eb2dd13432a 100644 --- a/lwlib/ChangeLog +++ b/lwlib/ChangeLog @@ -1,3 +1,10 @@ +2004-11-01 Jan Dj,Ad(Brv + + * xlwmenu.c (find_first_selectable, find_next_selectable) + (find_prev_selectable): Rename parameter skip_no_call_data to + skip_titles. Recognize titles as having no call_data and no contents. + (Down, Up): Comment update. + 2004-08-30 Jan Dj,Ad(Brv * lwlib.h (_widget_value): Added lname and lkey. diff --git a/lwlib/xlwmenu.c b/lwlib/xlwmenu.c index 973fc6ec5d5..d4eeeaa3eb4 100644 --- a/lwlib/xlwmenu.c +++ b/lwlib/xlwmenu.c @@ -2054,26 +2054,26 @@ Nothing (w, ev, params, num_params) } static widget_value * -find_first_selectable (mw, item, skip_no_call_data) +find_first_selectable (mw, item, skip_titles) XlwMenuWidget mw; widget_value *item; - int skip_no_call_data; + int skip_titles; { widget_value *current = item; enum menu_separator separator; while (lw_separator_p (current->name, &separator, 0) || !current->enabled - || (skip_no_call_data && !current->call_data)) + || (skip_titles && !current->call_data && !current->contents)) if (current->next) current=current->next; else - return NULL; + return NULL; return current; } static widget_value * -find_next_selectable (mw, item, skip_no_call_data) +find_next_selectable (mw, item, skip_titles) XlwMenuWidget mw; widget_value *item; { @@ -2082,7 +2082,7 @@ find_next_selectable (mw, item, skip_no_call_data) while (current->next && (current=current->next) && (lw_separator_p (current->name, &separator, 0) || !current->enabled - || (skip_no_call_data && !current->call_data))) + || (skip_titles && !current->call_data && !current->contents))) ; if (current == item) @@ -2093,7 +2093,8 @@ find_next_selectable (mw, item, skip_no_call_data) while (lw_separator_p (current->name, &separator, 0) || !current->enabled - || (skip_no_call_data && !current->call_data)) + || (skip_titles && !current->call_data + && !current->contents)) { if (current->next) current=current->next; @@ -2108,14 +2109,14 @@ find_next_selectable (mw, item, skip_no_call_data) } static widget_value * -find_prev_selectable (mw, item, skip_no_call_data) +find_prev_selectable (mw, item, skip_titles) XlwMenuWidget mw; widget_value *item; { widget_value *current = item; widget_value *prev = item; - while ((current=find_next_selectable (mw, current, skip_no_call_data)) + while ((current=find_next_selectable (mw, current, skip_titles)) != item) { if (prev == current) @@ -2141,8 +2142,7 @@ Down (w, ev, params, num_params) if (mw->menu.old_depth == mw->menu.top_depth) /* When in the menu-bar is pressed, display the corresponding sub-menu and select the first selectable menu item there. - If this is a popup menu, skip items with zero call data (title of - the popup). */ + If this is a popup menu, skip title item of the popup. */ set_new_state (mw, find_first_selectable (mw, selected_item->contents, @@ -2174,8 +2174,7 @@ Up (w, ev, params, num_params) last selectable item in the list. So we select the first selectable one and find the previous selectable item. Is there a better way? */ - /* If this is a popup menu, skip items with zero call data (title of - the popup). */ + /* If this is a popup menu, skip title item of the popup. */ set_new_state (mw, find_first_selectable (mw, selected_item->contents, From a4cabe41c25d17c79d25191fe64f28a0e209caf6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Mon, 1 Nov 2004 13:50:49 +0000 Subject: [PATCH 041/146] (mouse-yank-at-click, mouse-yank-secondary): Revert change from 2004-10-16. '*' checks the current buffer, but the mouse click may be in another buffer. --- lisp/mouse.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/mouse.el b/lisp/mouse.el index 8f05324d84d..2a467aa8069 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -1112,7 +1112,7 @@ and set mark at the beginning. Prefix arguments are interpreted as with \\[yank]. If `mouse-yank-at-point' is non-nil, insert at point regardless of where you click." - (interactive "*e\nP") + (interactive "e\nP") ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) (or mouse-yank-at-point (mouse-set-point click)) @@ -1414,7 +1414,7 @@ The function returns a non-nil value if it creates a secondary selection." Move point to the end of the inserted text. If `mouse-yank-at-point' is non-nil, insert at point regardless of where you click." - (interactive "*e") + (interactive "e") ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) (or mouse-yank-at-point (mouse-set-point click)) From df0a91e2d19a615ff7c76053a4b154e5aa6f566b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Mon, 1 Nov 2004 13:50:50 +0000 Subject: [PATCH 042/146] * mouse.el (mouse-yank-at-click, mouse-yank-secondary): Revert change from 2004-10-16. '*' checks the current buffer, but the mouse click may be in another buffer. --- lisp/ChangeLog | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 64ac6903651..6baac6a8f7b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2004-11-01 Jan Dj,Ad(Brv + + * mouse.el (mouse-yank-at-click, mouse-yank-secondary): Revert + change from 2004-10-16. '*' checks the current buffer, but the + mouse click may be in another buffer. + 2004-11-01 John Paul Wallington * files.el (large-file-warning-threshold): Add :version keyword. From e84fe274bc90b41b0573fee94b2ed8b97a0031f4 Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Mon, 1 Nov 2004 14:06:54 +0000 Subject: [PATCH 043/146] Add redisplay related errors. --- admin/FOR-RELEASE | 224 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 224 insertions(+) diff --git a/admin/FOR-RELEASE b/admin/FOR-RELEASE index 864f0285ab2..b16d2a27e44 100644 --- a/admin/FOR-RELEASE +++ b/admin/FOR-RELEASE @@ -8,6 +8,8 @@ Tasks needed before the next release. ** Face remapping. +** Let mouse-1 follow links. + * FATAL ERRORS @@ -18,10 +20,17 @@ redisplay uses an invalidated face_id with FACE_FROM_ID which then returns a NULL pointer. Said to happen with isearch faces. +** Investigate reported crashes in compact_small_strings. + +** Investigate reported crashes related to using an +invalid pointer from string_free_list. + + * LOSSAGE ** Clean up flymake.el to follow Emacs Lisp conventions. + * GTK RELATED BUGS ** Make GTK scrollbars behave like others w.r.t. overscrolling. @@ -30,6 +39,221 @@ isearch faces. so that the first can run Lisp code, while only the second needs BLOCK_INPUT. + +* REDISPLAY RELATED BUGS + +** Avoid unbreakable loops in redisplay. + +Redisplay may loop if there is an error in some display property, e.g. + (space 'left-margin) + +A fix would be to somehow disable handling of display properties if an error +is encountered. + +** Problem with cursor border around images and window-margins: + +The border around the image when the cursor is on the image +flows into the right fringe and margin. + + (progn + (auto-image-file-mode 1) + (find-file (concat data-directory "splash.xpm")) + (set-window-margins (selected-window) 25 25)) + + +** Problem with modeline and window margins: + +The mode line's right "box" line is misplaced under the right margin, +rather than at the right window edge. + +emacs -Q +(set-window-margins nil 25 25) +C-x 2 + + +** custom mode-line face makes Emacs freeze up + +From: Stephen Berman +Date: Sun, 24 Oct 2004 02:08:56 +0200 + +1. Start Emacs with -q -no-site-file. + +2. Type `M-x customize-face' and at the prompt `mode-line'. + +3. In the Custom buffer for mode-line face + a. check width and give it the value `narrow'; + b. check height and give it the value 120 in 1/10 pt; + c. check underline and give it the value `on' (or `colored'); + d. check overline and give it the value `on' (or `colored'). + +4. Set for current session. + +5. Invoke Ediff on any two files. + +6. Now Emacs is frozen and consumes 95-99% of CPU. + +The customizations in step 3 appear to be the minimum necessary to +induce this bug. Leave out any one of them and Ediff runs without a +problem. Also if the 1/10 point value of height is 130 or greater +there's no bug (with the default font family; with e.g. Helvetica the +bug is induced only by a value of 100 or less). + +I've noticed this freeze up only when invoking Ediff. The only thing +I've been able to do is kill Emacs externally, via top or with kill +when run in gdb, after interrupting. When the freeze up happens +within a gdb session, there is no automatic debugging feedback. After +interrupting I can get a backtrace, here's an example: + + +** Mouse-face overlay bleeds into header line + +From: Stephen Berman +Date: Thu, 21 Oct 2004 18:11:01 +0200 + +Mouse-face overlays bleed into the header line when the beginning of +the overlay is above (point-min). To reproduce: + +1. Start Emacs with -q -no-site-file. + +2. In *scratch* eval (setq ov (make-overlay 66 92)), (overlay-put ov +'mouse-face 'highlight), and (setq header-line-format "test"). + +3. Drag the mouse over the string "evaluation.\n;; If you want" and +notice the highlighting of only this string. + +4. Now click on the down arrow in the scroll bar until the line +beginning ";; If you want" is directly below the header line. + +5. Drag the mouse over ";; If you want" and notice that not only it +but also the header line are highlighted. + + +** scroll-preserve-screen-position doesn't work with a header-line-format + +From: jbyler+emacs-lists@anon41.eml.cc +Date: Tue, 17 Aug 2004 17:10:14 -0400 + +There seems to be an off-by-one error triggered by using a header line +together with scroll-preserve-screen-position. The symptom: instead of +staying in the same position on the screen when scrolling, the cursor +moves one screen line down each time the buffer is scrolled. Put +another way: repeatedly typing C-v M-v or using a mouse scroll wheel to +scroll up and down causes the cursor to migrate slowly down the screen +instead of staying put as it should. + +To reproduce: + +emacs -q --no-site-file +(setq scroll-preserve-screen-position t) +(setq header-line-format "") +C-v M-v C-v M-v C-v M-v etc. + + +** Clicking on partially visible lines fails + +From: David Kastrup +Date: 27 Apr 2004 16:42:58 +0200 + +This bug report will be sent to the Free Software Foundation, +not to your local site managers! +Please write in English if possible, because the Emacs maintainers +usually do not have translators to read other languages for them. + +Your bug report will be posted to the emacs-pretest-bug@gnu.org mailing list. + +Please describe exactly what actions triggered the bug +and the precise symptoms of the bug: + +I had gnus display a mouse-highlighted line (a URL from browse-url) +partially at the bottom of its window. If I click with middle mouse +key on it, the window gets recentered while I hold the mouse key +pressed. If I release it, the window returns into its old position +(cursor in top row) and nothing happens, presumably because the click +was not registered on the line itself, but on the magically +recentered version. + +That is a nuisance. Recentering of even partially visible click +targets should only happen if window-point moves there, but not at +the time of the click. From the moment I hold down a key until it +gets released, the displayed window portion should not change, with +the sole exception of scrolling when dragging at the edge of the +screen. + + +** Can't drag modeline when mouse-autoselect-window is set + +From: Klaus Zeitler +Date: Mon, 11 Oct 2004 11:14:49 +0200 + +1. start emacs -q --no-site-file +2. set variable mouse-autoselect-window to t +3. split-window-vertically + +now I can drag the modeline only upwards but not downwards + + +** line-spacing and (recenter -1) + +From: SAITO Takuya +Date: Mon, 31 May 2004 02:07:57 +0900 (JST) + +(recenter -1) does not show point at the bottom of the window +if line-spacing is set to positive integer. + +Start emacs -Q, and evaluate below: + +(progn + (setq line-spacing 1) + (dotimes (i (window-height)) + (insert "\n" (int-to-string i))) + (recenter -1)) + +Then, point is displayed at the center of the window. +But point should be displayed at the bottom of the window like Emacs-21.3. + + +** line-spacing and garbage in fringe + +From: SAITO Takuya +Date: Mon, 31 May 2004 02:08:05 +0900 (JST) + +Start emacs -Q and evaluate below with C-xC-e: + +(let ((lines 2) + (spacing 1)) + (setq line-spacing spacing + indicate-buffer-boundaries t) + (insert (make-string (window-height) ?\n)) + (goto-char (point-min)) + (message (make-string (* (window-width) lines) ?.)) + (scroll-up 1)) + +then, garbage is displayed in right fringe. + +Above code reproduces this bug with +(frame-parameter nil 'font) +=> "-Adobe-Courier-Medium-R-Normal--12-120-75-75-M-70-ISO8859-1" + +If you use different font, you may need different value of +`lines' and/or `spacing'. + + +** line-spacing and Electric-pop-up-window + +From: SAITO Takuya +Date: Mon, 31 May 2004 02:08:10 +0900 (JST) + +Electric-pop-up-window does not work well +if truncate long lines disabled and/or +`line-spacing' is set to positive integer. + +For example, start emacs -Q --line-spacing 1, and type M-` . +Then, the last line of *Completions* buffer is not visible. + +fit-window-to-buffer works well for me, so I guess +Electric-pop-up-window can use it. + + * DOCUMENTATION ** Finish updating the Emacs Lisp manual. From 11fd50f793989f6130b080ec285ba8dab376c5a6 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 1 Nov 2004 15:02:09 +0000 Subject: [PATCH 044/146] *** empty log message *** --- lisp/ChangeLog | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6baac6a8f7b..397c7d0052a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,7 +1,7 @@ 2004-11-01 Jan Dj,Ad(Brv - * mouse.el (mouse-yank-at-click, mouse-yank-secondary): Revert - change from 2004-10-16. '*' checks the current buffer, but the + * mouse.el (mouse-yank-at-click, mouse-yank-secondary): + Revert change from 2004-10-16. '*' checks the current buffer, but the mouse click may be in another buffer. 2004-11-01 John Paul Wallington @@ -18,7 +18,7 @@ * allout.el (allout group): Add :version. (allout-init): Don't use interactive-p. (allout-ascend-to-depth, allout-ascend, allout-end-of-level) - (allout-forward-current-level, allout-backward-current-level): + (allout-forward-current-level, allout-backward-current-level): Don't use interactive-p. * textmodes/bibtex.el (bibtex-make-field): Don't use interactive-p. @@ -33,7 +33,7 @@ * progmodes/idlw-shell.el (idlwave-shell-send-char): Don't use interactive-p. - * progmodes/cperl-mode.el (cperl-switch-to-doc-buffer): + * progmodes/cperl-mode.el (cperl-switch-to-doc-buffer): Don't use interactive-p. * progmodes/ada-xref.el (ada-make-body-gnatstub): @@ -53,6 +53,12 @@ * man.el (Man-xref-normal-file): Fix help-echo. +2004-10-31 Stefan Monnier + + * reveal.el (reveal-last-tick): New var. + (reveal-post-command): Use it to avoid closing overlays when we're + appending text to them. + 2004-10-31 Roland Winkler * textmodes/bibtex.el: Require button. @@ -133,7 +139,7 @@ function. (help-at-pt-display-when-idle): Remove autoload. -2004-10-30 Stefan +2004-10-30 Stefan Monnier * makefile.w32-in (custom-deps, autoloads): Fix *-hooks -> *-hook. @@ -162,7 +168,7 @@ * mouse.el (mouse-show-mark): Replace the last occurrence of x-lost-selection-hooks with x-lost-selection-functions. -2004-10-28 Stefan +2004-10-28 Stefan Monnier * mouse.el (mouse-show-mark): Adjust to new name and don't assume x-lost-selection-functions is bound. @@ -1270,7 +1276,7 @@ 2004-09-17 Jay Belanger - * calc/calc.el (calc-mode-var-list): Fixed the value of + * calc/calc.el (calc-mode-var-list): Fix the value of `calc-matrix-brackets'. 2004-09-17 Romain Francoise From 12e46b0083cea4d9ef6eaf4d68497aac5d62343e Mon Sep 17 00:00:00 2001 From: Masatake YAMATO Date: Mon, 1 Nov 2004 17:42:31 +0000 Subject: [PATCH 045/146] 2004-11-2 Pavel Kobiakov * progmodes/flymake.el (flymake-err-line-patterns): Use `flymake-reformat-err-line-patterns-from-compile-el' to convert `compilation-error-regexp-alist-alist' to internal Flymake format. * progmodes/flymake.el: eliminated byte-compiler warnings. --- lisp/ChangeLog | 8 +++++++ lisp/progmodes/flymake.el | 49 ++++++++++++++++++++++++++++++--------- 2 files changed, 46 insertions(+), 11 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 397c7d0052a..c18c0986bd3 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,11 @@ +2004-11-2 Pavel Kobiakov + + * progmodes/flymake.el (flymake-err-line-patterns): Use + `flymake-reformat-err-line-patterns-from-compile-el' to convert + `compilation-error-regexp-alist-alist' to internal Flymake format. + + * progmodes/flymake.el: eliminated byte-compiler warnings. + 2004-11-01 Jan Dj,Ad(Brv * mouse.el (mouse-yank-at-click, mouse-yank-secondary): diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 3ccea967bc5..737071203e0 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -56,7 +56,7 @@ (defun flymake-makehash(&optional test) (cond ((equal flymake-emacs 'xemacs) (if test (make-hash-table :test test) (make-hash-table))) - (t (makehash test)) + (t (makehash test)) ) ) @@ -370,8 +370,8 @@ (let* ((init-f (nth 0 (flymake-get-file-name-mode-and-masks file-name)))) ;(flymake-log 0 "calling %s" init-f) ;(funcall init-f (current-buffer)) + init-f ) - (nth 0 (flymake-get-file-name-mode-and-masks file-name)) ) (defun flymake-get-cleanup-function(file-name) @@ -846,7 +846,7 @@ Whenether a buffer for master-file-name exists, use it as a source instead of re (set-buffer source-buffer) (flymake-parse-residual source-buffer) - (flymake-post-syntax-check source-buffer) + (flymake-post-syntax-check source-buffer exit-status command) (flymake-set-buffer-is-running source-buffer nil) ) ) @@ -863,7 +863,7 @@ Whenether a buffer for master-file-name exists, use it as a source instead of re ) ) -(defun flymake-post-syntax-check(source-buffer) +(defun flymake-post-syntax-check(source-buffer exit-status command) "" (flymake-set-buffer-err-info source-buffer (flymake-get-buffer-new-err-info source-buffer)) (flymake-set-buffer-new-err-info source-buffer nil) @@ -1220,7 +1220,33 @@ Whenether a buffer for master-file-name exists, use it as a source instead of re ) ) -(eval-when-compile (require 'compile)) +(defun flymake-reformat-err-line-patterns-from-compile-el(original-list) + "grab error line patterns from original list in compile.el format, convert to flymake internal format" + (let* ((converted-list '())) + (mapcar + (lambda (item) + (setq item (cdr item)) + (let ((regexp (nth 0 item)) + (file (nth 1 item)) + (line (nth 2 item)) + (col (nth 3 item)) + end-line) + (if (consp file) (setq file (car file))) + (if (consp line) (setq end-line (cdr line) line (car line))) + (if (consp col) (setq col (car col))) + + (when (not (functionp line)) + (setq converted-list (cons (list regexp file line col) converted-list)) + ) + ) + ) + original-list + ) + converted-list + ) +) + +(require 'compile) (defvar flymake-err-line-patterns ; regexp file-idx line-idx col-idx (optional) text-idx(optional), match-end to end of string is error text (append '( @@ -1243,9 +1269,9 @@ Whenether a buffer for master-file-name exists, use it as a source instead of re (" *\\(\\[javac\\]\\)? *\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)\:\\([0-9]+\\)\:[ \t\n]*\\(.+\\)" 2 4 nil 5) ) - ;; compilation-error-regexp-alist) - (mapcar (lambda (x) (cdr x)) compilation-error-regexp-alist-alist)) - "patterns for matching error/warning lines, (regexp file-idx line-idx err-text-idx)" + ;; compilation-error-regexp-alist) + (flymake-reformat-err-line-patterns-from-compile-el compilation-error-regexp-alist-alist)) + "patterns for matching error/warning lines, (regexp file-idx line-idx err-text-idx). Use flymake-reformat-err-line-patterns-from-compile-el to add patterns from compile.el" ) ;(defcustom flymake-err-line-patterns ; '( @@ -1452,7 +1478,7 @@ Whenether a buffer for master-file-name exists, use it as a source instead of re (let* ((dir (nth idx include-dirs))) (setq full-file-name (concat dir "/" rel-file-name)) (when (file-exists-p full-file-name) - (setq done t) + (setq found t) ) ) (setq idx (1+ idx)) @@ -1574,7 +1600,7 @@ Whenether a buffer for master-file-name exists, use it as a source instead of re process ) (error - (let ((err-str (format "Failed to launch syntax check process '%s' with args %s: %s" + (let* ((err-str (format "Failed to launch syntax check process '%s' with args %s: %s" cmd args (error-message-string err))) (source-file-name (buffer-file-name buffer)) (cleanup-f (flymake-get-cleanup-function source-file-name))) @@ -1905,7 +1931,8 @@ Whenether a buffer for master-file-name exists, use it as a source instead of re (defun flymake-mode(&optional arg) "toggle flymake-mode" (interactive) - (let ((old-flymake-mode flymake-mode)) + (let ((old-flymake-mode flymake-mode) + (turn-on nil)) (setq turn-on (if (null arg) From 97d83988746b8220f5d42929bc198d1a4fec6361 Mon Sep 17 00:00:00 2001 From: Jay Belanger Date: Mon, 1 Nov 2004 20:08:56 +0000 Subject: [PATCH 046/146] (calc-over-notation): Replaced `completing-read' with `interactive "s"'. --- lisp/ChangeLog | 5 +++++ lisp/calc/calc-frac.el | 7 +------ 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c18c0986bd3..cc60a86f895 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2004-11-01 Jay Belanger + + * calc/calc-frac.el (calc-over-notation): Replaced + `completing-read' with `interactive "s"'. + 2004-11-2 Pavel Kobiakov * progmodes/flymake.el (flymake-err-line-patterns): Use diff --git a/lisp/calc/calc-frac.el b/lisp/calc/calc-frac.el index 3aa3bbdae41..48201a7dc8a 100644 --- a/lisp/calc/calc-frac.el +++ b/lisp/calc/calc-frac.el @@ -54,12 +54,7 @@ (defun calc-over-notation (fmt) - (interactive - (list - (completing-read "Fraction separator: " (mapcar (lambda (s) - (cons s 0)) - '(":" "::" "/" "//" ":/")) - nil t))) + (interactive "sFraction separator: ") (calc-wrapper (if (string-match "\\`\\([^ 0-9][^ 0-9]?\\)[0-9]*\\'" fmt) (let ((n nil)) From f73f97084bbd1f3ef0f418e11be60e27d2794282 Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Mon, 1 Nov 2004 20:46:16 +0000 Subject: [PATCH 047/146] *** empty log message *** --- lisp/ChangeLog | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index cc60a86f895..c7f3977f562 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,10 @@ +2004-11-02 Nick Roberts + + * progmodes/gdb-ui.el (gdb-enable-debug-log) + (gdb-use-inferior-io-buffer, gdb-use-colon-colon-notation) + (gud-gdba-command-name, gdb-show-main, gdb-many-windows): + Add :version keyword. + 2004-11-01 Jay Belanger * calc/calc-frac.el (calc-over-notation): Replaced From 27b3b9d302243fd2b623347220321ab43def79a0 Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Mon, 1 Nov 2004 20:47:03 +0000 Subject: [PATCH 048/146] (gdb-enable-debug-log) (gdb-use-inferior-io-buffer, gdb-use-colon-colon-notation) (gud-gdba-command-name, gdb-show-main, gdb-many-windows): Add :version keyword. --- lisp/progmodes/gdb-ui.el | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el index 1486ec7e5cf..90c0a50c7dc 100644 --- a/lisp/progmodes/gdb-ui.el +++ b/lisp/progmodes/gdb-ui.el @@ -133,12 +133,14 @@ detailed description of this mode. (defcustom gdb-enable-debug-log nil "Non-nil means record the process input and output in `gdb-debug-log'." :type 'boolean - :group 'gud) + :group 'gud + :version "21.4") (defcustom gdb-use-inferior-io-buffer nil "Non-nil means display output from the inferior in a separate buffer." :type 'boolean - :group 'gud) + :group 'gud + :version "21.4") (defun gdb-ann3 () (setq gdb-debug-log nil) @@ -211,7 +213,8 @@ detailed description of this mode. (defcustom gdb-use-colon-colon-notation nil "If non-nil use FUN::VAR format to display variables in the speedbar." ; :type 'boolean - :group 'gud) + :group 'gud + :version "21.4") (defun gud-watch () "Watch expression at point." @@ -658,7 +661,8 @@ This filter may simply queue input for a later time." (defcustom gud-gdba-command-name "gdb -annotate=3" "Default command to execute an executable under the GDB-UI debugger." :type 'string - :group 'gud) + :group 'gud + :version "21.4") (defvar gdb-annotation-rules '(("pre-prompt" gdb-pre-prompt) @@ -1685,7 +1689,8 @@ static char *magick[] = { (defcustom gdb-show-main nil "Nil means don't display source file containing the main routine." :type 'boolean - :group 'gud) + :group 'gud + :version "21.4") (defun gdb-setup-windows () "Layout the window pattern for gdb-many-windows." @@ -1726,7 +1731,8 @@ buffer and the other with the source file with the main routine of the inferior. Non-nil means display the layout shown for `gdba'." :type 'boolean - :group 'gud) + :group 'gud + :version "21.4") (defun gdb-many-windows (arg) "Toggle the number of windows in the basic arrangement." From 23ed65c0e341d36a095dedd666b927d32ea89888 Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Mon, 1 Nov 2004 23:02:26 +0000 Subject: [PATCH 049/146] *** empty log message *** --- lisp/ChangeLog | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c7f3977f562..6b030c02c7c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2004-11-02 Kim F. Storm + + * kmacro.el (group kmacro): Add :version. + (kmacro-keyboard-quit): New function to cleanup on C-g. + (kmacro-start-macro): Set defining-kbd-macro to append when + appending to last macro. + + * simple.el (keyboard-quit): Call kmacro-keyboard-quit. + 2004-11-02 Nick Roberts * progmodes/gdb-ui.el (gdb-enable-debug-log) @@ -5,19 +14,19 @@ (gud-gdba-command-name, gdb-show-main, gdb-many-windows): Add :version keyword. +2004-11-02 Pavel Kobiakov + + * progmodes/flymake.el (flymake-err-line-patterns): Use + `flymake-reformat-err-line-patterns-from-compile-el' to convert + `compilation-error-regexp-alist-alist' to internal Flymake format. + + * progmodes/flymake.el: eliminated byte-compiler warnings. + 2004-11-01 Jay Belanger * calc/calc-frac.el (calc-over-notation): Replaced `completing-read' with `interactive "s"'. -2004-11-2 Pavel Kobiakov - - * progmodes/flymake.el (flymake-err-line-patterns): Use - `flymake-reformat-err-line-patterns-from-compile-el' to convert - `compilation-error-regexp-alist-alist' to internal Flymake format. - - * progmodes/flymake.el: eliminated byte-compiler warnings. - 2004-11-01 Jan Dj,Ad(Brv * mouse.el (mouse-yank-at-click, mouse-yank-secondary): From 8a7644e9fd9ee9006ae2ea9142a11072ebb53808 Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Mon, 1 Nov 2004 23:03:12 +0000 Subject: [PATCH 050/146] (keyboard-quit): Call kmacro-keyboard-quit. --- lisp/simple.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/simple.el b/lisp/simple.el index 2665e4c7639..864340e25d4 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1,7 +1,7 @@ ;;; simple.el --- basic editing commands for Emacs ;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99, -;; 2000, 01, 02, 03, 04 +;; 2000, 01, 02, 03, 2004 ;; Free Software Foundation, Inc. ;; Maintainer: FSF @@ -3916,6 +3916,8 @@ During execution of Lisp code, this character causes a quit directly. At top-level, as an editor command, this simply beeps." (interactive) (deactivate-mark) + (if (fboundp 'kmacro-keyboard-quit) + (kmacro-keyboard-quit)) (setq defining-kbd-macro nil) (signal 'quit nil)) From 1b25dccd6ef4ffd0d82daf82143d2107cc5099e1 Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Mon, 1 Nov 2004 23:06:32 +0000 Subject: [PATCH 051/146] (group kmacro): Add :version. (kmacro-keyboard-quit): New function to cleanup on C-g. (kmacro-start-macro): Set defining-kbd-macro to append when appending to last macro. --- lisp/ChangeLog | 3 +++ lisp/kmacro.el | 15 +++++++++++++-- 2 files changed, 16 insertions(+), 2 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6b030c02c7c..82aec89b14b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,8 @@ 2004-11-02 Kim F. Storm + * descr-text.el (describe-text-properties): Don't err if called in + the *Help* buffer; output to *Help-2* buffer instead. + * kmacro.el (group kmacro): Add :version. (kmacro-keyboard-quit): New function to cleanup on C-g. (kmacro-start-macro): Set defining-kbd-macro to append when diff --git a/lisp/kmacro.el b/lisp/kmacro.el index 2b4cbcaf323..9ee34a8432c 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -1,6 +1,6 @@ ;;; kmacro.el --- enhanced keyboard macros -;; Copyright (C) 2002 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. ;; Author: Kim F. Storm ;; Keywords: keyboard convenience @@ -120,6 +120,7 @@ "Simplified keyboard macro user interface." :group 'keyboard :group 'convenience + :version "21.4" :link '(emacs-commentary-link :tag "Commentary" "kmacro.el") :link '(emacs-library-link :tag "Lisp File" "kmacro.el")) @@ -222,6 +223,14 @@ macro to be executed before appending to it." (global-set-key (vector kmacro-call-mouse-event) 'kmacro-end-call-mouse)) +;;; Called from keyboard-quit + +(defun kmacro-keyboard-quit () + (or (not defining-kbd-macro) + (eq defining-kbd-macro 'append) + (kmacro-ring-empty-p) + (kmacro-pop-ring))) + ;;; Keyboard macro counter @@ -585,7 +594,9 @@ Use \\[kmacro-bind-to-key] to bind it to a key sequence." (and append (if kmacro-execute-before-append (> (car arg) 4) - (= (car arg) 4))))))) + (= (car arg) 4)))) + (if (and defining-kbd-macro append) + (setq defining-kbd-macro 'append))))) ;;;###autoload From e26422500cc9e78c73c3d2929f9fc226ad68c977 Mon Sep 17 00:00:00 2001 From: Miles Bader Date: Mon, 1 Nov 2004 23:06:36 +0000 Subject: [PATCH 052/146] Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-660 Merge from gnus--rel--5.10 Patches applied: * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-65 Update from CVS 2004-11-01 Reiner Steib * lisp/gnus/gnus-msg.el (gnus-summary-resend-default-address): Add :version. * lisp/gnus/tls.el (tls-process-connection-type, tls-success) (tls-certtool-program): Add :version. * lisp/gnus/starttls.el (starttls-gnutls-program, starttls-use-gnutls) (starttls-extra-arguments, starttls-process-connection-type) (starttls-connect, starttls-failure, starttls-success): * lisp/gnus/spam-stat.el (spam-stat): Add :version. * lisp/gnus/sieve.el (sieve): Add :version. * lisp/gnus/sha1.el (sha1): Added :version. (sha1-use-external): Removed redundant version. * lisp/gnus/nnmail.el (nnmail-split-fancy-with-parent-ignore-groups) (nnmail-cache-ignore-groups, nnmail-spool-hook) (nnmail-split-fancy-match-partial-words) (nnmail-split-lowercase-expanded): * lisp/gnus/nndiary.el (nndiary): Add :version. * lisp/gnus/mml2015.el (mml2015-unabbrev-trust-alist): Add :version. * lisp/gnus/mml-sec.el (mml-default-sign-method) (mml-default-encrypt-method, mml-signencrypt-style-alist): Add :version. * lisp/gnus/mm-uu.el (mm-uu-diff-groups-regexp): Add :version. * lisp/gnus/mm-url.el (mm-url-use-external, mm-url-program) (mm-url-arguments): Add :version. * lisp/gnus/mm-decode.el (mm-inline-text-html-with-w3m-keymap) (mm-attachment-file-modes, mm-decrypt-option) (mm-w3m-safe-url-regexp): Add :version. * lisp/gnus/message.el (message-cite-prefix-regexp) (message-sendmail-envelope-from, message-minibuffer-local-map) (message-user-fqdn, message-completion-alist): Add :version. * lisp/gnus/gnus-win.el (gnus-configure-windows-hook) (gnus-use-frames-on-any-display): Add :version. * lisp/gnus/gnus-art.el (gnus-article-address-banner-alist) (gnus-treat-unsplit-urls, gnus-treat-unfold-headers) (gnus-treat-from-picon, gnus-treat-mail-picon) (gnus-treat-x-pgp-sig): Add :version. * lisp/gnus/gnus-sum.el (gnus-spam-mark, gnus-recent-mark) (gnus-undownloaded-mark, gnus-summary-article-move-hook) (gnus-summary-article-delete-hook) (gnus-summary-display-while-building): Add :version. * lisp/gnus/gnus-start.el (gnus-subscribe-newsgroup-hooks) (gnus-get-top-new-news-hook):Add :version. * lisp/gnus/gnus-srvr.el (gnus-server-agent-face, gnus-server-opened-face) (gnus-server-closed-face, gnus-server-denied-face): Add :version. * lisp/gnus/gnus-registry.el (gnus-registry): Add :version. * lisp/gnus/gnus-spec.el (gnus-use-correct-string-widths) (gnus-make-format-preserve-properties): Add :version. * lisp/gnus/gnus.el (gnus-group-charter-alist) (gnus-group-fetch-control-use-browse-url) (gnus-install-group-spam-parameters): Add :version. * lisp/gnus/gnus-diary.el (gnus-diary): Add :version. * lisp/gnus/gnus-delay.el (gnus-delay): Add :version. * lisp/gnus/gnus-cite.el (gnus-cite-unsightly-citation-regexp) (gnus-cite-ignore-quoted-from, gnus-cite-attribution-face) (gnus-cite-blank-line-after-header, gnus-article-boring-faces): Add :version. * lisp/gnus/gnus-agent.el (gnus-agent-max-fetch-size) (gnus-agent-enable-expiration, gnus-agent-queue-mail) (gnus-agent-prompt-send-queue): Add :version. * lisp/gnus/deuglify.el (gnus-outlook-deuglify): Add :version. * lisp/gnus/html2text.el: Beautify code. Improve doc strings. Some checkdoc cleanup. (html2text-get-attr, html2text-fix-paragraph): Simplify code. (html2text-format-tag-list): Added "strong" and "em". From "Alfred M. Szmidt" (tiny change). --- lisp/gnus/ChangeLog | 93 +++++++++++++++ lisp/gnus/deuglify.el | 3 +- lisp/gnus/gnus-agent.el | 4 + lisp/gnus/gnus-art.el | 6 + lisp/gnus/gnus-cite.el | 5 +- lisp/gnus/gnus-delay.el | 1 + lisp/gnus/gnus-diary.el | 3 +- lisp/gnus/gnus-msg.el | 1 + lisp/gnus/gnus-registry.el | 1 + lisp/gnus/gnus-spec.el | 2 + lisp/gnus/gnus-srvr.el | 4 + lisp/gnus/gnus-start.el | 2 + lisp/gnus/gnus-sum.el | 7 ++ lisp/gnus/gnus-win.el | 2 + lisp/gnus/gnus.el | 3 + lisp/gnus/html2text.el | 237 +++++++++++++------------------------ lisp/gnus/message.el | 7 +- lisp/gnus/mm-decode.el | 4 + lisp/gnus/mm-url.el | 3 + lisp/gnus/mm-uu.el | 1 + lisp/gnus/mml-sec.el | 3 + lisp/gnus/mml2015.el | 1 + lisp/gnus/nndiary.el | 1 + lisp/gnus/nnmail.el | 5 + lisp/gnus/sha1.el | 2 +- lisp/gnus/sieve.el | 1 + lisp/gnus/spam-stat.el | 1 + lisp/gnus/starttls.el | 7 ++ lisp/net/tls.el | 3 + 29 files changed, 255 insertions(+), 158 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 0484057a4fb..df6fa771f87 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,96 @@ +2004-11-01 Reiner Steib + + * gnus-msg.el (gnus-summary-resend-default-address): Add :version. + + * tls.el (tls-process-connection-type, tls-success) + (tls-certtool-program): Add :version. + + * starttls.el (starttls-gnutls-program, starttls-use-gnutls) + (starttls-extra-arguments, starttls-process-connection-type) + (starttls-connect, starttls-failure, starttls-success): + + * spam-stat.el (spam-stat): Add :version. + + * sieve.el (sieve): Add :version. + + * sha1.el (sha1): Added :version. + (sha1-use-external): Removed redundant version. + + * nnmail.el (nnmail-split-fancy-with-parent-ignore-groups) + (nnmail-cache-ignore-groups, nnmail-spool-hook) + (nnmail-split-fancy-match-partial-words) + (nnmail-split-lowercase-expanded): + + * nndiary.el (nndiary): Add :version. + + * mml2015.el (mml2015-unabbrev-trust-alist): Add :version. + + * mml-sec.el (mml-default-sign-method) + (mml-default-encrypt-method, mml-signencrypt-style-alist): Add + :version. + + * mm-uu.el (mm-uu-diff-groups-regexp): Add :version. + + * mm-url.el (mm-url-use-external, mm-url-program) + (mm-url-arguments): Add :version. + + * mm-decode.el (mm-inline-text-html-with-w3m-keymap) + (mm-attachment-file-modes, mm-decrypt-option) + (mm-w3m-safe-url-regexp): Add :version. + + * message.el (message-cite-prefix-regexp) + (message-sendmail-envelope-from, message-minibuffer-local-map) + (message-user-fqdn, message-completion-alist): Add :version. + + * gnus-win.el (gnus-configure-windows-hook) + (gnus-use-frames-on-any-display): Add :version. + + * gnus-art.el (gnus-article-address-banner-alist) + (gnus-treat-unsplit-urls, gnus-treat-unfold-headers) + (gnus-treat-from-picon, gnus-treat-mail-picon) + (gnus-treat-x-pgp-sig): Add :version. + + * gnus-sum.el (gnus-spam-mark, gnus-recent-mark) + (gnus-undownloaded-mark, gnus-summary-article-move-hook) + (gnus-summary-article-delete-hook) + (gnus-summary-display-while-building): Add :version. + + * gnus-start.el (gnus-subscribe-newsgroup-hooks) + (gnus-get-top-new-news-hook):Add :version. + + * gnus-srvr.el (gnus-server-agent-face, gnus-server-opened-face) + (gnus-server-closed-face, gnus-server-denied-face): Add :version. + + * gnus-registry.el (gnus-registry): Add :version. + + * gnus-spec.el (gnus-use-correct-string-widths) + (gnus-make-format-preserve-properties): Add :version. + + * gnus.el (gnus-group-charter-alist) + (gnus-group-fetch-control-use-browse-url) + (gnus-install-group-spam-parameters): Add :version. + + * gnus-diary.el (gnus-diary): Add :version. + + * gnus-delay.el (gnus-delay): Add :version. + + * gnus-cite.el (gnus-cite-unsightly-citation-regexp) + (gnus-cite-ignore-quoted-from, gnus-cite-attribution-face) + (gnus-cite-blank-line-after-header, gnus-article-boring-faces): + Add :version. + + * gnus-agent.el (gnus-agent-max-fetch-size) + (gnus-agent-enable-expiration, gnus-agent-queue-mail) + (gnus-agent-prompt-send-queue): Add :version. + + * deuglify.el (gnus-outlook-deuglify): Add :version. + + * html2text.el: Beautify code. Improve doc strings. Some checkdoc + cleanup. + (html2text-get-attr, html2text-fix-paragraph): Simplify code. + (html2text-format-tag-list): Added "strong" and "em". From + "Alfred M. Szmidt" (tiny change). + 2004-10-29 Katsumi Yamaoka * gnus-msg.el (gnus-configure-posting-styles): Work with empty diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el index 07e630d793b..4fe1001a050 100644 --- a/lisp/gnus/deuglify.el +++ b/lisp/gnus/deuglify.el @@ -230,7 +230,8 @@ ;;; User Customizable Variables: (defgroup gnus-outlook-deuglify nil - "Deuglify articles generated by broken user agents like MS Outlook (Express).") + "Deuglify articles generated by broken user agents like MS Outlook (Express)." + :version "21.4") ;;;###autoload (defcustom gnus-outlook-deuglify-unwrap-min 45 diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index c62460946ab..23fcbbde5df 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -160,6 +160,7 @@ read articles as they would just be downloaded again." "Chunk size for `gnus-agent-fetch-session'. The function will split its article fetches into chunks smaller than this limit." + :version "21.4" :group 'gnus-agent :type 'integer) @@ -170,6 +171,7 @@ contents from a group's local storage. This value may be overridden to disable expiration in specific categories, topics, and groups. Of course, you could change gnus-agent-enable-expiration to DISABLE then enable expiration per categories, topics, and groups." + :version "21.4" :group 'gnus-agent :type '(radio (const :format "Enable " ENABLE) (const :format "Disable " DISABLE))) @@ -195,6 +197,7 @@ See Info node `(gnus)Server Buffer'." "Whether and when outgoing mail should be queued by the agent. When `always', always queue outgoing mail. When nil, never queue. Otherwise, queue if and only if unplugged." + :version "21.4" :group 'gnus-agent :type '(radio (const :format "Always" always) (const :format "Never" nil) @@ -203,6 +206,7 @@ queue. Otherwise, queue if and only if unplugged." (defcustom gnus-agent-prompt-send-queue nil "If non-nil, `gnus-group-send-queue' will prompt if called when unplugged." + :version "21.4" :group 'gnus-agent :type 'boolean) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 7a365d81a2c..d12186ca370 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -318,6 +318,7 @@ advertisements. For example: (symbol :tag "Item in `gnus-article-banner-alist'" none) regexp (const :tag "None" nil)))) + :version "21.4" :group 'gnus-article-washing) (defcustom gnus-emphasis-alist @@ -920,6 +921,7 @@ See Info node `(gnus)Customizing Articles' for details." "Remove newlines from within URLs. Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' for details." + :version "21.4" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) @@ -1124,6 +1126,7 @@ See Info node `(gnus)Customizing Articles' for details." "Unfold folded header lines. Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' for details." + :version "21.4" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) @@ -1238,6 +1241,7 @@ See Info node `(gnus)Customizing Articles' and Info node Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' and Info node `(gnus)Picons' for details." + :version "21.4" :group 'gnus-article-treat :group 'gnus-picon :link '(custom-manual "(gnus)Customizing Articles") @@ -1253,6 +1257,7 @@ See Info node `(gnus)Customizing Articles' and Info node Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' and Info node `(gnus)Picons' for details." + :version "21.4" :group 'gnus-article-treat :group 'gnus-picon :link '(custom-manual "(gnus)Customizing Articles") @@ -1338,6 +1343,7 @@ See Info node `(gnus)Customizing Articles' for details." To automatically treat X-PGP-Sig, set it to head. Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles' for details." + :version "21.4" :group 'gnus-article-treat :group 'mime-security :link '(custom-manual "(gnus)Customizing Articles") diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index bf9f5863428..5306f3b17bf 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el @@ -124,6 +124,7 @@ The text matching the first grouping will be used as a button." (defcustom gnus-cite-unsightly-citation-regexp "^-----Original Message-----\nFrom: \\(.+\n\\)+\n" "Regexp matching Microsoft-type rest-of-message citations." + :version "21.4" :group 'gnus-cite :type 'regexp) @@ -131,6 +132,7 @@ The text matching the first grouping will be used as a button." "Non-nil means don't regard lines beginning with \">From \" as cited text. Those lines may have been quoted by MTAs in order not to mix up with the envelope From line." + :version "21.4" :group 'gnus-cite :type 'boolean) @@ -141,6 +143,7 @@ the envelope From line." (defcustom gnus-cite-attribution-face 'gnus-cite-attribution-face "Face used for attribution lines. It is merged with the face for the cited text belonging to the attribution." + :version "21.4" :group 'gnus-cite :type 'face) @@ -278,7 +281,6 @@ This should make it easier to see who wrote what." (defcustom gnus-cite-blank-line-after-header t "If non-nil, put a blank line between the citation header and the button." - :version "21.4" :group 'gnus-cite :type 'boolean) @@ -290,7 +292,6 @@ This should make it easier to see who wrote what." If an article has more pages below the one you are looking at, but nothing on those pages is a word of at least three letters that is not in a boring face, then the pages will be skipped." - :version "21.4" :type '(repeat face) :group 'gnus-article-hiding) diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el index ee431076fad..8a566e3e5d8 100644 --- a/lisp/gnus/gnus-delay.el +++ b/lisp/gnus/gnus-delay.el @@ -41,6 +41,7 @@ ;;;###autoload (defgroup gnus-delay nil "Arrange for sending postings later." + :version "21.4" :group 'gnus) (defcustom gnus-delay-group "delayed" diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el index e82d77fa58b..7d2df362bbc 100644 --- a/lisp/gnus/gnus-diary.el +++ b/lisp/gnus/gnus-diary.el @@ -102,7 +102,8 @@ (require 'gnus-art) (defgroup gnus-diary nil - "Utilities on top of the nndiary backend for Gnus.") + "Utilities on top of the nndiary backend for Gnus." + :version "21.4") (defcustom gnus-diary-summary-line-format "%U%R%z %uD: %(%s%) (%ud)\n" "*Summary line format for nndiary groups." diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index 886aa80368f..6b093480940 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -281,6 +281,7 @@ If nil, Gnus will never ask for confirmation if replying to mail." "If non-nil, Gnus tries to suggest a default address to resend to. If nil, the address field will always be empty after invoking `gnus-summary-resend-message'." + :version "21.4" :group 'gnus-message :type 'boolean) diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 841f0057566..046114cbe24 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -66,6 +66,7 @@ (defgroup gnus-registry nil "The Gnus registry." + :version "21.4" :group 'gnus) (defvar gnus-registry-hashtb nil diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el index dc93fef5176..1177df4731a 100644 --- a/lisp/gnus/gnus-spec.el +++ b/lisp/gnus/gnus-spec.el @@ -32,12 +32,14 @@ (defcustom gnus-use-correct-string-widths (featurep 'xemacs) "*If non-nil, use correct functions for dealing with wide characters." + :version "21.4" :group 'gnus-format :type 'boolean) (defcustom gnus-make-format-preserve-properties (featurep 'xemacs) "*If non-nil, use a replacement `format' function which preserves text properties. This is only needed on XEmacs, as FSF Emacs does this anyway." + :version "21.4" :group 'gnus-format :type 'boolean) diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index 7fef378722a..d42c5d71cfd 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -205,21 +205,25 @@ If nil, a faster, but more primitive, buffer is used instead." (defcustom gnus-server-agent-face 'gnus-server-agent-face "Face name to use on AGENTIZED servers." + :version "21.4" :group 'gnus-server-visual :type 'face) (defcustom gnus-server-opened-face 'gnus-server-opened-face "Face name to use on OPENED servers." + :version "21.4" :group 'gnus-server-visual :type 'face) (defcustom gnus-server-closed-face 'gnus-server-closed-face "Face name to use on CLOSED servers." + :version "21.4" :group 'gnus-server-visual :type 'face) (defcustom gnus-server-denied-face 'gnus-server-denied-face "Face name to use on DENIED servers." + :version "21.4" :group 'gnus-server-visual :type 'face) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 971124ba831..81ca22a87ad 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -299,6 +299,7 @@ claim them." (defcustom gnus-subscribe-newsgroup-hooks nil "*Hooks run after you subscribe to a new group. The hooks will be called with new group's name as argument." + :version "21.4" :group 'gnus-group-new :type 'hook) @@ -405,6 +406,7 @@ This hook is called as the first thing when Gnus is started." (defcustom gnus-get-top-new-news-hook nil "A hook run just before Gnus checks for new news globally." + :version "21.4" :group 'gnus-group-new :type 'hook) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 6ce2f55e2b7..5f2c2d7aeb1 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -469,6 +469,7 @@ this variable specifies group names." (defcustom gnus-spam-mark ?$ "*Mark used for spam articles." + :version "21.4" :group 'gnus-summary-marks :type 'character) @@ -505,6 +506,7 @@ this variable specifies group names." (defcustom gnus-recent-mark ?N "*Mark used for articles that are recent." + :version "21.4" :group 'gnus-summary-marks :type 'character) @@ -552,6 +554,7 @@ this variable specifies group names." (defcustom gnus-undownloaded-mark ?- "*Mark used for articles that weren't downloaded." + :version "21.4" :group 'gnus-summary-marks :type 'character) @@ -890,16 +893,19 @@ automatically when it is selected." (defcustom gnus-summary-article-move-hook nil "*A hook called after an article is moved, copied, respooled, or crossposted." + :version "21.4" :group 'gnus-summary :type 'hook) (defcustom gnus-summary-article-delete-hook nil "*A hook called after an article is deleted." + :version "21.4" :group 'gnus-summary :type 'hook) (defcustom gnus-summary-article-expire-hook nil "*A hook called after an article is expired." + :version "21.4" :group 'gnus-summary :type 'hook) @@ -9178,6 +9184,7 @@ If nil, use to the current newsgroup method." "If non-nil, show and update the summary buffer as it's being built. If the value is t, update the buffer after every line is inserted. If the value is an integer (N), update the display every N lines." + :version "21.4" :group 'gnus-thread :type '(choice (const :tag "off" nil) number diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el index 8de4673fddc..554c9dc3437 100644 --- a/lisp/gnus/gnus-win.el +++ b/lisp/gnus/gnus-win.el @@ -62,6 +62,7 @@ "*If non-nil, frames on all displays will be considered useable by Gnus. When nil, only frames on the same display as the selected frame will be used to display Gnus windows." + :version "21.4" :group 'gnus-windows :type 'boolean) @@ -198,6 +199,7 @@ See the Gnus manual for an explanation of the syntax used.") (defcustom gnus-configure-windows-hook nil "*A hook called when configuring windows." + :version "21.4" :group 'gnus-windows :type 'hook) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index bff1c3bba2f..c8dc878eacd 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -1314,6 +1314,7 @@ If the default site is too slow, try one of these: (gnus-replace-in-string name "\\." "-") "-charter.html"))) "*An alist of (HIERARCHY . FORM) pairs used to construct the URL of a charter. When FORM is evaluated `name' is bound to the name of the group." + :version "21.4" :group 'gnus-group-various :type '(repeat (cons (string :tag "Hierarchy") (sexp :tag "Form")))) @@ -1321,6 +1322,7 @@ When FORM is evaluated `name' is bound to the name of the group." "*Non-nil means that control messages are displayed using `browse-url'. Otherwise they are fetched with ange-ftp and displayed in an ephemeral group." + :version "21.4" :group 'gnus-group-various :type 'boolean) @@ -1788,6 +1790,7 @@ total number of articles in the group.") (defcustom gnus-install-group-spam-parameters t "*Disable the group parameters for spam detection. Enable if `G c' in XEmacs is giving you trouble, and make sure to submit a bug report." + :version "21.4" :type 'boolean :group 'gnus-start) diff --git a/lisp/gnus/html2text.el b/lisp/gnus/html2text.el index 31d1869c695..7decfc8adb1 100644 --- a/lisp/gnus/html2text.el +++ b/lisp/gnus/html2text.el @@ -24,11 +24,11 @@ ;; These functions provide a simple way to wash/clean html infected ;; mails. Definitely do not work in all cases, but some improvement -;; in readability is generally obtained. Formatting is only done in +;; in readability is generally obtained. Formatting is only done in ;; the buffer, so the next time you enter the article it will be ;; "re-htmlized". ;; -;; The main function is "html2text" +;; The main function is `html2text'. ;;; Code: @@ -47,9 +47,9 @@ "The map of entity to text. This is an alist were each element is a dotted pair consisting of an -old string, and a replacement string. This replacement is done by the -function \"html2text-substitute\" which basically performs a -replace-string operation for every element in the list. This is +old string, and a replacement string. This replacement is done by the +function `html2text-substitute' which basically performs a +`replace-string' operation for every element in the list. This is completely verbatim - without any use of REGEXP.") (defvar html2text-remove-tag-list @@ -57,11 +57,11 @@ completely verbatim - without any use of REGEXP.") "A list of removable tags. This is a list of tags which should be removed, without any -formatting. Observe that if you the tags in the list are presented -*without* any \"<\" or \">\". All occurences of a tag appearing in -this list are removed, irrespective of whether it is a closing or -opening tag, or if the tag has additional attributes. The actual -deletion is done by the function \"html2text-remove-tags\". +formatting. Note that tags in the list are presented *without* +any \"<\" or \">\". All occurences of a tag appearing in this +list are removed, irrespective of whether it is a closing or +opening tag, or if the tag has additional attributes. The +deletion is done by the function `html2text-remove-tags'. For instance the text: @@ -75,8 +75,10 @@ If this list contains the element \"font\".") (defvar html2text-format-tag-list '(("b" . html2text-clean-bold) + ("strong" . html2text-clean-bold) ("u" . html2text-clean-underline) ("i" . html2text-clean-italic) + ("em" . html2text-clean-italic) ("blockquote" . html2text-clean-blockquote) ("a" . html2text-clean-anchor) ("ul" . html2text-clean-ul) @@ -86,7 +88,7 @@ If this list contains the element \"font\".") "An alist of tags and processing functions. This is an alist where each dotted pair consists of a tag, and then -the name of a function to be called when this tag is found. The +the name of a function to be called when this tag is found. The function is called with the arguments p1, p2, p3 and p4. These are demontrated below: @@ -117,17 +119,15 @@ formatting, and then moved afterward.") ;; -(defun html2text-replace-string (from-string to-string p1 p2) - (goto-char p1) +(defun html2text-replace-string (from-string to-string min max) + "Replace FROM-STRING with TO-STRING in region from MIN to MAX." + (goto-char min) (let ((delta (- (string-width to-string) (string-width from-string))) (change 0)) - (while (search-forward from-string p2 t) + (while (search-forward from-string max t) (replace-match to-string) - (setq change (+ change delta)) - ) - change - ) - ) + (setq change (+ change delta))) + change)) ;; ;; @@ -140,9 +140,9 @@ formatting, and then moved afterward.") ;; i.e. ;; -(defun html2text-attr-value (attr-list attr) - (nth 1 (assoc attr attr-list)) - ) +(defun html2text-attr-value (list attribute) + "Get value of ATTRIBUTE from LIST." + (nth 1 (assoc attribute list))) (defun html2text-get-attr (p1 p2 tag) (goto-char p1) @@ -161,14 +161,10 @@ formatting, and then moved afterward.") ((string-match "[^ ]=[^ ]" prev) (let ((attr (nth 0 (split-string prev "="))) (value (nth 1 (split-string prev "=")))) - (setq attr-list (cons (list attr value) attr-list)) - ) - ) + (setq attr-list (cons (list attr value) attr-list)))) ;; size= 3 ((string-match "[^ ]=\\'" prev) - (setq attr-list (cons (list (substring prev 0 -1) this) attr-list)) - ) - ) + (setq attr-list (cons (list (substring prev 0 -1) this) attr-list)))) (while (< index (length tmp-list)) (cond @@ -176,29 +172,20 @@ formatting, and then moved afterward.") ((string-match "[^ ]=[^ ]" this) (let ((attr (nth 0 (split-string this "="))) (value (nth 1 (split-string this "=")))) - (setq attr-list (cons (list attr value) attr-list)) - ) - ) + (setq attr-list (cons (list attr value) attr-list)))) ;; size =3 ((string-match "\\`=[^ ]" this) (setq attr-list (cons (list prev (substring this 1)) attr-list))) - ;; size= 3 ((string-match "[^ ]=\\'" this) - (setq attr-list (cons (list (substring this 0 -1) next) attr-list)) - ) - + (setq attr-list (cons (list (substring this 0 -1) next) attr-list))) ;; size = 3 ((string= "=" this) - (setq attr-list (cons (list prev next) attr-list)) - ) - ) + (setq attr-list (cons (list prev next) attr-list)))) (setq index (1+ index)) (setq prev this) (setq this next) - (setq next (nth (1+ index) tmp-list)) - ) - + (setq next (nth (1+ index) tmp-list))) ;; ;; Tags with no accompanying "=" i.e. value=nil ;; @@ -207,41 +194,25 @@ formatting, and then moved afterward.") (setq next (nth 2 tmp-list)) (setq index 1) - (if (not (string-match "=" prev)) - (progn - (if (not (string= (substring this 0 1) "=")) - (setq attr-list (cons (list prev nil) attr-list)) - ) - ) - ) - + (when (and (not (string-match "=" prev)) + (not (string= (substring this 0 1) "="))) + (setq attr-list (cons (list prev nil) attr-list))) (while (< index (1- (length tmp-list))) - (if (not (string-match "=" this)) - (if (not (or (string= (substring next 0 1) "=") - (string= (substring prev -1) "="))) - (setq attr-list (cons (list this nil) attr-list)) - ) - ) + (when (and (not (string-match "=" this)) + (not (or (string= (substring next 0 1) "=") + (string= (substring prev -1) "=")))) + (setq attr-list (cons (list this nil) attr-list))) (setq index (1+ index)) (setq prev this) (setq this next) - (setq next (nth (1+ index) tmp-list)) - ) + (setq next (nth (1+ index) tmp-list))) - (if this - (progn - (if (not (string-match "=" this)) - (progn - (if (not (string= (substring prev -1) "=")) - (setq attr-list (cons (list this nil) attr-list)) - ) - ) - ) - ) - ) - attr-list ;; return - value - ) - ) + (when (and this + (not (string-match "=" this)) + (not (string= (substring prev -1) "="))) + (setq attr-list (cons (list this nil) attr-list))) + ;; return - value + attr-list)) ;; ;; @@ -266,10 +237,7 @@ formatting, and then moved afterward.") (cond ((string= list-type "ul") (insert " o ")) ((string= list-type "ol") (insert (format " %s: " item-nr))) - (t (insert " x "))) - ) - ) - ) + (t (insert " x ")))))) (defun html2text-clean-dtdd (p1 p2) (goto-char p1) @@ -308,60 +276,50 @@ formatting, and then moved afterward.") (html2text-delete-single-tag p1 p2) (goto-char p1) (newline 1) - (insert (make-string fill-column ?-)) - ) + (insert (make-string fill-column ?-))) (defun html2text-clean-ul (p1 p2 p3 p4) (html2text-delete-tags p1 p2 p3 p4) - (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ul") - ) + (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ul")) (defun html2text-clean-ol (p1 p2 p3 p4) (html2text-delete-tags p1 p2 p3 p4) - (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ol") - ) + (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ol")) (defun html2text-clean-dl (p1 p2 p3 p4) (html2text-delete-tags p1 p2 p3 p4) - (html2text-clean-dtdd p1 (- p3 (- p1 p2))) - ) + (html2text-clean-dtdd p1 (- p3 (- p1 p2)))) (defun html2text-clean-center (p1 p2 p3 p4) (html2text-delete-tags p1 p2 p3 p4) - (center-region p1 (- p3 (- p2 p1))) - ) + (center-region p1 (- p3 (- p2 p1)))) (defun html2text-clean-bold (p1 p2 p3 p4) (put-text-property p2 p3 'face 'bold) - (html2text-delete-tags p1 p2 p3 p4) - ) + (html2text-delete-tags p1 p2 p3 p4)) (defun html2text-clean-title (p1 p2 p3 p4) (put-text-property p2 p3 'face 'bold) - (html2text-delete-tags p1 p2 p3 p4) - ) + (html2text-delete-tags p1 p2 p3 p4)) (defun html2text-clean-underline (p1 p2 p3 p4) (put-text-property p2 p3 'face 'underline) - (html2text-delete-tags p1 p2 p3 p4) - ) + (html2text-delete-tags p1 p2 p3 p4)) (defun html2text-clean-italic (p1 p2 p3 p4) (put-text-property p2 p3 'face 'italic) - (html2text-delete-tags p1 p2 p3 p4) - ) + (html2text-delete-tags p1 p2 p3 p4)) (defun html2text-clean-font (p1 p2 p3 p4) - (html2text-delete-tags p1 p2 p3 p4) - ) + (html2text-delete-tags p1 p2 p3 p4)) (defun html2text-clean-blockquote (p1 p2 p3 p4) - (html2text-delete-tags p1 p2 p3 p4) - ) + (html2text-delete-tags p1 p2 p3 p4)) (defun html2text-clean-anchor (p1 p2 p3 p4) - ;; If someone can explain how to make the URL clickable I will - ;; surely improve upon this. + ;; If someone can explain how to make the URL clickable I will surely + ;; improve upon this. + ;; Maybe `goto-addr.el' can be used here. (let* ((attr-list (html2text-get-attr p1 p2 "a")) (href (html2text-attr-value attr-list "href"))) (delete-region p1 p4) @@ -386,38 +344,27 @@ formatting, and then moved afterward.") (let ((has-br-line) (refill-start) (refill-stop)) - (if (re-search-forward "
$" p2 t) - (setq has-br-line t) - ) - (if has-br-line - (progn - (goto-char p1) - (if (re-search-forward ".+[^<][^b][^r][^>]$" p2 t) - (progn - (beginning-of-line) - (setq refill-start (point)) - (goto-char p2) - (re-search-backward ".+[^<][^b][^r][^>]$" refill-start t) - (next-line 1) - (end-of-line) - ;; refill-stop should ideally be adjusted to - ;; accomodate the "
" strings which are removed - ;; between refill-start and refill-stop. Can simply - ;; be returned from my-replace-string - (setq refill-stop (+ (point) - (html2text-replace-string - "
" "" - refill-start (point)))) - ;; (message "Point = %s refill-stop = %s" (point) refill-stop) - ;; (sleep-for 4) - (fill-region refill-start refill-stop) - ) - ) - ) - ) - ) - (html2text-replace-string "
" "" p1 p2) - ) + (when (re-search-forward "
$" p2 t) + (goto-char p1) + (when (re-search-forward ".+[^<][^b][^r][^>]$" p2 t) + (beginning-of-line) + (setq refill-start (point)) + (goto-char p2) + (re-search-backward ".+[^<][^b][^r][^>]$" refill-start t) + (next-line 1) + (end-of-line) + ;; refill-stop should ideally be adjusted to + ;; accomodate the "
" strings which are removed + ;; between refill-start and refill-stop. Can simply + ;; be returned from my-replace-string + (setq refill-stop (+ (point) + (html2text-replace-string + "
" "" + refill-start (point)))) + ;; (message "Point = %s refill-stop = %s" (point) refill-stop) + ;; (sleep-for 4) + (fill-region refill-start refill-stop)))) + (html2text-replace-string "
" "" p1 p2)) ;; ;; This one is interactive ... @@ -452,7 +399,7 @@ fashion, quite close to pure guess-work. It does work in some cases though." ;; (defun html2text-remove-tags (tag-list) - "Removes the tags listed in the list \"html2text-remove-tag-list\". + "Removes the tags listed in the list `html2text-remove-tag-list'. See the documentation for that variable." (interactive) (dolist (tag tag-list) @@ -461,7 +408,7 @@ See the documentation for that variable." (delete-region (match-beginning 0) (match-end 0))))) (defun html2text-format-tags () - "See the variable \"html2text-format-tag-list\" for documentation" + "See the variable `html2text-format-tag-list' for documentation." (interactive) (dolist (tag-and-function html2text-format-tag-list) (let ((tag (car tag-and-function)) @@ -480,27 +427,18 @@ See the documentation for that variable." (search-backward " ;; - +(provide 'html2text) ;;; arch-tag: e9e57b79-35d4-4de1-a647-e7e01fe56d1e ;;; html2text.el ends here diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 585a72af549..fb63d6724be 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -587,6 +587,7 @@ Done before generating the new subject of a forward." non-word-constituents "]\\)+>+\\|[ \t]*[]>|}+]\\)+")))) "*Regexp matching the longest possible citation prefix on a line." + :version "21.4" :group 'message-insertion :link '(custom-manual "(message)Insertion Variables") :type 'regexp) @@ -743,6 +744,7 @@ Doing so would be even more evil than leaving it out." "*Envelope-from when sending mail with sendmail. If this is nil, use `user-mail-address'. If it is the symbol `header', use the From: header of the message." + :version "21.4" :type '(choice (string :tag "From name") (const :tag "Use From: header from message" header) (const :tag "Use `user-mail-address'" nil)) @@ -855,7 +857,8 @@ the signature is inserted." (let ((map (make-sparse-keymap 'message-minibuffer-local-map))) (set-keymap-parent map minibuffer-local-map) map) - "Keymap for `message-read-from-minibuffer'.") + "Keymap for `message-read-from-minibuffer'." + :version "21.4") ;;;###autoload (defcustom message-citation-line-function 'message-insert-citation-line @@ -1435,6 +1438,7 @@ no, only reply back to the author." (defcustom message-user-fqdn nil "*Domain part of Messsage-Ids." + :version "21.4" :group 'message-headers :link '(custom-manual "(message)News Headers") :type '(radio (const :format "%v " nil) @@ -6590,6 +6594,7 @@ which specify the range to operate on." '("^\\(Disposition-Notification-To\\|Return-Receipt-To\\):" . message-expand-name)) "Alist of (RE . FUN). Use FUN for completion on header lines matching RE." + :version "21.4" :group 'message :type '(alist :key-type regexp :value-type function)) diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 51ec38dc387..b167ea7d104 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -150,12 +150,14 @@ when displaying the image. The default value is \"\\\\`cid:\" which only matches parts embedded to the Multipart/Related type MIME contents and Gnus will never connect to the spammer's site arbitrarily. You may set this variable to nil if you consider all urls to be safe." + :version "21.4" :type '(choice (regexp :tag "Regexp") (const :tag "All URLs are safe" nil)) :group 'mime-display) (defcustom mm-inline-text-html-with-w3m-keymap t "If non-nil, use emacs-w3m command keys in the article buffer." + :version "21.4" :type 'boolean :group 'mime-display) @@ -378,6 +380,7 @@ If not set, `default-directory' will be used." (defcustom mm-attachment-file-modes 384 "Set the mode bits of saved attachments to this integer." + :version "21.4" :type 'integer :group 'mime-display) @@ -435,6 +438,7 @@ If not set, `default-directory' will be used." "Option of decrypting encrypted parts. `never', not decrypt; `always', always decrypt; `known', only decrypt known protocols. Otherwise, ask user." + :version "21.4" :type '(choice (item always) (item never) (item :tag "only known protocols" known) diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index 1652dbca245..1388371c981 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el @@ -49,6 +49,7 @@ (require 'url) (error nil))) "*If non-nil, use external grab program `mm-url-program'." + :version "21.4" :type 'boolean :group 'mm-url) @@ -67,6 +68,7 @@ (t "GET")) "The url grab program. Likely values are `wget', `w3m', `lynx' and `curl'." + :version "21.4" :type '(choice (symbol :tag "wget" wget) (symbol :tag "w3m" w3m) @@ -77,6 +79,7 @@ Likely values are `wget', `w3m', `lynx' and `curl'." (defcustom mm-url-arguments nil "The arguments for `mm-url-program'." + :version "21.4" :type '(repeat string) :group 'mm-url) diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el index 17fa59311db..b140cb76df5 100644 --- a/lisp/gnus/mm-uu.el +++ b/lisp/gnus/mm-uu.el @@ -80,6 +80,7 @@ This can be either \"inline\" or \"attachment\".") (defcustom mm-uu-diff-groups-regexp "gnus\\.commits" "*Regexp matching diff groups." + :version "21.4" :type 'regexp :group 'gnus-article-mime) diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el index b8107364411..8bd2ed784ad 100644 --- a/lisp/gnus/mml-sec.el +++ b/lisp/gnus/mml-sec.el @@ -43,6 +43,7 @@ (defcustom mml-default-sign-method "pgpmime" "Default sign method. The string must have an entry in `mml-sign-alist'." + :version "21.4" :type '(choice (const "smime") (const "pgp") (const "pgpauto") @@ -60,6 +61,7 @@ The string must have an entry in `mml-sign-alist'." (defcustom mml-default-encrypt-method "pgpmime" "Default encryption method. The string must have an entry in `mml-encrypt-alist'." + :version "21.4" :type '(choice (const "smime") (const "pgp") (const "pgpauto") @@ -83,6 +85,7 @@ Note that the output generated by using a `combined' mode is NOT understood by all PGP implementations, in particular PGP version 2 does not support it! See Info node `(message)Security' for details." + :version "21.4" :group 'message :type '(repeat (list (choice (const :tag "S/MIME" "smime") (const :tag "PGP" "pgp") diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index 6c89cfbe798..e083c2c9d9c 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -83,6 +83,7 @@ ("TRUST_FULLY" . t) ("TRUST_ULTIMATE" . t)) "Map GnuPG trust output values to a boolean saying if you trust the key." + :version "21.4" :group 'mime-security :type '(repeat (cons (regexp :tag "GnuPG output regexp") (boolean :tag "Trust key")))) diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el index 81d5443b640..13000a8ad19 100644 --- a/lisp/gnus/nndiary.el +++ b/lisp/gnus/nndiary.el @@ -223,6 +223,7 @@ (defgroup nndiary nil "The Gnus Diary backend." + :version "21.4" :group 'gnus-diary) (defcustom nndiary-mail-sources diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index c1a23d8ca9b..040be1e60e1 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -119,6 +119,7 @@ If nil, the first match found will be used." (defcustom nnmail-split-fancy-with-parent-ignore-groups nil "Regexp that matches group names to be ignored when applying `nnmail-split-fancy-with-parent'. This can also be a list of regexps." + :version "21.4" :group 'nnmail-split :type '(choice (const :tag "none" nil) (regexp :value ".*") @@ -127,6 +128,7 @@ This can also be a list of regexps." (defcustom nnmail-cache-ignore-groups nil "Regexp that matches group names to be ignored when inserting message ids into the cache (`nnmail-cache-insert'). This can also be a list of regexps." + :version "21.4" :group 'nnmail-split :type '(choice (const :tag "none" nil) (regexp :value ".*") @@ -353,6 +355,7 @@ discarded after running the split process." (defcustom nnmail-spool-hook nil "*A hook called when a new article is spooled." + :version "21.4" :group 'nnmail :type 'hook) @@ -575,6 +578,7 @@ Normally, regexes given in `nnmail-split-fancy' are implicitly surrounded by \"\\=\\<...\\>\". If this variable is true, they are not implicitly\ surrounded by anything." + :version "21.4" :group 'nnmail :type 'boolean) @@ -582,6 +586,7 @@ by anything." "Whether to lowercase expanded entries (i.e. \\N) when splitting mails. This avoids the creation of multiple groups when users send to an address using different case (i.e. mailing-list@domain vs Mailing-List@Domain)." + :version "21.4" :group 'nnmail :type 'boolean) diff --git a/lisp/gnus/sha1.el b/lisp/gnus/sha1.el index a9b68805d3f..51a826fe5fc 100644 --- a/lisp/gnus/sha1.el +++ b/lisp/gnus/sha1.el @@ -60,6 +60,7 @@ (defgroup sha1 nil "Elisp interface for SHA1 hash computation." + :version "21.4" :group 'extensions) (defcustom sha1-maximum-internal-length 500 @@ -82,7 +83,6 @@ It must be a string \(program name\) or list of strings \(name and its args\)." (error)) "*Use external SHA1 program. If this variable is set to nil, use internal function only." - :version "21.4" :type 'boolean :group 'sha1) diff --git a/lisp/gnus/sieve.el b/lisp/gnus/sieve.el index f4645168dec..c37ffb616db 100644 --- a/lisp/gnus/sieve.el +++ b/lisp/gnus/sieve.el @@ -65,6 +65,7 @@ (defgroup sieve nil "Manage sieve scripts." + :version "21.4" :group 'tools) (defcustom sieve-new-script "" diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el index f197d165cdd..eb33b7ad0b3 100644 --- a/lisp/gnus/spam-stat.el +++ b/lisp/gnus/spam-stat.el @@ -128,6 +128,7 @@ Use the functions to build a dictionary of words and their statistical distribution in spam and non-spam mails. Then use a function to determine whether a buffer contains spam or not." + :version "21.4" :group 'gnus) (defcustom spam-stat-file "~/.spam-stat.el" diff --git a/lisp/gnus/starttls.el b/lisp/gnus/starttls.el index c172e88c515..7a2eef5e7d0 100644 --- a/lisp/gnus/starttls.el +++ b/lisp/gnus/starttls.el @@ -126,6 +126,7 @@ "Name of GNUTLS command line tool. This program is used when GNUTLS is used, i.e. when `starttls-use-gnutls' is non-nil." + :version "21.4" :type 'string :group 'starttls) @@ -138,6 +139,7 @@ i.e. when `starttls-use-gnutls' is nil." (defcustom starttls-use-gnutls (not (executable-find starttls-program)) "*Whether to use GNUTLS instead of the `starttls' command." + :version "21.4" :type 'boolean :group 'starttls) @@ -156,11 +158,13 @@ This program is used when GNUTLS is used, i.e. when For example, non-TLS compliant servers may require '(\"--protocols\" \"ssl3\"). Invoke \"gnutls-cli --help\" to find out which parameters are available." + :version "21.4" :type '(repeat string) :group 'starttls) (defcustom starttls-process-connection-type nil "*Value for `process-connection-type' to use when starting STARTTLS process." + :version "21.4" :type 'boolean :group 'starttls) @@ -170,6 +174,7 @@ The default is what GNUTLS's \"gnutls-cli\" outputs." ;; GNUTLS cli.c:main() print this string when it is starting to run ;; in the application read/write phase. If the logic, or the string ;; itself, is modified, this must be updated. + :version "21.4" :type 'regexp :group 'starttls) @@ -178,6 +183,7 @@ The default is what GNUTLS's \"gnutls-cli\" outputs." The default is what GNUTLS's \"gnutls-cli\" outputs." ;; GNUTLS cli.c:do_handshake() print this string on failure. If the ;; logic, or the string itself, is modified, this must be updated. + :version "21.4" :type 'regexp :group 'starttls) @@ -188,6 +194,7 @@ The default is what GNUTLS's \"gnutls-cli\" outputs." ;; common.c:print_info(), that unconditionally print this string ;; last. If that logic, or the string itself, is modified, this ;; must be updated. + :version "21.4" :type 'regexp :group 'starttls) diff --git a/lisp/net/tls.el b/lisp/net/tls.el index 5f57c084f9b..1b58760c17c 100644 --- a/lisp/net/tls.el +++ b/lisp/net/tls.el @@ -67,18 +67,21 @@ after successful negotiation." (defcustom tls-process-connection-type nil "*Value for `process-connection-type' to use when starting TLS process." + :version "21.4" :type 'boolean :group 'tls) (defcustom tls-success "- Handshake was completed" "*Regular expression indicating completed TLS handshakes. The default is what GNUTLS's \"gnutls-cli\" outputs." + :version "21.4" :type 'regexp :group 'tls) (defcustom tls-certtool-program (executable-find "certtool") "Name of GnuTLS certtool. Used by `tls-certificate-information'." + :version "21.4" :type '(repeat string) :group 'tls) From 0911ac26575a836e9df8a2b2148503bfbb5af400 Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Mon, 1 Nov 2004 23:06:51 +0000 Subject: [PATCH 053/146] (describe-text-properties): Don't err if called in the *Help* buffer; output to *Help-2* buffer instead. --- lisp/descr-text.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/lisp/descr-text.el b/lisp/descr-text.el index 8ac2d36334b..72ddde7c8cb 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -176,11 +176,12 @@ otherwise." (describe-text-properties-1 pos output-buffer) (if (not (or (text-properties-at pos) (overlays-at pos))) (message "This is plain text.") - (let ((buffer (current-buffer))) - (when (eq buffer (get-buffer "*Help*")) - (error "Can't do self inspection")) + (let ((buffer (current-buffer)) + (target-buffer "*Help*")) + (when (eq buffer (get-buffer target-buffer)) + (setq target-buffer "*Help-2*")) (save-excursion - (with-output-to-temp-buffer "*Help*" + (with-output-to-temp-buffer target-buffer (set-buffer standard-output) (setq output-buffer (current-buffer)) (widget-insert "Text content at position " (format "%d" pos) ":\n\n") From 3fc26d4804fac2ed6c3828b9c08037a6cb1a8920 Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Mon, 1 Nov 2004 23:13:39 +0000 Subject: [PATCH 054/146] *** empty log message *** --- lisp/ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 82aec89b14b..bb38dbc47ed 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,9 @@ 2004-11-02 Kim F. Storm + * ehelp.el (electric-help-map): Reorder Q/q and R/r entries so + substitute-command-keys will select lower-case bindings like those + used in the static help texts. + * descr-text.el (describe-text-properties): Don't err if called in the *Help* buffer; output to *Help-2* buffer instead. From ad8d994cbecb75742754f1a9d56e5f1b11950e78 Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Mon, 1 Nov 2004 23:16:25 +0000 Subject: [PATCH 055/146] (electric-help-map): Reorder Q/q and R/r entries so substitute-command-keys will select lower-case bindings like those used in the static help texts. --- lisp/ChangeLog | 4 ++++ lisp/ehelp.el | 4 ++-- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index bb38dbc47ed..3bdd1fefca1 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,9 @@ 2004-11-02 Kim F. Storm + * files.el (set-auto-mode-0): Don't rely on dynamic binding of + keep-mode-if-same variable. Add it as optional arg instead. + (set-auto-mode): Call set-auto-mode-0 with keep-mode-if-same. + * ehelp.el (electric-help-map): Reorder Q/q and R/r entries so substitute-command-keys will select lower-case bindings like those used in the static help texts. diff --git a/lisp/ehelp.el b/lisp/ehelp.el index e80c129d3ea..82a8e10301e 100644 --- a/lisp/ehelp.el +++ b/lisp/ehelp.el @@ -85,11 +85,11 @@ (define-key map "<" 'beginning-of-buffer) (define-key map ">" 'end-of-buffer) ;(define-key map "\C-g" 'electric-help-exit) - (define-key map "q" 'electric-help-exit) (define-key map "Q" 'electric-help-exit) + (define-key map "q" 'electric-help-exit) ;;a better key than this? - (define-key map "r" 'electric-help-retain) (define-key map "R" 'electric-help-retain) + (define-key map "r" 'electric-help-retain) (define-key map "\ex" 'electric-help-execute-extended) (define-key map "\C-x" 'electric-help-ctrl-x-prefix) From 3467488ee7d0b3eb3b4c34da94eee2243636bc5b Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Mon, 1 Nov 2004 23:16:42 +0000 Subject: [PATCH 056/146] (set-auto-mode-0): Don't rely on dynamic binding of keep-mode-if-same variable. Add it as optional arg instead. (set-auto-mode): Call set-auto-mode-0 with keep-mode-if-same. --- lisp/files.el | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/lisp/files.el b/lisp/files.el index 5ff80615050..f10281a0d10 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1896,7 +1896,7 @@ only set the major mode, if that would change it." (if (not (functionp mode)) (message "Ignoring unknown mode `%s'" mode) (setq done t) - (or (set-auto-mode-0 mode) + (or (set-auto-mode-0 mode keep-mode-if-same) (throw 'nop nil))))) ;; If we didn't, look for an interpreter specified in the first line. ;; As a special case, allow for things like "#!/bin/env perl", which @@ -1911,7 +1911,7 @@ only set the major mode, if that would change it." done (assoc (file-name-nondirectory mode) interpreter-mode-alist)) ;; If we found an interpreter mode to use, invoke it now. - (if done (set-auto-mode-0 (cdr done)))) + (if done (set-auto-mode-0 (cdr done) keep-mode-if-same))) (if (and (not done) buffer-file-name) (let ((name buffer-file-name)) ;; Remove backup-suffixes from file name. @@ -1930,27 +1930,27 @@ only set the major mode, if that would change it." (when mode (if xml (or (memq mode xml-based-modes) (setq mode 'xml-mode))) - (set-auto-mode-0 mode) + (set-auto-mode-0 mode keep-mode-if-same) (setq done t))))) (and xml (not done) - (set-auto-mode-0 'xml-mode)))) + (set-auto-mode-0 'xml-mode keep-mode-if-same)))) ;; When `keep-mode-if-same' is set, we are working on behalf of ;; set-visited-file-name. In that case, if the major mode specified is the ;; same one we already have, don't actually reset it. We don't want to lose ;; minor modes such as Font Lock. -(defun set-auto-mode-0 (mode) +(defun set-auto-mode-0 (mode &optional keep-mode-if-same) "Apply MODE and return it. -If `keep-mode-if-same' is non-nil MODE is chased of any aliases and -compared to current major mode. If they are the same, do nothing -and return nil." +If optional arg KEEP-MODE-IF-SAME is non-nil, MODE is chased of +any aliases and compared to current major mode. If they are the +same, do nothing and return nil." (when keep-mode-if-same (while (symbolp (symbol-function mode)) (setq mode (symbol-function mode))) (if (eq mode major-mode) - (setq mode))) + (setq mode nil))) (when mode (funcall mode) mode)) From 81d565943da7e109fdbc27540608b31a6f1d0ebc Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 2 Nov 2004 01:05:27 +0000 Subject: [PATCH 057/146] From Ulf Jasper : (icalendar-version): Increase to 0.08. (icalendar--split-value): Change name of work buffer. (icalendar--get-weekday-abbrev): Return nil on error. (icalendar--date-to-isodate): New function. (icalendar-convert-diary-to-ical) (icalendar-extract-ical-from-buffer): Use only two args for make-obsolete (XEmacs compatibility). (icalendar-export-file, icalendar-import-file): Blank at end of prompt. (icalendar-export-region): Doc fix. If error, return non-nil and write errors to buffer ` *icalendar-errors*'. Use correct weekday for weekly recurring events. Check whether date has been parsed for ordinary events. Make weekly events start in the year 2000. DTEND is non-inclusive, shift end date by one day if necessary (not for entries that have date and time). Rename local let variables: oops -> found-error, datestring -> startdatestring. --- lisp/calendar/icalendar.el | 724 ++++++++++++++++++++----------------- 1 file changed, 383 insertions(+), 341 deletions(-) diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el index 5f581e1d74a..dc3bf016053 100644 --- a/lisp/calendar/icalendar.el +++ b/lisp/calendar/icalendar.el @@ -31,16 +31,7 @@ ;;; History: -;; 0.07: Renamed commands! -;; icalendar-extract-ical-from-buffer -> icalendar-import-buffer -;; icalendar-convert-diary-to-ical -> icalendar-export-file -;; Naming scheme: icalendar-.* = user command; icalendar--.* = -;; internal. -;; Added icalendar-export-region. -;; The import and export commands do not clear their target file, -;; but append their results to the target file. -;; I18n-problems fixed -- use calendar-(month|day)-name-array. -;; Fixed problems with export of multi-line diary entries. +;; 0.07 onwards: see lisp/ChangeLog ;; 0.06: Bugfixes regarding icalendar-import-format-*. ;; Fix in icalendar-convert-diary-to-ical -- thanks to Philipp @@ -99,7 +90,7 @@ ;;; Code: -(defconst icalendar-version 0.07 +(defconst icalendar-version 0.08 "Version number of icalendar.el.") ;; ====================================================================== @@ -333,7 +324,7 @@ children." param-name param-value) (when value-string (save-current-buffer - (set-buffer (get-buffer-create " *ical-temp*")) + (set-buffer (get-buffer-create " *icalendar-work*")) (set-buffer-modified-p nil) (erase-buffer) (insert value-string) @@ -529,7 +520,17 @@ Note that this silently ignores seconds." (setq num (1+ num)))) calendar-day-name-array)) ;; Error: - "??")) + nil)) + +(defun icalendar--date-to-isodate (date &optional day-shift) + "Convert DATE to iso-style date. +DATE must be a list of the form (month day year). +If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days." + (let ((mdy (calendar-gregorian-from-absolute + (+ (calendar-absolute-from-gregorian date) + (or day-shift 0))))) + (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy)))) + (defun icalendar--datestring-to-isodate (datestring &optional day-shift) "Convert diary-style DATESTRING to iso-style date. @@ -587,7 +588,7 @@ takes care of european-style." (if (> day 0) (let ((mdy (calendar-gregorian-from-absolute (+ (calendar-absolute-from-gregorian (list month day - year)) + year)) (or day-shift 0))))) (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy))) nil))) @@ -625,22 +626,24 @@ would be \"pm\"." "Export diary file to iCalendar format. All diary entries in the file DIARY-FILENAME are converted to iCalendar format. The result is appended to the file ICAL-FILENAME." - (interactive "FExport diary data from file: + (interactive "FExport diary data from file: Finto iCalendar file: ") (save-current-buffer (set-buffer (find-file diary-filename)) (icalendar-export-region (point-min) (point-max) ical-filename))) (defalias 'icalendar-convert-diary-to-ical 'icalendar-export-file) -(make-obsolete 'icalendar-convert-diary-to-ical 'icalendar-export-file - "icalendar 0.07") +(make-obsolete 'icalendar-convert-diary-to-ical 'icalendar-export-file) ;; User function (defun icalendar-export-region (min max ical-filename) "Export region in diary file to iCalendar format. All diary entries in the region from MIN to MAX in the current buffer are converted to iCalendar format. The result is appended to the file -ICAL-FILENAME." +ICAL-FILENAME. + +Returns non-nil if an error occurred. In this case an error message is +written to the buffer ` *icalendar-errors*'." (interactive "r FExport diary data into iCalendar file: ") (let ((result "") @@ -649,9 +652,14 @@ FExport diary data into iCalendar file: ") (entry-rest "") (header "") (contents) - (oops nil) + (found-error nil) (nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol) "?"))) + ;; prepare buffer with error messages + (save-current-buffer + (set-buffer (get-buffer-create " *icalendar-errors*")) + (erase-buffer)) + ;; here we go (save-excursion (goto-char min) (while (re-search-forward @@ -664,330 +672,366 @@ FExport diary data into iCalendar file: ") (car (current-time)) (cadr (current-time)) (car (cddr (current-time))))) - (setq oops nil) - (cond - ;; anniversaries - ((string-match - (concat nonmarker - "%%(diary-anniversary \\([^)]+\\))\\s-*\\(.*\\)") - entry-main) - (icalendar--dmsg "diary-anniversary %s" entry-main) - (let* ((datetime (substring entry-main (match-beginning 1) - (match-end 1))) - (summary (icalendar--convert-string-for-export - (substring entry-main (match-beginning 2) - (match-end 2)))) - (startisostring (icalendar--datestring-to-isodate - datetime)) - (endisostring (icalendar--datestring-to-isodate - datetime 1))) - (setq contents - (concat "\nDTSTART;VALUE=DATE:" startisostring - "\nDTEND;VALUE=DATE:" endisostring - "\nSUMMARY:" summary - "\nRRULE:FREQ=YEARLY;INTERVAL=1" - ;; the following is redundant, - ;; but korganizer seems to expect this... ;( - ;; and evolution doesn't understand it... :( - ;; so... who is wrong?! - ";BYMONTH=" (substring startisostring 4 6) - ";BYMONTHDAY=" (substring startisostring 6 8) - ))) - (unless (string= entry-rest "") - (setq contents (concat contents "\nDESCRIPTION:" - (icalendar--convert-string-for-export - entry-rest))))) - ;; cyclic events - ;; %%(diary-cyclic ) - ((string-match - (concat nonmarker - "%%(diary-cyclic \\([^ ]+\\) +" - "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)") - entry-main) - (icalendar--dmsg "diary-cyclic %s" entry-main) - (let* ((frequency (substring entry-main (match-beginning 1) - (match-end 1))) - (datetime (substring entry-main (match-beginning 2) - (match-end 2))) - (summary (icalendar--convert-string-for-export - (substring entry-main (match-beginning 3) - (match-end 3)))) - (startisostring (icalendar--datestring-to-isodate - datetime)) - (endisostring (icalendar--datestring-to-isodate - datetime 1))) - (setq contents - (concat "\nDTSTART;VALUE=DATE:" startisostring - "\nDTEND;VALUE=DATE:" endisostring - "\nSUMMARY:" summary - "\nRRULE:FREQ=DAILY;INTERVAL=" frequency - ;; strange: korganizer does not expect - ;; BYSOMETHING here... - ))) - (unless (string= entry-rest "") - (setq contents (concat contents "\nDESCRIPTION:" - (icalendar--convert-string-for-export - entry-rest))))) - ;; diary-date -- FIXME - ((string-match - (concat nonmarker - "%%(diary-date \\([^)]+\\))\\s-*\\(.*\\)") - entry-main) - (icalendar--dmsg "diary-date %s" entry-main) - (setq oops t)) - ;; float events -- FIXME - ((string-match - (concat nonmarker - "%%(diary-float \\([^)]+\\))\\s-*\\(.*\\)") - entry-main) - (icalendar--dmsg "diary-float %s" entry-main) - (setq oops t)) - ;; block events - ((string-match - (concat nonmarker - "%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\) +" - "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)") - entry-main) - (icalendar--dmsg "diary-block %s" entry-main) - (let* ((startstring (substring entry-main (match-beginning 1) - (match-end 1))) - (endstring (substring entry-main (match-beginning 2) - (match-end 2))) - (summary (icalendar--convert-string-for-export - (substring entry-main (match-beginning 3) - (match-end 3)))) - (startisostring (icalendar--datestring-to-isodate - startstring)) - (endisostring (icalendar--datestring-to-isodate - endstring 1))) - (setq contents - (concat "\nDTSTART;VALUE=DATE:" startisostring - "\nDTEND;VALUE=DATE:" endisostring - "\nSUMMARY:" summary - )) - (unless (string= entry-rest "") - (setq contents (concat contents "\nDESCRIPTION:" - (icalendar--convert-string-for-export - entry-rest)))))) - ;; other sexp diary entries -- FIXME - ((string-match - (concat nonmarker - "%%(\\([^)]+\\))\\s-*\\(.*\\)") - entry-main) - (icalendar--dmsg "diary-sexp %s" entry-main) - (setq oops t)) - ;; weekly by day - ;; Monday 8:30 Team meeting - ((and (string-match - (concat nonmarker - "\\([a-z]+\\)\\s-+" - "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" - "\\(-0?" - "\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" - "\\)?" - "\\s-*\\(.*\\)$") - entry-main) - (icalendar--get-weekday-abbrev - (substring entry-main (match-beginning 1) (match-end 1)))) - (icalendar--dmsg "weekly %s" entry-main) - (let* ((day (icalendar--get-weekday-abbrev - (substring entry-main (match-beginning 1) - (match-end 1)))) - (starttimestring (icalendar--diarytime-to-isotime - (if (match-beginning 3) - (substring entry-main - (match-beginning 3) - (match-end 3)) - nil) - (if (match-beginning 4) - (substring entry-main - (match-beginning 4) - (match-end 4)) - nil))) - (endtimestring (icalendar--diarytime-to-isotime - (if (match-beginning 6) - (substring entry-main - (match-beginning 6) - (match-end 6)) - nil) - (if (match-beginning 7) - (substring entry-main - (match-beginning 7) - (match-end 7)) - nil))) - (summary (icalendar--convert-string-for-export - (substring entry-main (match-beginning 8) - (match-end 8))))) - (when starttimestring - (unless endtimestring - (let ((time (read (icalendar--rris "^T0?" "" - starttimestring)))) - (setq endtimestring (format "T%06d" (+ 10000 time)))))) - (setq contents - (concat "\nDTSTART" - (if starttimestring "" ";VALUE=DATE") - ":19000101" ;; FIXME? Probability that this - ;; is the right day is 1/7 - (or starttimestring "") - "\nDTEND" - (if endtimestring "" ";VALUE=DATE") - ":19000101" ;; FIXME? - (or endtimestring "") - "\nSUMMARY:" summary - "\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=" day - ))) - (unless (string= entry-rest "") - (setq contents (concat contents "\nDESCRIPTION:" - (icalendar--convert-string-for-export - entry-rest))))) - ;; yearly by day - ;; 1 May Tag der Arbeit - ((string-match - (concat nonmarker - (if european-calendar-style - "0?\\([1-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+" - "\\([a-z]+\\)\\s-+0?\\([1-9]+[0-9]?\\)\\s-+") - "\\*?\\s-*" - "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" - "\\(" - "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" - "\\)?" - "\\s-*\\([^0-9]+.*\\)$" ; must not match years - ) - entry-main) - (icalendar--dmsg "yearly %s" entry-main) - (let* ((daypos (if european-calendar-style 1 2)) - (monpos (if european-calendar-style 2 1)) - (day (read (substring entry-main (match-beginning daypos) - (match-end daypos)))) - (month (icalendar--get-month-number - (substring entry-main (match-beginning monpos) - (match-end monpos)))) - (starttimestring (icalendar--diarytime-to-isotime - (if (match-beginning 4) - (substring entry-main - (match-beginning 4) - (match-end 4)) - nil) - (if (match-beginning 5) - (substring entry-main - (match-beginning 5) - (match-end 5)) - nil))) - (endtimestring (icalendar--diarytime-to-isotime - (if (match-beginning 7) - (substring entry-main - (match-beginning 7) - (match-end 7)) - nil) - (if (match-beginning 8) - (substring entry-main - (match-beginning 8) - (match-end 8)) - nil))) - (summary (icalendar--convert-string-for-export - (substring entry-main (match-beginning 9) - (match-end 9))))) - (when starttimestring - (unless endtimestring - (let ((time (read (icalendar--rris "^T0?" "" - starttimestring)))) - (setq endtimestring (format "T%06d" (+ 10000 time)))))) - (setq contents - (concat "\nDTSTART" - (if starttimestring "" ";VALUE=DATE") - (format ":1900%02d%02d" month day) - (or starttimestring "") - "\nDTEND" - (if endtimestring "" ";VALUE=DATE") - (format ":1900%02d%02d" month day) - (or endtimestring "") - "\nSUMMARY:" summary - "\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=" - (format "%2d" month) - ";BYMONTHDAY=" - (format "%2d" day) - ))) - (unless (string= entry-rest "") - (setq contents (concat contents "\nDESCRIPTION:" - (icalendar--convert-string-for-export - entry-rest))))) - ;; "ordinary" events, start and end time given - ;; 1 Feb 2003 Hs Hochzeitsfeier, Dreieich - ((string-match - (concat nonmarker - "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-+" - "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" - "\\(" - "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" - "\\)?" - "\\s-*\\(.*\\)") - entry-main) - (icalendar--dmsg "ordinary %s" entry-main) - (let* ((datestring (icalendar--datestring-to-isodate - (substring entry-main (match-beginning 1) - (match-end 1)))) - (starttimestring (icalendar--diarytime-to-isotime - (if (match-beginning 3) - (substring entry-main - (match-beginning 3) - (match-end 3)) - nil) - (if (match-beginning 4) - (substring entry-main - (match-beginning 4) - (match-end 4)) - nil))) - (endtimestring (icalendar--diarytime-to-isotime - (if (match-beginning 6) - (substring entry-main - (match-beginning 6) - (match-end 6)) - nil) - (if (match-beginning 7) - (substring entry-main - (match-beginning 7) - (match-end 7)) - nil))) - (summary (icalendar--convert-string-for-export - (substring entry-main (match-beginning 8) - (match-end 8))))) - (when starttimestring - (unless endtimestring - (let ((time (read (icalendar--rris "^T0?" "" - starttimestring)))) - (setq endtimestring (format "T%06d" (+ 10000 time)))))) - (setq contents (format - "\nDTSTART%s:%s%s\nDTEND%s:%s%s\nSUMMARY:%s" - (if starttimestring "" ";VALUE=DATE") - datestring - (or starttimestring "") - (if endtimestring "" - ";VALUE=DATE") - datestring - (or endtimestring "") - summary)) - (unless (string= entry-rest "") - (setq contents (concat contents "\nDESCRIPTION:" - (icalendar--convert-string-for-export - entry-rest)))))) - ;; everything else - (t - ;; Oops! what's that? - (setq oops t))) - (if oops - (message "Cannot export entry on line %d" - (count-lines (point-min) (point))) - (setq result (concat result header contents "\nEND:VEVENT")))) + (condition-case error-val + (progn + (cond + ;; anniversaries + ((string-match + (concat nonmarker + "%%(diary-anniversary \\([^)]+\\))\\s-*\\(.*\\)") + entry-main) + (icalendar--dmsg "diary-anniversary %s" entry-main) + (let* ((datetime (substring entry-main (match-beginning 1) + (match-end 1))) + (summary (icalendar--convert-string-for-export + (substring entry-main (match-beginning 2) + (match-end 2)))) + (startisostring (icalendar--datestring-to-isodate + datetime)) + (endisostring (icalendar--datestring-to-isodate + datetime 1))) + (setq contents + (concat "\nDTSTART;VALUE=DATE:" startisostring + "\nDTEND;VALUE=DATE:" endisostring + "\nSUMMARY:" summary + "\nRRULE:FREQ=YEARLY;INTERVAL=1" + ;; the following is redundant, + ;; but korganizer seems to expect this... ;( + ;; and evolution doesn't understand it... :( + ;; so... who is wrong?! + ";BYMONTH=" (substring startisostring 4 6) + ";BYMONTHDAY=" (substring startisostring 6 8) + ))) + (unless (string= entry-rest "") + (setq contents (concat contents "\nDESCRIPTION:" + (icalendar--convert-string-for-export + entry-rest))))) + ;; cyclic events + ;; %%(diary-cyclic ) + ((string-match + (concat nonmarker + "%%(diary-cyclic \\([^ ]+\\) +" + "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)") + entry-main) + (icalendar--dmsg "diary-cyclic %s" entry-main) + (let* ((frequency (substring entry-main (match-beginning 1) + (match-end 1))) + (datetime (substring entry-main (match-beginning 2) + (match-end 2))) + (summary (icalendar--convert-string-for-export + (substring entry-main (match-beginning 3) + (match-end 3)))) + (startisostring (icalendar--datestring-to-isodate + datetime)) + (endisostring (icalendar--datestring-to-isodate + datetime 1))) + (setq contents + (concat "\nDTSTART;VALUE=DATE:" startisostring + "\nDTEND;VALUE=DATE:" endisostring + "\nSUMMARY:" summary + "\nRRULE:FREQ=DAILY;INTERVAL=" frequency + ;; strange: korganizer does not expect + ;; BYSOMETHING here... + ))) + (unless (string= entry-rest "") + (setq contents (concat contents "\nDESCRIPTION:" + (icalendar--convert-string-for-export + entry-rest))))) + ;; diary-date -- FIXME + ((string-match + (concat nonmarker + "%%(diary-date \\([^)]+\\))\\s-*\\(.*\\)") + entry-main) + (icalendar--dmsg "diary-date %s" entry-main) + (error "`diary-date' is not supported yet")) + ;; float events -- FIXME + ((string-match + (concat nonmarker + "%%(diary-float \\([^)]+\\))\\s-*\\(.*\\)") + entry-main) + (icalendar--dmsg "diary-float %s" entry-main) + (error "`diary-float' is not supported yet")) + ;; block events + ((string-match + (concat nonmarker + "%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\) +" + "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)") + entry-main) + (icalendar--dmsg "diary-block %s" entry-main) + (let* ((startstring (substring entry-main (match-beginning 1) + (match-end 1))) + (endstring (substring entry-main (match-beginning 2) + (match-end 2))) + (summary (icalendar--convert-string-for-export + (substring entry-main (match-beginning 3) + (match-end 3)))) + (startisostring (icalendar--datestring-to-isodate + startstring)) + (endisostring (icalendar--datestring-to-isodate + endstring 1))) + (setq contents + (concat "\nDTSTART;VALUE=DATE:" startisostring + "\nDTEND;VALUE=DATE:" endisostring + "\nSUMMARY:" summary + )) + (unless (string= entry-rest "") + (setq contents (concat contents "\nDESCRIPTION:" + (icalendar--convert-string-for-export + entry-rest)))))) + ;; other sexp diary entries -- FIXME + ((string-match + (concat nonmarker + "%%(\\([^)]+\\))\\s-*\\(.*\\)") + entry-main) + (icalendar--dmsg "diary-sexp %s" entry-main) + (error "sexp-entries are not supported yet")) + ;; weekly by day + ;; Monday 8:30 Team meeting + ((and (string-match + (concat nonmarker + "\\([a-z]+\\)\\s-+" + "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" + "\\(-0?" + "\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" + "\\)?" + "\\s-*\\(.*\\)$") + entry-main) + (icalendar--get-weekday-abbrev + (substring entry-main (match-beginning 1) (match-end 1)))) + (icalendar--dmsg "weekly %s" entry-main) + (let* ((day (icalendar--get-weekday-abbrev + (substring entry-main (match-beginning 1) + (match-end 1)))) + (starttimestring (icalendar--diarytime-to-isotime + (if (match-beginning 3) + (substring entry-main + (match-beginning 3) + (match-end 3)) + nil) + (if (match-beginning 4) + (substring entry-main + (match-beginning 4) + (match-end 4)) + nil))) + (endtimestring (icalendar--diarytime-to-isotime + (if (match-beginning 6) + (substring entry-main + (match-beginning 6) + (match-end 6)) + nil) + (if (match-beginning 7) + (substring entry-main + (match-beginning 7) + (match-end 7)) + nil))) + (summary (icalendar--convert-string-for-export + (substring entry-main (match-beginning 8) + (match-end 8))))) + (when starttimestring + (unless endtimestring + (let ((time (read (icalendar--rris "^T0?" "" + starttimestring)))) + (setq endtimestring (format "T%06d" (+ 10000 time)))))) + (setq contents + (concat "\nDTSTART;" + (if starttimestring + "VALUE=DATE-TIME:" + "VALUE=DATE:") + ;; find the correct week day, + ;; 1st january 2000 was a saturday + (format + "200001%02d" + (+ (icalendar--get-weekday-number day) 2)) + (or starttimestring "") + "\nDTEND;" + (if endtimestring + "VALUE=DATE-TIME:" + "VALUE=DATE:") + (format + "200001%02d" + ;; end is non-inclusive! + (+ (icalendar--get-weekday-number day) + (if endtimestring 2 3))) + (or endtimestring "") + "\nSUMMARY:" summary + "\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=" day + ))) + (unless (string= entry-rest "") + (setq contents (concat contents "\nDESCRIPTION:" + (icalendar--convert-string-for-export + entry-rest))))) + ;; yearly by day + ;; 1 May Tag der Arbeit + ((string-match + (concat nonmarker + (if european-calendar-style + "0?\\([1-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+" + "\\([a-z]+\\)\\s-+0?\\([1-9]+[0-9]?\\)\\s-+") + "\\*?\\s-*" + "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" + "\\(" + "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" + "\\)?" + "\\s-*\\([^0-9]+.*\\)$" ; must not match years + ) + entry-main) + (icalendar--dmsg "yearly %s" entry-main) + (let* ((daypos (if european-calendar-style 1 2)) + (monpos (if european-calendar-style 2 1)) + (day (read (substring entry-main (match-beginning daypos) + (match-end daypos)))) + (month (icalendar--get-month-number + (substring entry-main (match-beginning monpos) + (match-end monpos)))) + (starttimestring (icalendar--diarytime-to-isotime + (if (match-beginning 4) + (substring entry-main + (match-beginning 4) + (match-end 4)) + nil) + (if (match-beginning 5) + (substring entry-main + (match-beginning 5) + (match-end 5)) + nil))) + (endtimestring (icalendar--diarytime-to-isotime + (if (match-beginning 7) + (substring entry-main + (match-beginning 7) + (match-end 7)) + nil) + (if (match-beginning 8) + (substring entry-main + (match-beginning 8) + (match-end 8)) + nil))) + (summary (icalendar--convert-string-for-export + (substring entry-main (match-beginning 9) + (match-end 9))))) + (when starttimestring + (unless endtimestring + (let ((time (read (icalendar--rris "^T0?" "" + starttimestring)))) + (setq endtimestring (format "T%06d" (+ 10000 time)))))) + (setq contents + (concat "\nDTSTART;" + (if starttimestring "VALUE=DATE-TIME:" + "VALUE=DATE:") + (format "1900%02d%02d" month day) + (or starttimestring "") + "\nDTEND;" + (if endtimestring "VALUE=DATE-TIME:" + "VALUE=DATE:") + ;; end is not included! shift by one day + (icalendar--date-to-isodate + (list month day 1900) (if endtimestring 0 1)) + (or endtimestring "") + "\nSUMMARY:" + summary + "\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=" + (format "%2d" month) + ";BYMONTHDAY=" + (format "%2d" day) + ))) + (unless (string= entry-rest "") + (setq contents (concat contents "\nDESCRIPTION:" + (icalendar--convert-string-for-export + entry-rest))))) + ;; "ordinary" events, start and end time given + ;; 1 Feb 2003 Hs Hochzeitsfeier, Dreieich + ((string-match + (concat nonmarker + "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-+" + "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" + "\\(" + "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" + "\\)?" + "\\s-*\\(.*\\)") + entry-main) + (icalendar--dmsg "ordinary %s" entry-main) + (let* ((startdatestring (icalendar--datestring-to-isodate + (substring entry-main + (match-beginning 1) + (match-end 1)))) + (starttimestring (icalendar--diarytime-to-isotime + (if (match-beginning 3) + (substring entry-main + (match-beginning 3) + (match-end 3)) + nil) + (if (match-beginning 4) + (substring entry-main + (match-beginning 4) + (match-end 4)) + nil))) + (endtimestring (icalendar--diarytime-to-isotime + (if (match-beginning 6) + (substring entry-main + (match-beginning 6) + (match-end 6)) + nil) + (if (match-beginning 7) + (substring entry-main + (match-beginning 7) + (match-end 7)) + nil))) + (summary (icalendar--convert-string-for-export + (substring entry-main (match-beginning 8) + (match-end 8))))) + (unless startdatestring + (error "Could not parse date")) + (when starttimestring + (unless endtimestring + (let ((time (read (icalendar--rris "^T0?" "" + starttimestring)))) + (setq endtimestring (format "T%06d" (+ 10000 time)))))) + (setq contents (concat + "\nDTSTART;" + (if starttimestring "VALUE=DATE-TIME:" + "VALUE=DATE:") + startdatestring + (or starttimestring "") + "\nDTEND;" + (if endtimestring "VALUE=DATE-TIME:" + "VALUE=DATE:") + (icalendar--datestring-to-isodate + (substring entry-main + (match-beginning 1) + (match-end 1)) + (if endtimestring 0 1)) + (or endtimestring "") + "\nSUMMARY:" + summary)) + ;; could not parse the date + (unless (string= entry-rest "") + (setq contents (concat contents "\nDESCRIPTION:" + (icalendar--convert-string-for-export + entry-rest)))))) + ;; everything else + (t + ;; Oops! what's that? + (error "Could not parse entry"))) + (setq result (concat result header contents "\nEND:VEVENT"))) + ;; handle errors + (error + (setq found-error t) + (save-current-buffer + (set-buffer (get-buffer-create " *icalendar-errors*")) + (insert (format "Error in line %d -- %s: `%s'\n" + (count-lines (point-min) (point)) + (cadr error-val) + entry-main)))))) + ;; we're done, insert everything into the file (let ((coding-system-for-write 'utf8)) (set-buffer (find-file ical-filename)) (goto-char (point-max)) (insert "BEGIN:VCALENDAR") - (insert "\nPRODID:-//Emacs//NONSGML icalendar.el//EN") + (insert "\nPRODID:-//Emacs//NONSGML icalendar.el//EN") (insert "\nVERSION:2.0") (insert result) - (insert "\nEND:VCALENDAR\n"))))) + (insert "\nEND:VCALENDAR\n"))) + found-error)) ;; ====================================================================== ;; Import -- convert icalendar to emacs-diary @@ -1001,7 +1045,7 @@ Argument ICAL-FILENAME output iCalendar file. Argument DIARY-FILENAME input `diary-file'. Optional argument NON-MARKING determines whether events are created as non-marking or not." - (interactive "fImport iCalendar data from file: + (interactive "fImport iCalendar data from file: Finto diary file: p") ;; clean up the diary file @@ -1062,9 +1106,7 @@ reading, parsing, or converting iCalendar data!" "Current buffer does not contain icalendar contents!")))) (defalias 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer) - -(make-obsolete 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer - "icalendar 0.07") +(make-obsolete 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer) ;; ====================================================================== ;; private area @@ -1184,7 +1226,7 @@ written into the buffer ` *icalendar-errors*'." (setq diary-string (format "%s %s%s%s" (aref calendar-day-name-array - weekday) + weekday) start-t (if end-t "-" "") (or end-t ""))) ;; FIXME!!!! From fba8240fd69132711e292c839846b1722108ad63 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 2 Nov 2004 01:15:04 +0000 Subject: [PATCH 058/146] *** empty log message *** --- lisp/ChangeLog | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3bdd1fefca1..7b9b92ee6ce 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,24 @@ +2004-11-02 Ulf Jasper + + * calendar/icalendar.el (icalendar-version): Increase to 0.08. + (icalendar--split-value): Change name of work buffer. + (icalendar--get-weekday-abbrev): Return nil on error. + (icalendar--date-to-isodate): New function. + (icalendar-convert-diary-to-ical) + (icalendar-extract-ical-from-buffer): Use only two args for + make-obsolete (XEmacs compatibility). + (icalendar-export-file, icalendar-import-file): Blank at end of + prompt. + (icalendar-export-region): Doc fix. + If error, return non-nil and write errors to a buffer. + Use correct weekday for weekly recurring events. + Check whether date has been parsed for ordinary events. + Make weekly events start in the year 2000. + DTEND is non-inclusive, shift end date by one day if + necessary (not for entries that have date and time). + Rename local let variables: oops -> found-error, datestring -> + startdatestring. + 2004-11-02 Kim F. Storm * files.el (set-auto-mode-0): Don't rely on dynamic binding of From 572a3cc2664adea7b5a3303b04b57fe1ba5b4641 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Tue, 2 Nov 2004 07:33:51 +0000 Subject: [PATCH 059/146] * configure.in (HAVE_GTK_FILE_CHOOSER, $HAVE_GTK_FILE_SELECTION): New tests for new and old GTK file dialogs. * configure: Rebuild --- ChangeLog | 6 ++ configure | 216 +++++++++++++++++++++++++++++++++++++++++++++++++++ configure.in | 15 ++++ 3 files changed, 237 insertions(+) diff --git a/ChangeLog b/ChangeLog index f215921b6e6..1f07f82dfc0 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2004-11-02 Jan Dj,Ad(Brv + + * configure.in (HAVE_GTK_FILE_CHOOSER, $HAVE_GTK_FILE_SELECTION): New + tests for new and old GTK file dialogs. + * configure: Rebuild + 2004-10-20 Jan Dj,Ad(Brv * configure.in (HAVE_PERSONALITY_LINUX32): New test if PER_LINUX32 diff --git a/configure b/configure index 316babd4d3c..d966346868d 100755 --- a/configure +++ b/configure @@ -9906,6 +9906,222 @@ done cat >>confdefs.h <<\_ACEOF #define HAVE_GTK_MULTIDISPLAY 1 +_ACEOF + + fi + HAVE_GTK_FILE_SELECTION=no + +for ac_func in gtk_file_selection_new +do +as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` +echo "$as_me:$LINENO: checking for $ac_func" >&5 +echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 +if eval "test \"\${$as_ac_var+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +/* Define $ac_func to an innocuous variant, in case declares $ac_func. + For example, HP-UX 11i declares gettimeofday. */ +#define $ac_func innocuous_$ac_func + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $ac_func (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef $ac_func + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char $ac_func (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_$ac_func) || defined (__stub___$ac_func) +choke me +#else +char (*f) () = $ac_func; +#endif +#ifdef __cplusplus +} +#endif + +int +main () +{ +return f != $ac_func; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + eval "$as_ac_var=yes" +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +eval "$as_ac_var=no" +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 +if test `eval echo '${'$as_ac_var'}'` = yes; then + cat >>confdefs.h <<_ACEOF +#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + HAVE_GTK_FILE_SELECTION=yes +fi +done + + + HAVE_GTK_FILE_CHOOSER=no + +for ac_func in gtk_file_chooser_dialog_new +do +as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh` +echo "$as_me:$LINENO: checking for $ac_func" >&5 +echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6 +if eval "test \"\${$as_ac_var+set}\" = set"; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +/* Define $ac_func to an innocuous variant, in case declares $ac_func. + For example, HP-UX 11i declares gettimeofday. */ +#define $ac_func innocuous_$ac_func + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $ac_func (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef $ac_func + +/* Override any gcc2 internal prototype to avoid an error. */ +#ifdef __cplusplus +extern "C" +{ +#endif +/* We use char because int might match the return type of a gcc2 + builtin and then its argument prototype would still apply. */ +char $ac_func (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined (__stub_$ac_func) || defined (__stub___$ac_func) +choke me +#else +char (*f) () = $ac_func; +#endif +#ifdef __cplusplus +} +#endif + +int +main () +{ +return f != $ac_func; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + eval "$as_ac_var=yes" +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +eval "$as_ac_var=no" +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5 +echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6 +if test `eval echo '${'$as_ac_var'}'` = yes; then + cat >>confdefs.h <<_ACEOF +#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + HAVE_GTK_FILE_CHOOSER=yes +fi +done + + + if test "$HAVE_GTK_FILE_SELECTION" = yes \ + && test "$HAVE_GTK_FILE_CHOOSER" = yes; then + +cat >>confdefs.h <<\_ACEOF +#define HAVE_GTK_FILE_BOTH 1 _ACEOF fi diff --git a/configure.in b/configure.in index 48ea02a351f..1f49cc536aa 100644 --- a/configure.in +++ b/configure.in @@ -1977,6 +1977,21 @@ if test "${with_gtk}" = "yes" || test "$USE_X_TOOLKIT" = "gtk"; then AC_DEFINE(HAVE_GTK_MULTIDISPLAY, 1, [Define to 1 if GTK can handle more than one display.]) fi + dnl Check if we have the old file selection dialog. + dnl If gdk_display_open exists, assume all others are there also. + HAVE_GTK_FILE_SELECTION=no + AC_CHECK_FUNCS(gtk_file_selection_new, HAVE_GTK_FILE_SELECTION=yes) + + dnl Check if we have the new file chooser dialog + dnl If gdk_display_open exists, assume all others are there also. + HAVE_GTK_FILE_CHOOSER=no + AC_CHECK_FUNCS(gtk_file_chooser_dialog_new, HAVE_GTK_FILE_CHOOSER=yes) + + if test "$HAVE_GTK_FILE_SELECTION" = yes \ + && test "$HAVE_GTK_FILE_CHOOSER" = yes; then + AC_DEFINE(HAVE_GTK_FILE_BOTH, 1, + [Define to 1 if GTK has both file selection and chooser dialog.]) + fi fi dnl Do not put whitespace before the #include statements below. From 2a00cdb499b95c6befaac75104fce2cf78b69b9e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Tue, 2 Nov 2004 07:34:28 +0000 Subject: [PATCH 060/146] * config.in: Rebuild (added HAVE_GTK_FILE_*). --- src/ChangeLog | 4 ++++ src/config.in | 9 +++++++++ 2 files changed, 13 insertions(+) diff --git a/src/ChangeLog b/src/ChangeLog index 527b16382da..18704954db0 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2004-11-02 Jan Dj,Ad(Brv + + * config.in: Rebuild (added HAVE_GTK_FILE_*). + 2004-11-01 Kim F. Storm * process.c (connect_wait_mask, num_pending_connects): Only diff --git a/src/config.in b/src/config.in index 136f4ecd55d..0fb9126b470 100644 --- a/src/config.in +++ b/src/config.in @@ -217,6 +217,15 @@ Boston, MA 02111-1307, USA. */ /* Define to 1 if using GTK. */ #undef HAVE_GTK +/* Define to 1 if GTK has both file selection and chooser dialog. */ +#undef HAVE_GTK_FILE_BOTH + +/* Define to 1 if you have the `gtk_file_chooser_dialog_new' function. */ +#undef HAVE_GTK_FILE_CHOOSER_DIALOG_NEW + +/* Define to 1 if you have the `gtk_file_selection_new' function. */ +#undef HAVE_GTK_FILE_SELECTION_NEW + /* Define to 1 if GTK can handle more than one display. */ #undef HAVE_GTK_MULTIDISPLAY From 95ec60bcbf3f89bd6c72c989a3510da8c0b96f9a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Tue, 2 Nov 2004 07:56:08 +0000 Subject: [PATCH 061/146] * toolbar/tool-bar.el (tool-bar-setup): Tool bar item dired uses icon diropen. New tool bar item find-file-existing uses icon open. * diropen.pbm diropen.xpm: New files. --- lisp/toolbar/diropen.pbm | Bin 0 -> 81 bytes lisp/toolbar/diropen.xpm | 215 +++++++++++++++++++++++++++++++++++++++ lisp/toolbar/tool-bar.el | 3 +- 3 files changed, 217 insertions(+), 1 deletion(-) create mode 100644 lisp/toolbar/diropen.pbm create mode 100644 lisp/toolbar/diropen.xpm diff --git a/lisp/toolbar/diropen.pbm b/lisp/toolbar/diropen.pbm new file mode 100644 index 0000000000000000000000000000000000000000..0f1996db78c8f6d791856dd62509c7186d9104d1 GIT binary patch literal 81 zcmWGA;W9E&Ff!p{fC2jk1_uWaYDjEouz%3NI01VMS#{{Yhpq5=4S97+HH literal 0 HcmV?d00001 diff --git a/lisp/toolbar/diropen.xpm b/lisp/toolbar/diropen.xpm new file mode 100644 index 00000000000..bdc0b19d7dd --- /dev/null +++ b/lisp/toolbar/diropen.xpm @@ -0,0 +1,215 @@ +/* XPM */ +static char * diropen_xpm[] = { +"24 24 188 2", +" c None", +". c #000000", +"+ c #010100", +"@ c #B5B8A5", +"# c #E4E7D2", +"$ c #878A76", +"% c #33342B", +"& c #0B0B0B", +"* c #E2E5CF", +"= c #CFD4AF", +"- c #CED3AE", +"; c #B2B696", +"> c #2D2D25", +", c #23241D", +"' c #9D9F90", +") c #C6CAA6", +"! c #C4C9A5", +"~ c #C6CBA7", +"{ c #C7CCA8", +"] c #C9CEA9", +"^ c #555847", +"/ c #1A1B15", +"( c #20201A", +"_ c #D4D6C2", +": c #BEC2A0", +"< c #B3B896", +"[ c #B0B595", +"} c #B3B797", +"| c #B6BB99", +"1 c #BBC09E", +"2 c #BCC19F", +"3 c #81856C", +"4 c #3E3F32", +"5 c #010101", +"6 c #DADDC8", +"7 c #AFB494", +"8 c #AAAF8F", +"9 c #A3A789", +"0 c #A6AA8B", +"a c #A9AD8E", +"b c #A7AB8D", +"c c #A4A88A", +"d c #A1A588", +"e c #AAAD96", +"f c #B3B5A5", +"g c #B8BBAA", +"h c #BABCAB", +"i c #40413B", +"j c #CACDBB", +"k c #BABDA8", +"l c #0C0C09", +"m c #DDDFCB", +"n c #969B7E", +"o c #9DA286", +"p c #95987C", +"q c #96997E", +"r c #9A9D81", +"s c #999D80", +"t c #9DA184", +"u c #A5AA8B", +"v c #A4A98A", +"w c #A3A889", +"x c #A2A588", +"y c #33352B", +"z c #9B9E83", +"A c #898D74", +"B c #D8DBC9", +"C c #84866E", +"D c #7D8169", +"E c #151612", +"F c #D7DAC9", +"G c #797D67", +"H c #3D3F34", +"I c #E0E0D9", +"J c #EBEDDD", +"K c #E8EBD9", +"L c #D8DBCA", +"M c #1A1A18", +"N c #0A0A09", +"O c #6E7067", +"P c #8D8F84", +"Q c #4A4B45", +"R c #2C2D29", +"S c #4B4C46", +"T c #E7EAD8", +"U c #E3E6D4", +"V c #DEE1D0", +"W c #DADCCC", +"X c #DADCD1", +"Y c #2B2C28", +"Z c #D7DAC6", +"` c #6F735E", +" . c #0D0D0D", +".. c #F4F4EC", +"+. c #606251", +"@. c #92957B", +"#. c #4A4C3E", +"$. c #434438", +"%. c #CACFAB", +"&. c #C6CBA8", +"*. c #C2C6A4", +"=. c #ABB091", +"-. c #23251E", +";. c #494B3D", +">. c #DCDCD4", +",. c #EAECDD", +"'. c #CDD2AD", +"). c #20201B", +"!. c #1C1C17", +"~. c #A4A88B", +"{. c #414337", +"]. c #BABF9D", +"^. c #B5B999", +"/. c #81836C", +"(. c #070806", +"_. c #D5D8C4", +":. c #161616", +"<. c #F2F2EA", +"[. c #CACFAA", +"}. c #050504", +"|. c #3C3D32", +"1. c #C9CEAA", +"2. c #C8CDA9", +"3. c #BFC4A2", +"4. c #3E4035", +"5. c #BCC09F", +"6. c #B6BB9A", +"7. c #B0B494", +"8. c #9DA185", +"9. c #535445", +"0. c #B6B8A7", +"a. c #747470", +"b. c #ECECE2", +"c. c #C3C8A5", +"d. c #C2C7A4", +"e. c #393B30", +"f. c #BFC4A1", +"g. c #BDC2A0", +"h. c #C0C5A2", +"i. c #3A3B31", +"j. c #A9AD8F", +"k. c #A3A78A", +"l. c #80836D", +"m. c #020201", +"n. c #A6A998", +"o. c #B8BC9B", +"p. c #1B1C17", +"q. c #181814", +"r. c #AFB394", +"s. c #ACB091", +"t. c #878A72", +"u. c #9B9F83", +"v. c #9A9D82", +"w. c #8A8D75", +"x. c #4F5243", +"y. c #070705", +"z. c #9E9F91", +"A. c #E5E6DA", +"B. c #ADB192", +"C. c #A6AA8C", +"D. c #A5A98C", +"E. c #4B4D3F", +"F. c #70735F", +"G. c #9FA286", +"H. c #999D81", +"I. c #35362D", +"J. c #2D2E26", +"K. c #8A8D74", +"L. c #71735F", +"M. c #080908", +"N. c #E3E5D9", +"O. c #C0C3AF", +"P. c #94987C", +"Q. c #8F9379", +"R. c #8B8F75", +"S. c #8A8E74", +"T. c #888C73", +"U. c #7D816A", +"V. c #0E0F0C", +"W. c #3E4034", +"X. c #4E5042", +"Y. c #282922", +"Z. c #121310", +"`. c #24251F", +" + c #71745F", +".+ c #6A6D59", +"++ c #434538", +"@+ c #080907", +" ", +" ", +" ", +" . . . . . . . ", +" + @ # # # # # $ % ", +" & * = = = - - ; > ", +", ' * ) ! ~ { ] ] ^ / . . ", +"( _ : < [ } | 1 2 3 4 5 . . . . . . . ", +", 6 7 8 9 0 8 a b c d e f g h . i j k . ", +"l m n o p q r s q t u v w x 9 . y z A . ", +". B C D E . . . . . . . . . . . . . . . 5 5 ", +". F G H I J K K L M N O P Q R . S T U V W X Y ", +". Z ` ...= = = +.. @.= = = #.. $.%.&.*.1 =.-. ", +". Z ;.>.,.'.- - ).!.'.'.'.'.~.. {.&.*.].^./.(. ", +". _.:.<.%.[.%.[.}.|.1.{ 2.2.3.. 4.5.6.7.8.9.l ", +". 0.a.b.c.d.d.*.}.e.f.g.h.g.} . i.[ j.k.l.m. ", +". n.>.o.o.^.} } p.q.r.r.r.s.t.. % u.v.w.x.y. ", +". z.A.B.j.C.D.k.E.. F.G.u.H.I.. J.K.K.L.M. ", +". N.O.P.Q.R.S.T.U.V.}.W.X.Y.Z.. `. +.+++@+ ", +" . . . . . . . . . . . . . . . . . . }. ", +" ", +" ", +" ", +" "}; diff --git a/lisp/toolbar/tool-bar.el b/lisp/toolbar/tool-bar.el index bf1c229ccb9..f22d84cafaf 100644 --- a/lisp/toolbar/tool-bar.el +++ b/lisp/toolbar/tool-bar.el @@ -223,7 +223,8 @@ MAP must contain appropriate binding for `[menu-bar]' which holds a keymap." ;; might inadvertently click that button. ;;(tool-bar-add-item-from-menu 'save-buffers-kill-emacs "exit") (tool-bar-add-item-from-menu 'find-file "new") - (tool-bar-add-item-from-menu 'dired "open") + (tool-bar-add-item-from-menu 'find-file-existing "open") + (tool-bar-add-item-from-menu 'dired "diropen") (tool-bar-add-item-from-menu 'kill-this-buffer "close") (tool-bar-add-item-from-menu 'save-buffer "save" nil :visible '(or buffer-file-name From 46bfc73bed2e2b6b3cdfff43f82c6705fb89355c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Tue, 2 Nov 2004 07:57:53 +0000 Subject: [PATCH 062/146] * files.el (find-file-existing): New function. * menu-bar.el (menu-bar-files-menu): Make "Open File..." call find-file-existing. Add "New File..." that calls find-file. * dired.el (dired-read-dir-and-switches): Call read-driectory-name instead of read-file-name. --- lisp/ChangeLog | 15 +++++++++++++++ lisp/dired.el | 2 +- lisp/files.el | 8 ++++++++ lisp/menu-bar.el | 9 +++++++-- 4 files changed, 31 insertions(+), 3 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7b9b92ee6ce..853daf41a26 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,18 @@ +2004-11-02 Jan Dj,Ad(Brv + + * files.el (find-file-existing): New function. + + * menu-bar.el (menu-bar-files-menu): Make "Open File..." call + find-file-existing. Add "New File..." that calls find-file. + + * diropen.pbm diropen.xpm: New files. + + * toolbar/tool-bar.el (tool-bar-setup): Tool bar item dired uses + icon diropen. New tool bar item find-file-existing uses icon open. + + * dired.el (dired-read-dir-and-switches): Call read-driectory-name + instead of read-file-name. + 2004-11-02 Ulf Jasper * calendar/icalendar.el (icalendar-version): Increase to 0.08. diff --git a/lisp/dired.el b/lisp/dired.el index 96b2905337e..c0fc33729c2 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -546,7 +546,7 @@ Optional third argument FILTER, if non-nil, is a function to select (if current-prefix-arg (read-string "Dired listing switches: " dired-listing-switches)) - (read-file-name (format "Dired %s(directory): " str) + (read-directory-name (format "Dired %s(directory): " str) nil default-directory nil)))) ;;;###autoload (define-key ctl-x-map "d" 'dired) diff --git a/lisp/files.el b/lisp/files.el index f10281a0d10..888f9dc81e9 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -977,6 +977,14 @@ expand wildcards (if any) and visit multiple files." (mapcar 'switch-to-buffer (cdr value))) (switch-to-buffer-other-frame value)))) +(defun find-file-existing (filename &optional wildcards) + "Edit the existing file FILENAME. +Like \\[find-file] but only allow files that exists." + (interactive (find-file-read-args "Find existing file: " t)) + (unless (file-exists-p filename) (error "%s does not exist" filename)) + (find-file filename wildcards) + (current-buffer)) + (defun find-file-read-only (filename &optional wildcards) "Edit file FILENAME but don't allow changes. Like \\[find-file] but marks buffer as read-only. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 22840896c17..2c1d37c80e2 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -186,10 +186,15 @@ A large number or nil slows down menu responsiveness." '(menu-item "Open Directory..." dired :help "Read a directory, operate on its files")) (define-key menu-bar-files-menu [open-file] - '(menu-item "Open File..." find-file + '(menu-item "Open File..." find-file-existing :enable (not (window-minibuffer-p (frame-selected-window menu-updating-frame))) - :help "Read a file into an Emacs buffer")) + :help "Read an existing file into an Emacs buffer")) +(define-key menu-bar-files-menu [new-file] + '(menu-item "New File..." find-file + :enable (not (window-minibuffer-p + (frame-selected-window menu-updating-frame))) + :help "Read or create a file and edit it")) ;; The "Edit" menu items From f9d64bb358607b8bb771c5d61eccaea2859d3e5f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Tue, 2 Nov 2004 08:21:16 +0000 Subject: [PATCH 063/146] * fileio.c (Fread_file_name): Pass Qt as fifth parameter to Fx_file_dialog if only directories should be read. * lisp.h: Fx_file_dialog takes 5 parameters. * xfns.c (Fx_file_dialog): Both Motif and GTK version: Add parameter only_dir_p. In Motif version, don't put DEFAULT_FILENAME in filter part of the dialog, just text field part. Do not add DEFAULT_FILENAME to list of files if it isn't there. In GTK version, pass only_dir_p parameter to xg_get_file_name. * macfns.c (Fx_file_dialog): Add parameter only_dir_p. Check only_dir_p instead of comparing prompt to "Dired". When using a save dialog, add option kNavDontConfirmReplacement, change title to "Enter name", change text for save button to "Ok". * w32fns.c (Fx_file_dialog): Add parameter only_dir_p. Check only_dir_p instead of comparing prompt to "Dired". * gtkutil.c (xg_get_file_with_chooser) (xg_get_file_with_selection): New functions, only defined ifdef HAVE_GTK_FILE_CHOOSER_DIALOG_NEW and HAVE_GTK_FILE_SELECTION_NEW respectively. (xg_get_file_name): Add parameter only_dir_p. Call xg_get_file_with_chooser or xg_get_file_with_selection depending on HAVE_GTK_FILE* and the value of use_old_gtk_file_dialog. (xg_initialize): New DEFVAR_BOOL use_old_gtk_file_dialog. * gtkutil.h (xg_get_file_name): Add parameter only_dir_p. --- src/ChangeLog | 31 ++++++++++++ src/fileio.c | 3 +- src/gtkutil.c | 129 +++++++++++++++++++++++++++++++++++++++++++++++--- src/gtkutil.h | 3 +- src/lisp.h | 2 +- src/macfns.c | 38 +++++++-------- src/w32fns.c | 18 ++++--- src/xfns.c | 83 ++++++++++++++++---------------- 8 files changed, 228 insertions(+), 79 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 18704954db0..68794ed6cef 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,36 @@ 2004-11-02 Jan Dj,Ad(Brv + * fileio.c (Fread_file_name): Pass Qt as fifth parameter to + Fx_file_dialog if only directories should be read. + + * lisp.h: Fx_file_dialog takes 5 parameters. + + * xfns.c (Fx_file_dialog): Both Motif and GTK version: Add + parameter only_dir_p. + In Motif version, don't put DEFAULT_FILENAME in filter part of the + dialog, just text field part. Do not add DEFAULT_FILENAME + to list of files if it isn't there. + In GTK version, pass only_dir_p parameter to xg_get_file_name. + + * macfns.c (Fx_file_dialog): Add parameter only_dir_p. Check + only_dir_p instead of comparing prompt to "Dired". When using + a save dialog, add option kNavDontConfirmReplacement, change title + to "Enter name", change text for save button to "Ok". + + * w32fns.c (Fx_file_dialog): Add parameter only_dir_p. Check + only_dir_p instead of comparing prompt to "Dired". + + * gtkutil.c (xg_get_file_with_chooser) + (xg_get_file_with_selection): New functions, only defined ifdef + HAVE_GTK_FILE_CHOOSER_DIALOG_NEW and HAVE_GTK_FILE_SELECTION_NEW + respectively. + (xg_get_file_name): Add parameter only_dir_p. + Call xg_get_file_with_chooser or xg_get_file_with_selection + depending on HAVE_GTK_FILE* and the value of use_old_gtk_file_dialog. + (xg_initialize): New DEFVAR_BOOL use_old_gtk_file_dialog. + + * gtkutil.h (xg_get_file_name): Add parameter only_dir_p. + * config.in: Rebuild (added HAVE_GTK_FILE_*). 2004-11-01 Kim F. Storm diff --git a/src/fileio.c b/src/fileio.c index c10969378bc..68ca97cf57f 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -6321,7 +6321,8 @@ and `read-file-name-function'. */) } if (!NILP(default_filename)) default_filename = Fexpand_file_name (default_filename, dir); - val = Fx_file_dialog (prompt, dir, default_filename, mustmatch); + val = Fx_file_dialog (prompt, dir, default_filename, mustmatch, + EQ (predicate, Qfile_directory_p) ? Qt : Qnil); add_to_history = 1; } else diff --git a/src/gtkutil.c b/src/gtkutil.c index dc091c1a09b..ac4f1af56f9 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -1118,6 +1118,10 @@ create_dialog (wv, select_cb, deactivate_cb) } + +/*********************************************************************** + File dialog functions + ***********************************************************************/ enum { XG_FILE_NOT_DONE, @@ -1126,6 +1130,69 @@ enum XG_FILE_DESTROYED, }; +#ifdef HAVE_GTK_FILE_BOTH +static int use_old_gtk_file_dialog; +#endif + + +#ifdef HAVE_GTK_FILE_CHOOSER_DIALOG_NEW +/* Read a file name from the user using a file chooser dialog. + F is the current frame. + PROMPT is a prompt to show to the user. May not be NULL. + DEFAULT_FILENAME is a default selection to be displayed. May be NULL. + If MUSTMATCH_P is non-zero, the returned file name must be an existing + file. + + Returns a file name or NULL if no file was selected. + The returned string must be freed by the caller. */ + +static char * +xg_get_file_with_chooser (f, prompt, default_filename, mustmatch_p, only_dir_p) + FRAME_PTR f; + char *prompt; + char *default_filename; + int mustmatch_p, only_dir_p; +{ + GtkWidget *filewin; + GtkWindow *gwin = GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)); + + char *fn = 0; + GtkFileChooserAction action = (mustmatch_p ? + GTK_FILE_CHOOSER_ACTION_OPEN : + GTK_FILE_CHOOSER_ACTION_SAVE); + + if (only_dir_p) + action = GTK_FILE_CHOOSER_ACTION_SELECT_FOLDER; + + filewin = gtk_file_chooser_dialog_new (prompt, gwin, action, + GTK_STOCK_CANCEL, GTK_RESPONSE_CANCEL, + (mustmatch_p || only_dir_p ? + GTK_STOCK_OPEN : GTK_STOCK_SAVE), + GTK_RESPONSE_OK, + NULL); + + xg_set_screen (filewin, f); + gtk_widget_set_name (filewin, "emacs-filedialog"); + gtk_window_set_transient_for (GTK_WINDOW (filewin), gwin); + gtk_window_set_destroy_with_parent (GTK_WINDOW (filewin), TRUE); + + + if (default_filename) + gtk_file_chooser_set_filename (GTK_FILE_CHOOSER (filewin), + default_filename); + + gtk_widget_show (filewin); + + if (gtk_dialog_run (GTK_DIALOG (filewin)) == GTK_RESPONSE_OK) + fn = gtk_file_chooser_get_filename (GTK_FILE_CHOOSER (filewin)); + + gtk_widget_destroy (filewin); + + return fn; +} +#endif /* HAVE_GTK_FILE_CHOOSER_DIALOG_NEW */ + +#ifdef HAVE_GTK_FILE_SELECTION_NEW /* Callback function invoked when the Ok button is pressed in a file dialog. W is the file dialog widget, @@ -1167,7 +1234,7 @@ xg_file_sel_destroy (w, arg) *(int*)arg = XG_FILE_DESTROYED; } -/* Read a file name from the user using a file dialog. +/* Read a file name from the user using a file selection dialog. F is the current frame. PROMPT is a prompt to show to the user. May not be NULL. DEFAULT_FILENAME is a default selection to be displayed. May be NULL. @@ -1177,12 +1244,13 @@ xg_file_sel_destroy (w, arg) Returns a file name or NULL if no file was selected. The returned string must be freed by the caller. */ -char * -xg_get_file_name (f, prompt, default_filename, mustmatch_p) +static char * +xg_get_file_with_selection (f, prompt, default_filename, + mustmatch_p, only_dir_p) FRAME_PTR f; char *prompt; char *default_filename; - int mustmatch_p; + int mustmatch_p, only_dir_p; { GtkWidget *filewin; GtkFileSelection *filesel; @@ -1193,9 +1261,7 @@ xg_get_file_name (f, prompt, default_filename, mustmatch_p) filesel = GTK_FILE_SELECTION (filewin); xg_set_screen (filewin, f); - gtk_widget_set_name (filewin, "emacs-filedialog"); - gtk_window_set_transient_for (GTK_WINDOW (filewin), GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f))); gtk_window_set_destroy_with_parent (GTK_WINDOW (filewin), TRUE); @@ -1237,6 +1303,49 @@ xg_get_file_name (f, prompt, default_filename, mustmatch_p) return fn; } +#endif /* HAVE_GTK_FILE_SELECTION_NEW */ + +/* Read a file name from the user using a file dialog, either the old + file selection dialog, or the new file chooser dialog. Which to use + depends on what the GTK version used has, and what the value of + gtk-use-old-file-dialog. + F is the current frame. + PROMPT is a prompt to show to the user. May not be NULL. + DEFAULT_FILENAME is a default selection to be displayed. May be NULL. + If MUSTMATCH_P is non-zero, the returned file name must be an existing + file. + + Returns a file name or NULL if no file was selected. + The returned string must be freed by the caller. */ + +char * +xg_get_file_name (f, prompt, default_filename, mustmatch_p, only_dir_p) + FRAME_PTR f; + char *prompt; + char *default_filename; + int mustmatch_p, only_dir_p; +{ +#ifdef HAVE_GTK_FILE_BOTH + if (use_old_gtk_file_dialog) + return xg_get_file_with_selection (f, prompt, default_filename, + mustmatch_p, only_dir_p); + return xg_get_file_with_chooser (f, prompt, default_filename, + mustmatch_p, only_dir_p); + +#else /* not HAVE_GTK_FILE_BOTH */ + +#ifdef HAVE_GTK_FILE_SELECTION_DIALOG_NEW + return xg_get_file_with_selection (f, prompt, default_filename, + mustmatch_p, only_dir_p); +#endif +#ifdef HAVE_GTK_FILE_CHOOSER_DIALOG_NEW + return xg_get_file_with_chooser (f, prompt, default_filename, + mustmatch_p, only_dir_p); +#endif + +#endif /* HAVE_GTK_FILE_BOTH */ + return 0; +} /*********************************************************************** @@ -3429,6 +3538,14 @@ xg_initialize () "gtk-key-theme-name", "Emacs", EMACS_CLASS); + +#ifdef HAVE_GTK_FILE_BOTH + DEFVAR_BOOL ("use-old-gtk-file-dialog", &use_old_gtk_file_dialog, + doc: /* *Non-nil means that the old GTK file selection dialog is used. + If nil the new GTK file chooser is used instead. To turn off + all file dialogs set the variable `use-file-dialog'. */); + use_old_gtk_file_dialog = 0; +#endif } #endif /* USE_GTK */ diff --git a/src/gtkutil.h b/src/gtkutil.h index c0055f361cc..b2e2c5f2fff 100644 --- a/src/gtkutil.h +++ b/src/gtkutil.h @@ -132,7 +132,8 @@ extern void free_widget_value P_ ((widget_value *)); extern char *xg_get_file_name P_ ((FRAME_PTR f, char *prompt, char *default_filename, - int mustmatch_p)); + int mustmatch_p, + int only_dir_p)); extern GtkWidget *xg_create_widget P_ ((char *type, char *name, diff --git a/src/lisp.h b/src/lisp.h index 49d6fa9219d..daf23a05f54 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3121,7 +3121,7 @@ extern void syms_of_xfns P_ ((void)); #ifdef HAVE_WINDOW_SYSTEM /* Defined in xfns.c, w32fns.c, or macfns.c */ EXFUN (Fxw_display_color_p, 1); -EXFUN (Fx_file_dialog, 4); +EXFUN (Fx_file_dialog, 5); #endif /* HAVE_WINDOW_SYSTEM */ /* Defined in xsmfns.c */ diff --git a/src/macfns.c b/src/macfns.c index 88f975a65c8..401c7011fea 100644 --- a/src/macfns.c +++ b/src/macfns.c @@ -4216,22 +4216,23 @@ Value is t if tooltip was open, nil otherwise. */) extern Lisp_Object Qfile_name_history; -DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0, +DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, doc: /* Read file name, prompting with PROMPT in directory DIR. Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file selection box, if -specified. Ensure that file exists if MUSTMATCH is non-nil. */) - (prompt, dir, default_filename, mustmatch) - Lisp_Object prompt, dir, default_filename, mustmatch; +specified. Ensure that file exists if MUSTMATCH is non-nil. +If ONLY-DIR-P is non-nil, the user can only select directories. */) + (prompt, dir, default_filename, mustmatch, only_dir_p) + Lisp_Object prompt, dir, default_filename, mustmatch, only_dir_p; { struct frame *f = SELECTED_FRAME (); Lisp_Object file = Qnil; int count = SPECPDL_INDEX (); - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6; char filename[1001]; int default_filter_index = 1; /* 1: All Files, 2: Directories only */ - GCPRO5 (prompt, dir, default_filename, mustmatch, file); + GCPRO6 (prompt, dir, default_filename, mustmatch, file, only_dir_p); CHECK_STRING (prompt); CHECK_STRING (dir); @@ -4245,7 +4246,8 @@ specified. Ensure that file exists if MUSTMATCH is non-nil. */) NavDialogRef dialogRef; NavTypeListHandle fileTypes = NULL; NavUserAction userAction; - CFStringRef message=NULL, client=NULL, saveName = NULL; + CFStringRef message=NULL, client=NULL, saveName = NULL, ok = NULL; + CFStringRef title = NULL; BLOCK_INPUT; /* No need for a callback function because we are modal */ @@ -4268,13 +4270,19 @@ specified. Ensure that file exists if MUSTMATCH is non-nil. */) options.clientName = client; */ - /* Do Dired hack copied from w32fns.c */ - if (!NILP(prompt) && strncmp (SDATA(prompt), "Dired", 5) == 0) + if (!NILP (only_dir_p)) status = NavCreateChooseFolderDialog(&options, NULL, NULL, NULL, &dialogRef); else if (NILP (mustmatch)) { /* This is a save dialog */ + ok = CFStringCreateWithCString (NULL, "Ok", kCFStringEncodingUTF8); + title = CFStringCreateWithCString (NULL, "Enter name", + kCFStringEncodingUTF8); + options.optionFlags |= kNavDontConfirmReplacement; + options.actionButtonLabel = ok; + options.windowTitle = title; + if (!NILP(default_filename)) { saveName = CFStringCreateWithCString(NULL, SDATA(default_filename), @@ -4282,20 +4290,10 @@ specified. Ensure that file exists if MUSTMATCH is non-nil. */) options.saveFileName = saveName; options.optionFlags |= kNavSelectDefaultLocation; } - /* MAC_TODO: Find a better way to determine if this is a save - or load dialog than comparing dir with default_filename */ - if (EQ(dir, default_filename)) - { - status = NavCreateChooseFileDialog(&options, fileTypes, - NULL, NULL, NULL, NULL, - &dialogRef); - } - else { status = NavCreatePutFileDialog(&options, 'TEXT', kNavGenericSignature, NULL, NULL, &dialogRef); } - } else { /* This is an open dialog*/ @@ -4324,6 +4322,8 @@ specified. Ensure that file exists if MUSTMATCH is non-nil. */) if (saveName) CFRelease(saveName); if (client) CFRelease(client); if (message) CFRelease(message); + if (ok) CFRelease(ok); + if (title) CFRelease(title); if (status == noErr) { userAction = NavDialogGetUserAction(dialogRef); diff --git a/src/w32fns.c b/src/w32fns.c index 38faa7c3199..41bd6a9b9f9 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -7742,23 +7742,24 @@ file_dialog_callback (hwnd, msg, wParam, lParam) return 0; } -DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0, +DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, doc: /* Read file name, prompting with PROMPT in directory DIR. Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file selection box, if -specified. Ensure that file exists if MUSTMATCH is non-nil. */) - (prompt, dir, default_filename, mustmatch) - Lisp_Object prompt, dir, default_filename, mustmatch; +specified. Ensure that file exists if MUSTMATCH is non-nil. +If ONLY-DIR-P is non-nil, the user can only select directories. */) + (prompt, dir, default_filename, mustmatch, only_dir_p) + Lisp_Object prompt, dir, default_filename, mustmatch, only_dir_p; { struct frame *f = SELECTED_FRAME (); Lisp_Object file = Qnil; int count = SPECPDL_INDEX (); - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6; char filename[MAX_PATH + 1]; char init_dir[MAX_PATH + 1]; int default_filter_index = 1; /* 1: All Files, 2: Directories only */ - GCPRO5 (prompt, dir, default_filename, mustmatch, file); + GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file); CHECK_STRING (prompt); CHECK_STRING (dir); @@ -7806,10 +7807,7 @@ specified. Ensure that file exists if MUSTMATCH is non-nil. */) file_details.lpstrInitialDir = init_dir; file_details.lpstrTitle = SDATA (prompt); - /* If prompt starts with Dired, default to directories only. */ - /* A bit hacky, but there doesn't seem to be a better way to - DTRT for dired. */ - if (strncmp (file_details.lpstrTitle, "Dired", 5) == 0) + if (! NILP (only_dir_p)) default_filter_index = 2; file_details.nFilterIndex = default_filter_index; diff --git a/src/xfns.c b/src/xfns.c index 01d528e2790..2cf8a59ca52 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -5106,27 +5106,26 @@ file_dialog_unmap_cb (widget, client_data, call_data) } -DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0, +DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, doc: /* Read file name, prompting with PROMPT in directory DIR. -Use a file selection dialog. -Select DEFAULT-FILENAME in the dialog's file selection box, if -specified. Don't let the user enter a file name in the file -selection dialog's entry field, if MUSTMATCH is non-nil. */) - (prompt, dir, default_filename, mustmatch) - Lisp_Object prompt, dir, default_filename, mustmatch; +Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file +selection box, if specified. If MUSTMATCH is non-nil, the returned file +or directory must exist. ONLY-DIR-P is ignored." */) + (prompt, dir, default_filename, mustmatch, only_dir_p) + Lisp_Object prompt, dir, default_filename, mustmatch, only_dir_p; { int result; struct frame *f = SELECTED_FRAME (); Lisp_Object file = Qnil; - Widget dialog, text, list, help; + Widget dialog, text, help; Arg al[10]; int ac = 0; extern XtAppContext Xt_app_con; XmString dir_xmstring, pattern_xmstring; int count = SPECPDL_INDEX (); - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6; - GCPRO5 (prompt, dir, default_filename, mustmatch, file); + GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file); CHECK_STRING (prompt); CHECK_STRING (dir); @@ -5159,9 +5158,9 @@ selection dialog's entry field, if MUSTMATCH is non-nil. */) XtAddCallback (dialog, XmNunmapCallback, file_dialog_unmap_cb, (XtPointer) &result); - /* Disable the help button since we can't display help. */ + /* Remove the help button since we can't display help. */ help = XmFileSelectionBoxGetChild (dialog, XmDIALOG_HELP_BUTTON); - XtSetSensitive (help, False); + XtUnmanageChild (help); /* Mark OK button as default. */ XtVaSetValues (XmFileSelectionBoxGetChild (dialog, XmDIALOG_OK_BUTTON), @@ -5183,30 +5182,30 @@ selection dialog's entry field, if MUSTMATCH is non-nil. */) /* Manage the dialog, so that list boxes get filled. */ XtManageChild (dialog); - /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME - must include the path for this to work. */ - list = XmFileSelectionBoxGetChild (dialog, XmDIALOG_LIST); if (STRINGP (default_filename)) { XmString default_xmstring; - int item_pos; + Widget wtext = XmFileSelectionBoxGetChild (dialog, XmDIALOG_TEXT); + Widget list = XmFileSelectionBoxGetChild (dialog, XmDIALOG_LIST); - default_xmstring - = XmStringCreateLocalized (SDATA (default_filename)); + XmTextPosition last_pos = XmTextFieldGetLastPosition (wtext); + XmTextFieldReplace (wtext, 0, last_pos, + (SDATA (Ffile_name_nondirectory (default_filename)))); + + /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME + must include the path for this to work. */ + + default_xmstring = XmStringCreateLocalized (SDATA (default_filename)); + + if (XmListItemExists (list, default_xmstring)) + { + int item_pos = XmListItemPos (list, default_xmstring); + /* Select the item and scroll it into view. */ + XmListSelectPos (list, item_pos, True); + XmListSetPos (list, item_pos); + } - if (!XmListItemExists (list, default_xmstring)) - { - /* Add a new item if DEFAULT_FILENAME is not in the list. */ - XmListAddItem (list, default_xmstring, 0); - item_pos = 0; - } - else - item_pos = XmListItemPos (list, default_xmstring); XmStringFree (default_xmstring); - - /* Select the item and scroll it into view. */ - XmListSelectPos (list, item_pos, True); - XmListSetPos (list, item_pos); } /* Process events until the user presses Cancel or OK. */ @@ -5250,23 +5249,23 @@ selection dialog's entry field, if MUSTMATCH is non-nil. */) #ifdef USE_GTK -DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0, - "Read file name, prompting with PROMPT in directory DIR.\n\ -Use a file selection dialog.\n\ -Select DEFAULT-FILENAME in the dialog's file selection box, if\n\ -specified. Don't let the user enter a file name in the file\n\ -selection dialog's entry field, if MUSTMATCH is non-nil.") - (prompt, dir, default_filename, mustmatch) - Lisp_Object prompt, dir, default_filename, mustmatch; +DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, + doc: /* Read file name, prompting with PROMPT in directory DIR. +Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file +selection box, if specified. If MUSTMATCH is non-nil, the returned file +or directory must exist. If ONLY-DIR-P is non-nil, the user can only select +directories. */) + (prompt, dir, default_filename, mustmatch, only_dir_p) + Lisp_Object prompt, dir, default_filename, mustmatch, only_dir_p; { FRAME_PTR f = SELECTED_FRAME (); char *fn; Lisp_Object file = Qnil; int count = specpdl_ptr - specpdl; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6; char *cdef_file; - GCPRO5 (prompt, dir, default_filename, mustmatch, file); + GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file); CHECK_STRING (prompt); CHECK_STRING (dir); @@ -5280,7 +5279,9 @@ selection dialog's entry field, if MUSTMATCH is non-nil.") else cdef_file = SDATA (dir); - fn = xg_get_file_name (f, SDATA (prompt), cdef_file, ! NILP (mustmatch)); + fn = xg_get_file_name (f, SDATA (prompt), cdef_file, + ! NILP (mustmatch), + ! NILP (only_dir_p)); if (fn) { From 4f0d76fbdebcd7f51182e96524b7ec51dbb16270 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Tue, 2 Nov 2004 08:26:21 +0000 Subject: [PATCH 064/146] * frames.texi (Dialog Boxes): Document use-old-gtk-file-dialog. --- man/ChangeLog | 4 ++++ man/frames.texi | 5 +++++ 2 files changed, 9 insertions(+) diff --git a/man/ChangeLog b/man/ChangeLog index d91fbf0267c..1189f42388a 100644 --- a/man/ChangeLog +++ b/man/ChangeLog @@ -1,3 +1,7 @@ +2004-11-02 Jan Dj,Ad(Brv + + * frames.texi (Dialog Boxes): Document use-old-gtk-file-dialog. + 2004-10-23 Eli Zaretskii * text.texi (Text Based Tables, Table Definition) diff --git a/man/frames.texi b/man/frames.texi index dee050922e6..9a4cbb04f5c 100644 --- a/man/frames.texi +++ b/man/frames.texi @@ -910,6 +910,11 @@ use of file selection windows even if you still want other kinds of dialogs. This option has no effect if you have suppressed all dialog boxes with the option @code{use-dialog-box}. +@vindex use-old-gtk-file-dialog + For Gtk+ version 2.4, you can make Emacs use the old file dialog +by setting the variable @code{use-old-gtk-file-dialog} to a non-nil value. +If Emacs is built with a Gtk+ version that has only one file dialog, +the setting of this variable has no effect. @node Tooltips @section Tooltips (or ``Balloon Help'') From cba71f2453c279e7184c05740a0d724ac92fcb4d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Tue, 2 Nov 2004 08:27:06 +0000 Subject: [PATCH 065/146] Mention use-old-gtk-file-dialog. --- etc/NEWS | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 0d5adfdc98c..5ed7b753578 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -940,6 +940,11 @@ be navigated with the arrow keys (like Gtk+ and W32). ** The file selection dialog for Gtk+, W32 and Motif/Lesstif can be disabled by customizing the variable `use-file-dialog'. ++++ +** For Gtk+ version 2.4, you can make Emacs use the old file dialog +by setting the variable `use-old-gtk-file-dialog' to t. Default is to use +the new dialog. + +++ ** Emacs can produce an underscore-like (horizontal bar) cursor. The underscore cursor is set by putting `(cursor-type . hbar)' in From a3fe4aaf37c57337c1e422d2d15b73b91b6df809 Mon Sep 17 00:00:00 2001 From: Jason Rumney Date: Tue, 2 Nov 2004 08:54:05 +0000 Subject: [PATCH 066/146] *** empty log message *** --- src/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/ChangeLog b/src/ChangeLog index 68794ed6cef..a957c28f4e6 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2004-11-02 KOBAYASHI Yasuhiro (tiny change) + + * w32fns.c (w32_font_match): Use fast_string_match_ignore_case for + comapring font names. + 2004-11-02 Jan Dj,Ad(Brv * fileio.c (Fread_file_name): Pass Qt as fifth parameter to From fe4dcb868e1371946b675415fdf19249a606281f Mon Sep 17 00:00:00 2001 From: Jason Rumney Date: Tue, 2 Nov 2004 08:55:10 +0000 Subject: [PATCH 067/146] Use fast_string_match_ignore_case for comparing font names. --- src/w32fns.c | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/src/w32fns.c b/src/w32fns.c index 41bd6a9b9f9..08780e05b1f 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -5607,14 +5607,12 @@ w32_font_match (fontname, pattern) char * fontname; char * pattern; { - char *font_name_copy; char *ptr; - Lisp_Object encoded_font_name; + char *font_name_copy; char *regex = alloca (strlen (pattern) * 2 + 3); - /* Convert fontname to unibyte for match. */ - encoded_font_name = string_make_unibyte (build_string (fontname)); - font_name_copy = SDATA (encoded_font_name); + font_name_copy = alloca (strlen (fontname) + 1); + strcpy (font_name_copy, fontname); ptr = regex; *ptr++ = '^'; @@ -5652,8 +5650,8 @@ w32_font_match (fontname, pattern) return FALSE; } - return (fast_c_string_match_ignore_case (build_string (regex), - font_name_copy) >= 0); + return (fast_string_match_ignore_case (build_string (regex), + build_string(font_name_copy)) >= 0); } /* Callback functions, and a structure holding info they need, for From c63df42bfac4b43ba7af2590d18edbfc8e073690 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Tue, 2 Nov 2004 08:59:26 +0000 Subject: [PATCH 068/146] (Fcall_interactive_p): New function. (interactive_p): Don't test INTERACTIVE here. (Finteractive_p): Doc fix. (Feval): Abort if INPUT_BLOCKED_P. --- src/eval.c | 45 +++++++++++++++++++++++++++++++++------------ 1 file changed, 33 insertions(+), 12 deletions(-) diff --git a/src/eval.c b/src/eval.c index ee74215b2ee..6d37d43c79c 100644 --- a/src/eval.c +++ b/src/eval.c @@ -540,21 +540,45 @@ usage: (function ARG) */) DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0, - doc: /* Return t if function in which this appears was called interactively. + doc: /* Return t if the function was run directly by user input. This means that the function was called with call-interactively (which includes being called as the binding of a key) -and input is currently coming from the keyboard (not in keyboard macro). */) +and input is currently coming from the keyboard (not in keyboard macro), +and Emacs is not running in batch mode (`noninteractive' is nil). + +The only known proper use of `interactive-p' is in deciding whether to +display a helpful message, or how to display it. If you're thinking +of using it for any other purpose, it is quite likely that you're +making a mistake. Think: what do you want to do when the command is +called from a keyboard macro? + +If you want to test whether your function was called with +`call-interactively', the way to do that is by adding an extra +optional argument, and making the `interactive' spec specify non-nil +unconditionally for that argument. (`p' is a good way to do this.) */) () { - return interactive_p (1) ? Qt : Qnil; + return (INTERACTIVE && interactive_p (1)) ? Qt : Qnil; } -/* Return 1 if function in which this appears was called - interactively. This means that the function was called with - call-interactively (which includes being called as the binding of - a key) and input is currently coming from the keyboard (not in - keyboard macro). +DEFUN ("called-interactively-p", Fcall_interactive_p, Scall_interactive_p, 0, 0, 0, + doc: /* Return t if the function using this was called with call-interactively. +This is used for implementing advice and other function-modifying +features of Emacs. + +The cleanest way to test whether your function was called with +`call-interactively', the way to do that is by adding an extra +optional argument, and making the `interactive' spec specify non-nil +unconditionally for that argument. (`p' is a good way to do this.) */) + () +{ + return (INTERACTIVE && interactive_p (1)) ? Qt : Qnil; +} + + +/* Return 1 if function in which this appears was called using + call-interactively. EXCLUDE_SUBRS_P non-zero means always return 0 if the function called is a built-in. */ @@ -566,9 +590,6 @@ interactive_p (exclude_subrs_p) struct backtrace *btp; Lisp_Object fun; - if (!INTERACTIVE) - return 0; - btp = backtrace_list; /* If this isn't a byte-compiled function, there may be a frame at @@ -1975,7 +1996,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, struct backtrace backtrace; struct gcpro gcpro1, gcpro2, gcpro3; - if (handling_signal) + if (handling_signal || INPUT_BLOCKED_P) abort (); if (SYMBOLP (form)) From dc297565e7204be213349cbf4bff6d17d2d24d76 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Tue, 2 Nov 2004 09:06:06 +0000 Subject: [PATCH 069/146] (window_scroll_pixel_based): Update preserve_y for header line if any. (Fscroll_left, Fscroll_right): Don't call interactive_p; use a new second argument instead. --- src/window.c | 38 +++++++++++++++++++++++--------------- 1 file changed, 23 insertions(+), 15 deletions(-) diff --git a/src/window.c b/src/window.c index 5a1f1bab7ca..396d3e7330c 100644 --- a/src/window.c +++ b/src/window.c @@ -4625,17 +4625,25 @@ window_scroll_pixel_based (window, n, whole, noerror) w->force_start = Qt; } + /* The rest of this function uses current_y in a nonstandard way, + not including the height of the header line if any. */ it.current_y = it.vpos = 0; - /* Preserve the screen position if we must. */ + /* Preserve the screen position if we should. */ if (preserve_y >= 0) { + /* If we have a header line, take account of it. */ + if (WINDOW_WANTS_HEADER_LINE_P (w)) + preserve_y -= CURRENT_HEADER_LINE_HEIGHT (w); + move_it_to (&it, -1, -1, preserve_y, -1, MOVE_TO_Y); SET_PT_BOTH (IT_CHARPOS (it), IT_BYTEPOS (it)); } else { - /* Move PT out of scroll margins. */ + /* Move PT out of scroll margins. + This code wants current_y to be zero at the window start position + even if there is a header line. */ this_scroll_margin = max (0, scroll_margin); this_scroll_margin = min (this_scroll_margin, XFASTINT (w->total_lines) / 4); this_scroll_margin *= FRAME_LINE_HEIGHT (it.f); @@ -4990,17 +4998,17 @@ specifies the window to scroll. This takes precedence over return Qnil; } -DEFUN ("scroll-left", Fscroll_left, Sscroll_left, 0, 1, "P", +DEFUN ("scroll-left", Fscroll_left, Sscroll_left, 0, 2, "P\np", doc: /* Scroll selected window display ARG columns left. Default for ARG is window width minus 2. Value is the total amount of leftward horizontal scrolling in effect after the change. -If `automatic-hscrolling' is non-nil, the argument ARG modifies -a lower bound for automatic scrolling, i.e. automatic scrolling +If SET_MINIMUM is non-nil, the new scroll amount becomes the +lower bound for automatic scrolling, i.e. automatic scrolling will not scroll a window to a column less than the value returned -by this function. */) - (arg) - register Lisp_Object arg; +by this function. This happens in an interactive call. */) + (arg, set_minimum) + register Lisp_Object arg, set_minimum; { Lisp_Object result; int hscroll; @@ -5014,22 +5022,22 @@ by this function. */) hscroll = XINT (w->hscroll) + XINT (arg); result = Fset_window_hscroll (selected_window, make_number (hscroll)); - if (interactive_p (0)) + if (!NILP (set_minimum)) w->min_hscroll = w->hscroll; return result; } -DEFUN ("scroll-right", Fscroll_right, Sscroll_right, 0, 1, "P", +DEFUN ("scroll-right", Fscroll_right, Sscroll_right, 0, 2, "P\np", doc: /* Scroll selected window display ARG columns right. Default for ARG is window width minus 2. Value is the total amount of leftward horizontal scrolling in effect after the change. -If `automatic-hscrolling' is non-nil, the argument ARG modifies -a lower bound for automatic scrolling, i.e. automatic scrolling +If SET_MINIMUM is non-nil, the new scroll amount becomes the +lower bound for automatic scrolling, i.e. automatic scrolling will not scroll a window to a column less than the value returned -by this function. */) - (arg) +by this function. This happens in an interactive call. */) + (arg, set_minimum) register Lisp_Object arg; { Lisp_Object result; @@ -5044,7 +5052,7 @@ by this function. */) hscroll = XINT (w->hscroll) - XINT (arg); result = Fset_window_hscroll (selected_window, make_number (hscroll)); - if (interactive_p (0)) + if (!NILP (set_minimum)) w->min_hscroll = w->hscroll; return result; From d41b17ea2faaa4185b1410c7af27f6b31d0b3251 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Tue, 2 Nov 2004 09:08:42 +0000 Subject: [PATCH 070/146] (back_to_previous_visible_line_start): Subtract 1 from pos when checking previous newline for invisibility. --- src/xdisp.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/xdisp.c b/src/xdisp.c index dfb2e8198a5..2ed455e7f6b 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -4555,7 +4555,8 @@ back_to_previous_visible_line_start (it) { Lisp_Object prop; - prop = Fget_char_property (make_number (IT_CHARPOS (*it)), + /* Check the newline before point for invisibility. */ + prop = Fget_char_property (make_number (IT_CHARPOS (*it) - 1), Qinvisible, it->window); if (TEXT_PROP_MEANS_INVISIBLE (prop)) visible_p = 0; From 37663086b1060257daa7f439abe4b58345a66bdc Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Tue, 2 Nov 2004 09:10:13 +0000 Subject: [PATCH 071/146] (USAGE3): Delete --horizontal-scroll-bars, -hb. --- src/emacs.c | 1 - 1 file changed, 1 deletion(-) diff --git a/src/emacs.c b/src/emacs.c index bb601ea8643..67efa4ae4e5 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -305,7 +305,6 @@ Display options:\n\ --fullscreen, -fs make first frame fullscreen\n\ --fullwidth, -fw make the first frame wide as the screen\n\ --geometry, -g GEOMETRY window geometry\n\ ---horizontal-scroll-bars, -hb enable horizontal scroll bars\n\ --icon-type, -i use picture of gnu for Emacs icon\n\ --iconic start Emacs in iconified state\n\ --internal-border, -ib WIDTH width between text and main border\n\ From 5d19ee8aa5128eaefd9895a79a5f484a29acf487 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Tue, 2 Nov 2004 09:12:51 +0000 Subject: [PATCH 072/146] (casify_region): Handle changes in byte-length using replace_range_2. --- src/casefiddle.c | 23 +++++++++++------------ 1 file changed, 11 insertions(+), 12 deletions(-) diff --git a/src/casefiddle.c b/src/casefiddle.c index 51fc6444f49..ae4888088bd 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -235,6 +235,10 @@ casify_region (flag, b, e) else if (!UPPERCASEP (c) && (!inword || flag != CASE_CAPITALIZE_UP)) c = UPCASE1 (c); + if (multibyte && c >= 0x80) + /* A multibyte result character can't be handled in this + simple loop. */ + break; FETCH_BYTE (i) = c; if (c != c2) changed = 1; @@ -272,22 +276,17 @@ casify_region (flag, b, e) tolen = CHAR_STRING (c2, str), fromlen == tolen) { + /* Length is unchanged. */ for (j = 0; j < tolen; ++j) FETCH_BYTE (i + j) = str[j]; } else - { - error ("Can't casify letters that change length"); -#if 0 /* This is approximately what we'd like to be able to do here */ - if (tolen < fromlen) - del_range_1 (i + tolen, i + fromlen, 0, 0); - else if (tolen > fromlen) - { - TEMP_SET_PT (i + fromlen); - insert_1 (str + fromlen, tolen - fromlen, 1, 0, 0); - } -#endif - } + /* Replace one character with the other, + keeping text properties the same. */ + replace_range_2 (start + 1, i + tolen, + start + 2, i + tolen + fromlen, + str, 1, tolen, + 0); } if ((int) flag >= (int) CASE_CAPITALIZE) inword = SYNTAX (c2) == Sword; From 085db7de2dc9af0a5d88667aed435ad155ecfa70 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Tue, 2 Nov 2004 09:14:11 +0000 Subject: [PATCH 073/146] (replace_range_2): New function. --- src/insdel.c | 118 ++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 117 insertions(+), 1 deletion(-) diff --git a/src/insdel.c b/src/insdel.c index ffe7006a45b..f5f56f0371f 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -1464,7 +1464,7 @@ adjust_after_insert (from, from_byte, to, to_byte, newlen) Z -= len; Z_BYTE -= len_byte; adjust_after_replace (from, from_byte, Qnil, newlen, len_byte); } - + /* Replace the text from character positions FROM to TO with NEW, If PREPARE is nonzero, call prepare_to_modify_buffer. If INHERIT, the newly inserted text should inherit text properties @@ -1641,6 +1641,122 @@ replace_range (from, to, new, prepare, inherit, markers) update_compositions (from, GPT, CHECK_BORDER); } +/* Replace the text from character positions FROM to TO with + the text in INS of length INSCHARS. + Keep the text properties that applied to the old characters + (extending them to all the new chars if there are more new chars). + + Note that this does not yet handle markers quite right. + + If MARKERS is nonzero, relocate markers. + + Unlike most functions at this level, never call + prepare_to_modify_buffer and never call signal_after_change. */ + +void +replace_range_2 (from, from_byte, to, to_byte, ins, inschars, insbytes, markers) + int from, from_byte, to, to_byte; + char *ins; + int inschars, insbytes, markers; +{ + int nbytes_del, nchars_del; + Lisp_Object temp; + + CHECK_MARKERS (); + + nchars_del = to - from; + nbytes_del = to_byte - from_byte; + + if (nbytes_del <= 0 && insbytes == 0) + return; + + /* Make sure point-max won't overflow after this insertion. */ + XSETINT (temp, Z_BYTE - nbytes_del + insbytes); + if (Z_BYTE - nbytes_del + insbytes != XINT (temp)) + error ("Maximum buffer size exceeded"); + + /* Make sure the gap is somewhere in or next to what we are deleting. */ + if (from > GPT) + gap_right (from, from_byte); + if (to < GPT) + gap_left (to, to_byte, 0); + + GAP_SIZE += nbytes_del; + ZV -= nchars_del; + Z -= nchars_del; + ZV_BYTE -= nbytes_del; + Z_BYTE -= nbytes_del; + GPT = from; + GPT_BYTE = from_byte; + if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */ + + if (GPT_BYTE < GPT) + abort (); + + if (GPT - BEG < BEG_UNCHANGED) + BEG_UNCHANGED = GPT - BEG; + if (Z - GPT < END_UNCHANGED) + END_UNCHANGED = Z - GPT; + + if (GAP_SIZE < insbytes) + make_gap (insbytes - GAP_SIZE); + + /* Copy the replacement text into the buffer. */ + bcopy (ins, GPT_ADDR, insbytes); + +#ifdef BYTE_COMBINING_DEBUG + /* We have copied text into the gap, but we have not marked + it as part of the buffer. So we can use the old FROM and FROM_BYTE + here, for both the previous text and the following text. + Meanwhile, GPT_ADDR does point to + the text that has been stored by copy_text. */ + if (count_combining_before (GPT_ADDR, insbytes, from, from_byte) + || count_combining_after (GPT_ADDR, insbytes, from, from_byte)) + abort (); +#endif + + GAP_SIZE -= insbytes; + GPT += inschars; + ZV += inschars; + Z += inschars; + GPT_BYTE += insbytes; + ZV_BYTE += insbytes; + Z_BYTE += insbytes; + if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */ + + if (GPT_BYTE < GPT) + abort (); + + /* Adjust the overlay center as needed. This must be done after + adjusting the markers that bound the overlays. */ + if (nchars_del != inschars) + { + adjust_overlays_for_insert (from, inschars); + adjust_overlays_for_delete (from + inschars, nchars_del); + } + + /* Adjust markers for the deletion and the insertion. */ + if (markers + && ! (nchars_del == 1 && inschars == 1)) + adjust_markers_for_replace (from, from_byte, nchars_del, nbytes_del, + inschars, insbytes); + + offset_intervals (current_buffer, from, inschars - nchars_del); + + /* Relocate point as if it were a marker. */ + if (from < PT && nchars_del != inschars) + adjust_point ((from + inschars - (PT < to ? PT : to)), + (from_byte + insbytes + - (PT_BYTE < to_byte ? PT_BYTE : to_byte))); + + if (insbytes == 0) + evaporate_overlays (from); + + CHECK_MARKERS (); + + MODIFF++; +} + /* Delete characters in current buffer from FROM up to (but not including) TO. If TO comes before FROM, we delete nothing. */ From ae03e7cf52e245b66b8e04bd9601aa652c43cdf9 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Tue, 2 Nov 2004 09:17:50 +0000 Subject: [PATCH 074/146] (ad-make-advised-definition): Use called-interactively-p. --- lisp/emacs-lisp/advice.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 7686722c5be..cfaac96bbb1 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -3106,7 +3106,7 @@ in any of these classes." (not advised-interactive-form)) ;; Check whether we were called interactively ;; in order to do proper prompting: - `(if (interactive-p) + `(if (called-interactively-p) (call-interactively ',origname) ,(ad-make-mapped-call orig-arglist advised-arglist From f7ed02acc78d750509dd302014adec42ea8453d1 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Tue, 2 Nov 2004 09:20:13 +0000 Subject: [PATCH 075/146] (update-file-autoloads): Don't use interactive-p; take new arg SAVE-AFTER. --- lisp/emacs-lisp/autoload.el | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 5a5eb55a2a2..196786e9179 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -360,11 +360,14 @@ are used." (message "Generating autoloads for %s...done" file))) ;;;###autoload -(defun update-file-autoloads (file) +(defun update-file-autoloads (file &optional save-after) "Update the autoloads for FILE in `generated-autoload-file' \(which FILE might bind in its local variables). -Return FILE if there was no autoload cookie in it." - (interactive "fUpdate autoloads for file: ") +If SAVE-AFTER is non-nil (which is always, when called interactively), +save the buffer too. + +Return FILE if there was no autoload cookie in it, else nil." + (interactive "fUpdate autoloads for file: \np") (let ((load-name (let ((name (file-name-nondirectory file))) (if (string-match "\\.elc?\\(\\.\\|$\\)" name) (substring name 0 (match-beginning 0)) @@ -464,7 +467,7 @@ Autoload section for %s is up to date." (or existing-buffer (kill-buffer (current-buffer)))))))) (generate-file-autoloads file)))) - (and (interactive-p) + (and save-after (buffer-modified-p) (save-buffer)) From 086af77cf525ef51c8f15ef2b1c3673c86eea5ff Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Tue, 2 Nov 2004 09:22:16 +0000 Subject: [PATCH 076/146] (byte-compile-warning-types): Add interactive-only. (byte-compile-warnings): Add interactive-only as option. (byte-compile-interactive-only-functions): New variable. (byte-compile-form): Warn about calls to functions in byte-compile-interactive-only-functions. --- lisp/emacs-lisp/bytecomp.el | 22 +++++++++++++++++++--- 1 file changed, 19 insertions(+), 3 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 118352937bd..2116cc33b34 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -98,6 +98,9 @@ ;; `obsolete' (obsolete variables and functions) ;; `noruntime' (calls to functions only defined ;; within `eval-when-compile') +;; `cl-warnings' (calls to CL functions) +;; `interactive-only' (calls to commands that are +;; not good to call from Lisp) ;; byte-compile-compatibility Whether the compiler should ;; generate .elc files which can be loaded into ;; generic emacs 18. @@ -325,7 +328,8 @@ If it is 'byte, then only byte-level optimizations will be logged." :type 'boolean) (defconst byte-compile-warning-types - '(redefine callargs free-vars unresolved obsolete noruntime cl-functions) + '(redefine callargs free-vars unresolved + obsolete noruntime cl-functions interactive-only) "The list of warning types used when `byte-compile-warnings' is t.") (defcustom byte-compile-warnings t "*List of warnings that the byte-compiler should issue (t for all). @@ -341,13 +345,21 @@ Elements of the list may be be: noruntime functions that may not be defined at runtime (typically defined only under `eval-when-compile'). cl-functions calls to runtime functions from the CL package (as - distinguished from macros and aliases)." + distinguished from macros and aliases). + interactive-only + commands that normally shouldn't be called from Lisp code." :group 'bytecomp :type `(choice (const :tag "All" t) (set :menu-tag "Some" (const free-vars) (const unresolved) (const callargs) (const redefine) - (const obsolete) (const noruntime) (const cl-functions)))) + (const obsolete) (const noruntime) + (const cl-functions) (const interactive-only)))) + +(defvar byte-compile-interactive-only-functions + '(beginning-of-buffer end-of-buffer replace-string replace-regexp + insert-file) + "List of commands that are not meant to be called from Lisp.") (defvar byte-compile-not-obsolete-var nil "If non-nil, this is a variable that shouldn't be reported as obsolete.") @@ -2710,6 +2722,10 @@ If FORM is a lambda or a macro, byte-compile it as a function." (byte-compile-set-symbol-position fn) (when (byte-compile-const-symbol-p fn) (byte-compile-warn "`%s' called as a function" fn)) + (and (memq 'interactive-only byte-compile-warnings) + (memq (car form) byte-compile-interactive-only-functions) + (byte-compile-warn "`%s' used from Lisp code\n\ +That command is designed for interactive use only" fn)) (if (and handler (or (not (byte-compile-version-cond byte-compile-compatibility)) From a27235b3b5a9a6a31a8f33410186bd35328531e2 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Tue, 2 Nov 2004 09:23:34 +0000 Subject: [PATCH 077/146] (define-minor-mode): Use called-interactively-p. --- lisp/emacs-lisp/easy-mmode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 2439fdd4de6..b6b91710ed4 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -209,7 +209,7 @@ With zero or negative ARG turn mode off. ,@body ;; The on/off hooks are here for backward compatibility only. (run-hooks ',hook (if ,mode ',hook-on ',hook-off)) - (if (interactive-p) + (if (called-interactively-p) (progn ,(if globalp `(customize-mark-as-set ',mode)) (unless (current-message) From da6e3103c4143e18ed96c943b1519fc3e137ea66 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Tue, 2 Nov 2004 09:26:28 +0000 Subject: [PATCH 078/146] (easy-menu-intern): Don't downcase; rather, case-flip the first letter of each word. --- lisp/emacs-lisp/easymenu.el | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index dbd7194f50a..e039b80aee5 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el @@ -42,7 +42,25 @@ menus, turn this variable off, otherwise it is probably better to keep it on." :version "20.3") (defsubst easy-menu-intern (s) - (if (stringp s) (intern (downcase s)) s)) + (if (stringp s) + (let ((copy (copy-sequence s)) + (pos 0) + found) + ;; For each letter that starts a word, flip its case. + ;; This way, the usual convention for menu strings (capitalized) + ;; corresponds to the usual convention for menu item event types + ;; (all lower case). It's a 1-1 mapping so causes no conflicts. + (while (setq found (string-match "\\<\\sw" copy pos)) + (setq pos (match-end 0)) + (unless (= (upcase (aref copy found)) + (downcase (aref copy found))) + (aset copy found + (if (= (upcase (aref copy found)) + (aref copy found)) + (downcase (aref copy found)) + (upcase (aref copy found)))))) + (intern copy)) + s)) ;;;###autoload (put 'easy-menu-define 'lisp-indent-function 'defun) From ea346a5d91b751cd963b952201e1b1f0754a0d60 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Tue, 2 Nov 2004 09:27:26 +0000 Subject: [PATCH 079/146] (elp-instrument-function): Use called-interactively-p. --- lisp/emacs-lisp/elp.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index 17991067fab..d701db9e9b6 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -257,7 +257,7 @@ FUNSYM must be a symbol of a defined function." (setq newguts (append newguts `((elp-wrapper (quote ,funsym) ,(when (commandp funsym) - '(interactive-p)) + '(called-interactively-p)) args)))) ;; to record profiling times, we set the symbol's function ;; definition so that it runs the elp-wrapper function with the From 29bb7127341d58cdda011520188930dd92b630ab Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Tue, 2 Nov 2004 09:28:48 +0000 Subject: [PATCH 080/146] *** empty log message *** --- lisp/ChangeLog | 28 ++++++++++++++++++++++++++++ src/ChangeLog | 23 +++++++++++++++++++++++ 2 files changed, 51 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 853daf41a26..b22332ef287 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,27 @@ +2004-11-02 Richard M. Stallman + + * emacs-lisp/elp.el (elp-instrument-function): + Use called-interactively-p. + + * emacs-lisp/easymenu.el (easy-menu-intern): + Don't downcase; rather, case-flip the first letter of each word. + + * emacs-lisp/easy-mmode.el (define-minor-mode): + Use called-interactively-p. + + * emacs-lisp/bytecomp.el (byte-compile-warning-types): + Add interactive-only. + (byte-compile-warnings): Add interactive-only as option. + (byte-compile-interactive-only-functions): New variable. + (byte-compile-form): Warn about calls to functions + in byte-compile-interactive-only-functions. + + * emacs-lisp/autoload.el (update-file-autoloads): + Don't use interactive-p; take new arg SAVE-AFTER. + + * emacs-lisp/advice.el (ad-make-advised-definition): + Use called-interactively-p. + 2004-11-02 Jan Dj,Ad(Brv * files.el (find-file-existing): New function. @@ -91,6 +115,10 @@ 2004-11-01 Richard M. Stallman + * textmodes/ispell.el (ispell-word): Don't use interactive-p. + + * textmodes/flyspell.el (flyspell-word): Don't use interactive-p. + * allout.el (allout group): Add :version. (allout-init): Don't use interactive-p. (allout-ascend-to-depth, allout-ascend, allout-end-of-level) diff --git a/src/ChangeLog b/src/ChangeLog index a957c28f4e6..20a3a8e2511 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,26 @@ +2004-11-02 Richard M. Stallman + + * insdel.c (replace_range_2): New function. + + * casefiddle.c (casify_region): Handle changes in byte-length + using replace_range_2. + + * emacs.c (USAGE3): Delete --horizontal-scroll-bars, -hb. + + * xdisp.c (back_to_previous_visible_line_start): + Subtract 1 from pos when checking previous newline for invisibility. + + * window.c (window_scroll_pixel_based): Update preserve_y + for header line if any. + (Fscroll_left, Fscroll_right): Don't call interactive_p; + use a new second argument instead. + + * eval.c (Fcall_interactive_p): New function. + (interactive_p): Don't test INTERACTIVE here. + (Finteractive_p): Doc fix. + + * eval.c (Feval): Abort if INPUT_BLOCKED_P. + 2004-11-02 KOBAYASHI Yasuhiro (tiny change) * w32fns.c (w32_font_match): Use fast_string_match_ignore_case for From 60b5eb7862e363b06cf38921228f658471e5ba4f Mon Sep 17 00:00:00 2001 From: Masatake YAMATO Date: Tue, 2 Nov 2004 09:40:30 +0000 Subject: [PATCH 081/146] * url-imap.el (url-imap-open-host): Don't use `string-to-int'. The port returned by `url-port' is expected to be an integer. * url-irc.el (url-irc): Ditto. * url-news.el (url-news-open-host): Ditto. * url-nfs.el (url-nfs-build-filename): Ditto. --- lisp/url/ChangeLog | 12 ++++++++++++ lisp/url/url-imap.el | 2 -- lisp/url/url-irc.el | 2 +- lisp/url/url-news.el | 2 +- lisp/url/url-nfs.el | 2 +- 5 files changed, 15 insertions(+), 5 deletions(-) diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index 053984fcaeb..261635d51e2 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,15 @@ +2004-11-02 Masatake YAMATO + + * url-imap.el (url-imap-open-host): Don't use + `string-to-int'. The port returned by `url-port' + is expected to be an integer. + + * url-irc.el (url-irc): Ditto. + + * url-news.el (url-news-open-host): Ditto. + + * url-nfs.el (url-nfs-build-filename): Ditto. + 2004-10-20 John Paul Wallington * url-gw.el (url-gateway-nslookup-host): diff --git a/lisp/url/url-imap.el b/lisp/url/url-imap.el index 79b53e5d012..7b8f9deb19d 100644 --- a/lisp/url/url-imap.el +++ b/lisp/url/url-imap.el @@ -47,8 +47,6 @@ (let ((imap-username user) (imap-password pass) (authenticator (if user 'login 'anonymous))) - (if (stringp port) - (setq port (string-to-int port))) (nnimap-open-server host `((nnimap-server-port ,port) (nnimap-stream 'network) diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el index 8b54b6d9222..31254dee451 100644 --- a/lisp/url/url-irc.el +++ b/lisp/url/url-irc.el @@ -61,7 +61,7 @@ PASSWORD - What password to use" ;;;###autoload (defun url-irc (url) (let* ((host (url-host url)) - (port (string-to-int (url-port url))) + (port (url-port url)) (pass (url-password url)) (user (url-user url)) (chan (url-filename url))) diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el index 432c81f5d44..9d7f64bb4a4 100644 --- a/lisp/url/url-news.el +++ b/lisp/url/url-news.el @@ -38,7 +38,7 @@ (defun url-news-open-host (host port user pass) (if (fboundp 'nnheader-init-server-buffer) (nnheader-init-server-buffer)) - (nntp-open-server host (list (string-to-int port))) + (nntp-open-server host (list port)) (if (and user pass) (progn (nntp-send-command "^.*\r?\n" "AUTHINFO USER" user) diff --git a/lisp/url/url-nfs.el b/lisp/url/url-nfs.el index 3b834bba75f..ff36c1bdae9 100644 --- a/lisp/url/url-nfs.el +++ b/lisp/url/url-nfs.el @@ -62,7 +62,7 @@ Each can be used any number of times.") (defun url-nfs-build-filename (url) (let* ((host (url-host url)) - (port (string-to-int (url-port url))) + (port (url-port url)) (pass (url-password url)) (user (url-user url)) (file (url-filename url))) From b6189c3bdaea89fa3d9261194eb3cee2c537f721 Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Tue, 2 Nov 2004 09:52:15 +0000 Subject: [PATCH 082/146] Remove (tiny change) comments for people who have signed papers which covers the change. --- src/ChangeLog | 42 +++++++++++++++++++++--------------------- 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 20a3a8e2511..498adf460d1 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -7,7 +7,7 @@ * emacs.c (USAGE3): Delete --horizontal-scroll-bars, -hb. - * xdisp.c (back_to_previous_visible_line_start): + * xdisp.c (back_to_previous_visible_line_start): Subtract 1 from pos when checking previous newline for invisibility. * window.c (window_scroll_pixel_based): Update preserve_y @@ -21,10 +21,10 @@ * eval.c (Feval): Abort if INPUT_BLOCKED_P. -2004-11-02 KOBAYASHI Yasuhiro (tiny change) +2004-11-02 KOBAYASHI Yasuhiro * w32fns.c (w32_font_match): Use fast_string_match_ignore_case for - comapring font names. + comparing font names. 2004-11-02 Jan Dj,Ad(Brv @@ -483,7 +483,7 @@ compositions to encode. (encode_coding_string): Likewise. Free composition data. -2004-09-30 Florian Weimer (tiny change) +2004-09-30 Florian Weimer * coding.c (code_convert_region): Free composition data. @@ -1057,7 +1057,7 @@ (Fsave_window_excursion, Fset_window_vscroll) (syms_of_window) : Doc fixes. -2004-07-19 KOBAYASHI Yasuhiro (tiny change) +2004-07-19 KOBAYASHI Yasuhiro * w32fns.c (Fx_file_dialog): Use ENCODE_FILE instead of ENCODE_SYSTEM for filenames. @@ -1116,7 +1116,7 @@ * buffer.c (syms_of_buffer) : Doc fix. -2004-07-15 KOBAYASHI Yasuhiro (tiny change) +2004-07-15 KOBAYASHI Yasuhiro * w32fns.c (Fx_file_dialog): Encode strings in system coding system before passing them to OS functions for display. @@ -1780,7 +1780,7 @@ before actually accepting connection in case it has already been accepted due to recursion. -2004-05-23 K,Ba(Broly L,Bu(Brentey (tiny change) +2004-05-23 K,Ba(Broly L,Bu(Brentey * coding.c (Fset_safe_terminal_coding_system_internal): Set suppress_error in safe_terminal_coding, not terminal_coding. @@ -2094,7 +2094,7 @@ * w32fns.c (Vw32_ansi_code_page): New Lisp variable. (globals_of_w32fns): Set it. -2004-05-09 Piet van Oostrum (tiny change) +2004-05-09 Piet van Oostrum * data.c (Fquo): Simplify. @@ -2143,7 +2143,7 @@ * emacs.c (main) [VMS]: Fix var ref. -2004-05-06 Romain Francoise (tiny change) +2004-05-06 Romain Francoise * data.c (Fsetq_default): Fix docstring. @@ -2183,7 +2183,7 @@ * Makefile.in (region-cache.o): Depend on config.h. -2004-05-02 Romain Francoise (tiny change) +2004-05-02 Romain Francoise * indent.c (compute_motion): Save vpos in prev_vpos when dealing with continuation lines, too. @@ -3426,7 +3426,7 @@ entries that were used before we return. (init_keyboard): Initialize read_avail_input_buf here. -2004-02-16 Jesper Harder (tiny change) +2004-02-16 Jesper Harder * cmds.c (Fend_of_line): Doc fix. @@ -4094,7 +4094,7 @@ to the definition of `signal' in the Elisp manual. * eval.c (Fsignal): Ditto. -2003-12-29 James Clark (tiny change) +2003-12-29 James Clark * fns.c (internal_equal): Return t for two NaN arguments. @@ -5154,7 +5154,7 @@ * fileio.c (Fwrite_region): Fix conditional expression to issue the right message. -2003-08-16 Juri Linkov (tiny change) +2003-08-16 Juri Linkov * syntax.c (Fforward_word): Argument changed to optional. Set default value to 1. @@ -5213,7 +5213,7 @@ * fns.c (Fclear_string): New function. (syms_of_fns): defsubr it. -2003-07-28 KOBAYASHI Yasuhiro (tiny change) +2003-07-28 KOBAYASHI Yasuhiro * xfns.c (xic_set_preeditarea): Add the left fringe width to spot.x. @@ -5441,7 +5441,7 @@ * alloc.c (Fgarbage_collect): Doc fix. -2003-07-07 Nozomu Ando (tiny change) +2003-07-07 Nozomu Ando * buffer.c (Fkill_buffer): Clear charpos cache if necessary. @@ -6651,7 +6651,7 @@ * alloc.c (Fgarbage_collect): Cast pointers into specpdl to avoid GCC warning. -2003-05-16 Ralph Schleicher (tiny change) +2003-05-16 Ralph Schleicher * fileio.c (Fdelete_file): Handle symlinks pointing to directories. @@ -8374,7 +8374,7 @@ (w32_init_class): Use it. (x_put_x_image): Declare all args. -2003-01-21 Richard Dawe (tiny change) +2003-01-21 Richard Dawe * Makefile.in (ALL_CFLAGS): Include MYCPPFLAGS, not MYCPPFLAG. @@ -8746,7 +8746,7 @@ in direct action cases for Qforward_char and Qbackward_char. Set already_adjusted so it won't be done twice. -2002-12-30 Richard Dawe (tiny change) +2002-12-30 Richard Dawe * src/config.in (!HAVE_SIZE_T): Fix order of arguments in type definition of size_t. @@ -8844,7 +8844,7 @@ * dired.c (file_name_completion): Fix that change. Delete special quit-handling code; just use QUIT. -2002-12-21 Tak Ota (tiny change) +2002-12-21 Tak Ota * dired.c (file_name_completion): Close directory on error just as in directory_files_internal. @@ -10184,8 +10184,8 @@ 2002-08-26 Kim F. Storm - * frame.c (make_terminal_frame) [CANNOT_DUMP]: Initialize foreground - and background colors. From Joe Buehler (tiny change). + * frame.c (make_terminal_frame) [CANNOT_DUMP]: Initialize + foreground and background colors. From Joe Buehler. 2002-08-26 Miles Bader From ca28104dfda873b1a74828e3c7d7f150baf82bff Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Tue, 2 Nov 2004 09:59:28 +0000 Subject: [PATCH 083/146] *** empty log message *** --- src/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/ChangeLog b/src/ChangeLog index 498adf460d1..03052f017c1 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2004-11-02 Kim F. Storm + + * eval.c (Fcalled_interactively_p): Rename from Fcall_interactive_p. + (syms_of_eval): Defsubr it. + 2004-11-02 Richard M. Stallman * insdel.c (replace_range_2): New function. From 4b664e76189829082fc6b947e8bb60356e62db33 Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Tue, 2 Nov 2004 10:00:14 +0000 Subject: [PATCH 084/146] (Fcalled_interactively_p): Rename from Fcall_interactive_p. (syms_of_eval): Defsubr it. --- src/eval.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/eval.c b/src/eval.c index 6d37d43c79c..5fb35cee58b 100644 --- a/src/eval.c +++ b/src/eval.c @@ -562,7 +562,7 @@ unconditionally for that argument. (`p' is a good way to do this.) */) } -DEFUN ("called-interactively-p", Fcall_interactive_p, Scall_interactive_p, 0, 0, 0, +DEFUN ("called-interactively-p", Fcalled_interactively_p, Scalled_interactively_p, 0, 0, 0, doc: /* Return t if the function using this was called with call-interactively. This is used for implementing advice and other function-modifying features of Emacs. @@ -3470,6 +3470,7 @@ The value the function returns is not used. */); defsubr (&Scondition_case); defsubr (&Ssignal); defsubr (&Sinteractive_p); + defsubr (&Scalled_interactively_p); defsubr (&Scommandp); defsubr (&Sautoload); defsubr (&Seval); From 2b2d59d8db495910c52c44686178d9500802dd5d Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Tue, 2 Nov 2004 10:09:14 +0000 Subject: [PATCH 085/146] *** empty log message *** --- src/ChangeLog | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/ChangeLog b/src/ChangeLog index 03052f017c1..2456e6ed13a 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,11 @@ +2004-11-02 Kim F. Storm + + * Makefile.in (callproc.o): Depend on blockinput.h atimer.h systime.h. + +2004-11-02 YAMAMOTO Mitsuharu + + * callproc.c (Fcall_process): Block input around vfork. + 2004-11-02 Kim F. Storm * eval.c (Fcalled_interactively_p): Rename from Fcall_interactive_p. From ae8bc416df377a08031194848acd6633f407af1b Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Tue, 2 Nov 2004 10:09:50 +0000 Subject: [PATCH 086/146] (callproc.o): Depend on blockinput.h atimer.h systime.h. --- src/Makefile.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Makefile.in b/src/Makefile.in index deb33730644..758e74ebf64 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -1052,7 +1052,7 @@ callint.o: callint.c window.h commands.h buffer.h keymap.h \ keyboard.h dispextern.h $(config_h) callproc.o: callproc.c epaths.h buffer.h commands.h $(config_h) \ process.h systty.h syssignal.h charset.h coding.h ccl.h msdos.h \ - composite.h w32.h + composite.h w32.h blockinput.h atimer.h systime.h casefiddle.o: casefiddle.c syntax.h commands.h buffer.h composite.h \ charset.h keymap.h $(config_h) casetab.o: casetab.c buffer.h $(config_h) From aba637ec5be01e0210e52f16d22d1ad4c3b27eb8 Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Tue, 2 Nov 2004 10:10:35 +0000 Subject: [PATCH 087/146] From: YAMAMOTO Mitsuharu (Fcall_process): Block input around vfork. --- src/callproc.c | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/callproc.c b/src/callproc.c index 5d7447d94f2..e251fc65941 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -83,6 +83,7 @@ extern int errno; #include "process.h" #include "syssignal.h" #include "systty.h" +#include "blockinput.h" #ifdef MSDOS #include "msdos.h" @@ -624,6 +625,8 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) pid = child_setup (filefd, fd1, fd_error, (char **) new_argv, 0, current_dir); #else /* not WINDOWSNT */ + BLOCK_INPUT; + pid = vfork (); if (pid == 0) @@ -641,6 +644,8 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) child_setup (filefd, fd1, fd_error, (char **) new_argv, 0, current_dir); } + + UNBLOCK_INPUT; #endif /* not WINDOWSNT */ /* The MSDOS case did this already. */ From 6b3d3397cc170ef0151e2b9387396f7455184289 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Tue, 2 Nov 2004 10:45:34 +0000 Subject: [PATCH 088/146] * FOR-RELEASE (Indications): Remove two stage update for toolbar (Done). --- admin/ChangeLog | 4 ++++ admin/FOR-RELEASE | 4 ---- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/admin/ChangeLog b/admin/ChangeLog index 3c67f2e1bbb..ac21c3aeabc 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,7 @@ +2004-11-02 Jan Dj,Ad(Brv + + * FOR-RELEASE (Indications): Remove two stage update for toolbar (Done). + 2004-09-20 Luc Teirlinck * FOR-RELEASE (Indications): Rearrange checklists for Emacs and diff --git a/admin/FOR-RELEASE b/admin/FOR-RELEASE index b16d2a27e44..626c3e74179 100644 --- a/admin/FOR-RELEASE +++ b/admin/FOR-RELEASE @@ -35,10 +35,6 @@ invalid pointer from string_free_list. ** Make GTK scrollbars behave like others w.r.t. overscrolling. -** Make GTK update the menu bar in two stages, as with Xt, - so that the first can run Lisp code, while only the second - needs BLOCK_INPUT. - * REDISPLAY RELATED BUGS From 949b26bce2a38e0950a6eda19e7d8da211539310 Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Tue, 2 Nov 2004 13:49:38 +0000 Subject: [PATCH 089/146] *** empty log message *** --- admin/FOR-RELEASE | 12 ++---------- 1 file changed, 2 insertions(+), 10 deletions(-) diff --git a/admin/FOR-RELEASE b/admin/FOR-RELEASE index 626c3e74179..e5e719f9037 100644 --- a/admin/FOR-RELEASE +++ b/admin/FOR-RELEASE @@ -100,6 +100,8 @@ when run in gdb, after interrupting. When the freeze up happens within a gdb session, there is no automatic debugging feedback. After interrupting I can get a backtrace, here's an example: +Update: Maybe only reveals itself when compiled with GTK+ + ** Mouse-face overlay bleeds into header line @@ -150,16 +152,6 @@ C-v M-v C-v M-v C-v M-v etc. From: David Kastrup Date: 27 Apr 2004 16:42:58 +0200 -This bug report will be sent to the Free Software Foundation, -not to your local site managers! -Please write in English if possible, because the Emacs maintainers -usually do not have translators to read other languages for them. - -Your bug report will be posted to the emacs-pretest-bug@gnu.org mailing list. - -Please describe exactly what actions triggered the bug -and the precise symptoms of the bug: - I had gnus display a mouse-highlighted line (a URL from browse-url) partially at the bottom of its window. If I click with middle mouse key on it, the window gets recentered while I hold the mouse key From 76e159ab680e78215f4478a75a226c1458bbf917 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Tue, 2 Nov 2004 14:16:30 +0000 Subject: [PATCH 090/146] (comint-insert-input): Fix previous change. --- lisp/comint.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/comint.el b/lisp/comint.el index 16fd9782116..352ed876ee0 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -788,7 +788,7 @@ buffer. The hook `comint-exec-hook' is run after each exec." (defun comint-insert-input (&optional event) "In a Comint buffer, set the current input to the previous input at point." - (interactive "@") + (interactive "e") (if event (mouse-set-point event)) (let ((pos (point))) (if (not (eq (get-char-property pos 'field) 'input)) From 5f97a49d4666de5522ccc8f950dc97667fbb29c5 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Tue, 2 Nov 2004 14:17:44 +0000 Subject: [PATCH 091/146] (customize-group-other-window): Select the window that displays the custom buffer. (custom-buffer-create-other-window): Likewise. --- lisp/cus-edit.el | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 9e0efc5d3d0..89fcb633133 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -896,15 +896,14 @@ then prompt for the MODE to customize." (let ((name (format "*Customize Group: %s*" (custom-unlispify-tag-name group)))) (if (get-buffer name) - (let ((window (selected-window)) + (let ( ;; Copied from `custom-buffer-create-other-window'. (pop-up-windows t) (special-display-buffer-names nil) (special-display-regexps nil) (same-window-buffer-names nil) (same-window-regexps nil)) - (pop-to-buffer name) - (select-window window)) + (pop-to-buffer name)) (custom-buffer-create-other-window (list (list group 'custom-group)) name @@ -1240,21 +1239,20 @@ that option." ;;;###autoload (defun custom-buffer-create-other-window (options &optional name description) - "Create a buffer containing OPTIONS. + "Create a buffer containing OPTIONS, and display it in another window. +The result includes selecting that window. Optional NAME is the name of the buffer. OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where SYMBOL is a customization option, and WIDGET is a widget for editing that option." (unless name (setq name "*Customization*")) - (let ((window (selected-window)) - (pop-up-windows t) + (let ((pop-up-windows t) (special-display-buffer-names nil) (special-display-regexps nil) (same-window-buffer-names nil) (same-window-regexps nil)) (pop-to-buffer (custom-get-fresh-buffer name)) - (custom-buffer-create-internal options description) - (select-window window))) + (custom-buffer-create-internal options description))) (defcustom custom-reset-button-menu nil "If non-nil, only show a single reset button in customize buffers. From 42e91b78d9f873e213ba4a891d2d401124295b4c Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Tue, 2 Nov 2004 14:18:10 +0000 Subject: [PATCH 092/146] Comment change. --- lisp/fast-lock.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/fast-lock.el b/lisp/fast-lock.el index 6812361a28b..4a409bd77aa 100644 --- a/lisp/fast-lock.el +++ b/lisp/fast-lock.el @@ -26,7 +26,7 @@ ;;; Commentary: -;; Lazy Lock mode is a Font Lock support mode. +;; Fast Lock mode is a Font Lock support mode. ;; It makes visiting a file in Font Lock mode faster by restoring its face text ;; properties from automatically saved associated Font Lock cache files. ;; From a93563fdf6e092e33f9f54b6e0103115b13aff33 Mon Sep 17 00:00:00 2001 From: Andreas Schwab Date: Tue, 2 Nov 2004 14:42:40 +0000 Subject: [PATCH 093/146] (Fscroll_right): Fix last change. --- src/ChangeLog | 4 ++++ src/window.c | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/src/ChangeLog b/src/ChangeLog index 2456e6ed13a..f4cb2e518be 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2004-11-02 Andreas Schwab + + * window.c (Fscroll_right): Fix last change. + 2004-11-02 Kim F. Storm * Makefile.in (callproc.o): Depend on blockinput.h atimer.h systime.h. diff --git a/src/window.c b/src/window.c index 396d3e7330c..aae7a9f951e 100644 --- a/src/window.c +++ b/src/window.c @@ -5038,7 +5038,7 @@ lower bound for automatic scrolling, i.e. automatic scrolling will not scroll a window to a column less than the value returned by this function. This happens in an interactive call. */) (arg, set_minimum) - register Lisp_Object arg; + register Lisp_Object arg, set_minimum; { Lisp_Object result; int hscroll; From 8cfd0f366935f88a61af747c42fe67a9c2b5510e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Tue, 2 Nov 2004 15:41:38 +0000 Subject: [PATCH 094/146] * gtkutil.c (xg_get_file_with_chooser): Use GTK_STOCK_OK instead of save. --- src/ChangeLog | 5 +++++ src/gtkutil.c | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/src/ChangeLog b/src/ChangeLog index f4cb2e518be..153c871d917 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2004-11-02 Jan Dj,Ad(Brv + + * gtkutil.c (xg_get_file_with_chooser): Use GTK_STOCK_OK instead + of save. + 2004-11-02 Andreas Schwab * window.c (Fscroll_right): Fix last change. diff --git a/src/gtkutil.c b/src/gtkutil.c index ac4f1af56f9..e1331891140 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -1167,7 +1167,7 @@ xg_get_file_with_chooser (f, prompt, default_filename, mustmatch_p, only_dir_p) filewin = gtk_file_chooser_dialog_new (prompt, gwin, action, GTK_STOCK_CANCEL, GTK_RESPONSE_CANCEL, (mustmatch_p || only_dir_p ? - GTK_STOCK_OPEN : GTK_STOCK_SAVE), + GTK_STOCK_OPEN : GTK_STOCK_OK), GTK_RESPONSE_OK, NULL); From a11e1dce8fc37f32ffa428032e868369c7a6aa0f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Tue, 2 Nov 2004 16:25:50 +0000 Subject: [PATCH 095/146] * xterm.c (x_window_to_scroll_bar): Only call xg_get_scroll_id_for_window if toolkit scroll bars are used. --- src/ChangeLog | 3 +++ src/xterm.c | 4 ++-- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 153c871d917..b7ae4e8148f 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,8 @@ 2004-11-02 Jan Dj,Ad(Brv + * xterm.c (x_window_to_scroll_bar): Only call + xg_get_scroll_id_for_window if toolkit scroll bars are used. + * gtkutil.c (xg_get_file_with_chooser): Use GTK_STOCK_OK instead of save. diff --git a/src/xterm.c b/src/xterm.c index 54ee4014e8c..df99a8667f8 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -3924,9 +3924,9 @@ x_window_to_scroll_bar (display, window_id) { Lisp_Object tail; -#ifdef USE_GTK +#if defined (USE_GTK) && defined (USE_TOOLKIT_SCROLL_BARS) window_id = (Window) xg_get_scroll_id_for_window (display, window_id); -#endif /* USE_GTK */ +#endif /* USE_GTK && USE_TOOLKIT_SCROLL_BARS */ for (tail = Vframe_list; XGCTYPE (tail) == Lisp_Cons; From d0a80c21f31969243fa4ebc98883ba40c9987bc2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Tue, 2 Nov 2004 16:26:46 +0000 Subject: [PATCH 096/146] * configure.in (HAVE_GTK): Only set with_toolkit_scroll_bars if not explicitly set to no. --- ChangeLog | 3 +++ configure | 4 +++- configure.in | 4 +++- 3 files changed, 9 insertions(+), 2 deletions(-) diff --git a/ChangeLog b/ChangeLog index 1f07f82dfc0..fea2ce35e64 100644 --- a/ChangeLog +++ b/ChangeLog @@ -2,6 +2,9 @@ * configure.in (HAVE_GTK_FILE_CHOOSER, $HAVE_GTK_FILE_SELECTION): New tests for new and old GTK file dialogs. + (HAVE_GTK): Only set with_toolkit_scroll_bars if not explicitly set + to no. + * configure: Rebuild 2004-10-20 Jan Dj,Ad(Brv diff --git a/configure b/configure index d966346868d..c776e1fd633 100755 --- a/configure +++ b/configure @@ -9797,7 +9797,9 @@ _ACEOF USE_X_TOOLKIT=none - with_toolkit_scroll_bars=yes + if test "$with_toolkit_scroll_bars" != no; then + with_toolkit_scroll_bars=yes + fi HAVE_GTK_MULTIDISPLAY=no diff --git a/configure.in b/configure.in index 1f49cc536aa..1478d4d4b5d 100644 --- a/configure.in +++ b/configure.in @@ -1967,7 +1967,9 @@ if test "${with_gtk}" = "yes" || test "$USE_X_TOOLKIT" = "gtk"; then dnl GTK scrollbars resemble toolkit scrollbars a lot, so to avoid dnl a lot if #ifdef:s, say we have toolkit scrollbars. - with_toolkit_scroll_bars=yes + if test "$with_toolkit_scroll_bars" != no; then + with_toolkit_scroll_bars=yes + fi dnl Check if we can use multiple displays with this GTK version. dnl If gdk_display_open exists, assume all others are there also. From 98a864f0240b576fbb881d08b6109bf96fe5aea5 Mon Sep 17 00:00:00 2001 From: "Robert J. Chassell" Date: Tue, 2 Nov 2004 18:45:01 +0000 Subject: [PATCH 097/146] Changed copyright years so all include centuries. --- lisp/textmodes/texinfo.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el index 8e5b94114a3..54c9d6ad7db 100644 --- a/lisp/textmodes/texinfo.el +++ b/lisp/textmodes/texinfo.el @@ -1,7 +1,7 @@ ;;; texinfo.el --- major mode for editing Texinfo files -;; Copyright (C) 1985,88,89,90,91,92,93,96,97,2000,01,03,04 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 1988, 1989, 1990, 1991, 1992, 1993, 1996, 1997, +;; 2000, 2001, 2003, 2004 Free Software Foundation, Inc. ;; Author: Robert J. Chassell ;; Date: [See date below for texinfo-version] From f36e4afe479b3ea32dbfaa354392d0031e21ca1f Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Wed, 3 Nov 2004 10:22:39 +0000 Subject: [PATCH 098/146] (vc-annotate-display-autoscale): Add prefix-arg spec in `interactive' form, and mention it in the docstring. --- lisp/ChangeLog | 7 ++++++- lisp/vc.el | 4 ++-- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b22332ef287..3652c68c4f6 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2004-11-03 Thien-Thi Nguyen + + * vc.el (vc-annotate-display-autoscale): Add prefix-arg + spec in `interactive' form, and mention it in the docstring. + 2004-11-02 Richard M. Stallman * emacs-lisp/elp.el (elp-instrument-function): @@ -30,7 +35,7 @@ find-file-existing. Add "New File..." that calls find-file. * diropen.pbm diropen.xpm: New files. - + * toolbar/tool-bar.el (tool-bar-setup): Tool bar item dired uses icon diropen. New tool bar item find-file-existing uses icon open. diff --git a/lisp/vc.el b/lisp/vc.el index 15d0258e85d..3301c9c03f0 100644 --- a/lisp/vc.el +++ b/lisp/vc.el @@ -2896,9 +2896,9 @@ if present. The current time is used as the offset." (defun vc-annotate-display-autoscale (&optional full) "Highlight the output of \\[vc-annotate] using an autoscaled color map. Autoscaling means that the map is scaled from the current time to the -oldest annotation in the buffer, or, with argument FULL non-nil, to +oldest annotation in the buffer, or, with prefix argument FULL, to cover the range from the oldest annotation to the newest." - (interactive) + (interactive "P") (let ((newest 0.0) (oldest 999999.) ;Any CVS users at the founding of Rome? (current (vc-annotate-convert-time (current-time))) From 2e73435333f50845d845633664161d26d55afd51 Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Wed, 3 Nov 2004 10:41:46 +0000 Subject: [PATCH 099/146] (vc-annotate-display-autoscale): Make sure point is at bol after calling `annotate-time'. --- lisp/ChangeLog | 1 + lisp/vc.el | 4 +++- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3652c68c4f6..d47e404cf0e 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -2,6 +2,7 @@ * vc.el (vc-annotate-display-autoscale): Add prefix-arg spec in `interactive' form, and mention it in the docstring. + Also, make sure point is at bol after calling `annotate-time'. 2004-11-02 Richard M. Stallman diff --git a/lisp/vc.el b/lisp/vc.el index 3301c9c03f0..5aac27e31a4 100644 --- a/lisp/vc.el +++ b/lisp/vc.el @@ -2907,7 +2907,9 @@ cover the range from the oldest annotation to the newest." ;; Run through this file and find the oldest and newest dates annotated. (save-excursion (goto-char (point-min)) - (while (setq date (vc-call-backend vc-annotate-backend 'annotate-time)) + (while (setq date (prog1 (vc-call-backend vc-annotate-backend + 'annotate-time) + (forward-line 1))) (if (> date newest) (setq newest date)) (if (< date oldest) From 02b73b974f58f937c09ac318fd40d32c9a157c8b Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Wed, 3 Nov 2004 11:45:20 +0000 Subject: [PATCH 100/146] (grep-default-command): Take empty string for tag if all other methods yield nil. Shell-quote the tag. --- lisp/ChangeLog | 3 +++ lisp/progmodes/grep.el | 10 ++++++---- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d47e404cf0e..a7c72f3bd68 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,8 @@ 2004-11-03 Thien-Thi Nguyen + * progmodes/grep.el (grep-default-command): Take empty string + for tag if all other methods yield nil. Shell-quote the tag. + * vc.el (vc-annotate-display-autoscale): Add prefix-arg spec in `interactive' form, and mention it in the docstring. Also, make sure point is at bol after calling `annotate-time'. diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 71927642a96..7a13ddba6ed 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -436,9 +436,11 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'." (defun grep-default-command () (let ((tag-default - (funcall (or find-tag-default-function - (get major-mode 'find-tag-default-function) - 'find-tag-default))) + (shell-quote-argument + (or (funcall (or find-tag-default-function + (get major-mode 'find-tag-default-function) + 'find-tag-default)) + ""))) (sh-arg-re "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)") (grep-default (or (car grep-history) grep-command))) ;; Replace the thing matching for with that around cursor. @@ -460,7 +462,7 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'." 0 (match-beginning 2)) " *." (file-name-extension buffer-file-name)))) - (replace-match (or tag-default "") t t grep-default 1)))) + (replace-match tag-default t t grep-default 1)))) ;;;###autoload (defun grep (command-args &optional highlight-regexp) From c524d9a6daae2632b41c726919c8a4b78ce91e35 Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Wed, 3 Nov 2004 12:49:24 +0000 Subject: [PATCH 101/146] *** empty log message *** --- src/ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/ChangeLog b/src/ChangeLog index b7ae4e8148f..201bbcba661 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2004-11-03 Kim F. Storm + + * .gdbinit (ppt): New function. + 2004-11-02 Jan Dj,Ad(Brv * xterm.c (x_window_to_scroll_bar): Only call From decf4020140d26df76dfb02ae7e032c07ac159c2 Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Wed, 3 Nov 2004 12:49:39 +0000 Subject: [PATCH 102/146] (ppt): New function. --- src/.gdbinit | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/src/.gdbinit b/src/.gdbinit index 1bcb9f6789b..6adb9f3fa02 100644 --- a/src/.gdbinit +++ b/src/.gdbinit @@ -70,6 +70,34 @@ Print the argument as an emacs s-expression Works only when an inferior emacs is executing. end +# Print out current buffer point and boundaries +define ppt + set $b = current_buffer + set $t = $b->text + printf "BUF PT: %d", $b->pt + if ($b->pt != $b->pt_byte) + printf "[%d]", $b->pt_byte + end + printf " of 1..%d", $t->z + if ($t->z != $t->z_byte) + printf "[%d]", $t->z_byte + end + if ($b->begv != 1 || $b->zv != $t->z) + printf " NARROW=%d..%d", $b->begv, $b->zv + if ($b->begv != $b->begv_byte || $b->zv != $b->zv_byte) + printf " [%d..%d]", $b->begv_byte, $b->zv_byte + end + end + printf " GAP: %d", $t->gpt + if ($t->gpt != $t->gpt_byte) + printf "[%d]", $t->gpt_byte + end + printf " SZ=%d\n", $t->gap_size +end +document ppt +Print point, beg, end, narrow, and gap for current buffer. +end + define xtype xgettype $ output $type From 49e6099b1e840b51149c40a97547421b02292dc1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Wed, 3 Nov 2004 14:08:00 +0000 Subject: [PATCH 103/146] Replace non-nil with non-@code{nil}. --- man/ChangeLog | 9 +++++++++ man/frames.texi | 4 ++-- man/idlwave.texi | 2 +- man/reftex.texi | 6 +++--- man/speedbar.texi | 4 ++-- 5 files changed, 17 insertions(+), 8 deletions(-) diff --git a/man/ChangeLog b/man/ChangeLog index 1189f42388a..f80bb2fc502 100644 --- a/man/ChangeLog +++ b/man/ChangeLog @@ -1,3 +1,12 @@ +2004-11-03 Jan Dj,Ad(Brv + + * frames.texi (Dialog Boxes): + * idlwave.texi (Continued Statement Indentation): + * reftex.texi (Options (Index Support)): + (Displaying and Editing the Index, Table of Contents): + * speedbar.texi (Creating a display, Major Display Modes): Replace + non-nil with non-@code{nil}. + 2004-11-02 Jan Dj,Ad(Brv * frames.texi (Dialog Boxes): Document use-old-gtk-file-dialog. diff --git a/man/frames.texi b/man/frames.texi index 9a4cbb04f5c..cc8ae972567 100644 --- a/man/frames.texi +++ b/man/frames.texi @@ -912,8 +912,8 @@ boxes with the option @code{use-dialog-box}. @vindex use-old-gtk-file-dialog For Gtk+ version 2.4, you can make Emacs use the old file dialog -by setting the variable @code{use-old-gtk-file-dialog} to a non-nil value. -If Emacs is built with a Gtk+ version that has only one file dialog, +by setting the variable @code{use-old-gtk-file-dialog} to a non-@code{nil} +value. If Emacs is built with a Gtk+ version that has only one file dialog, the setting of this variable has no effect. @node Tooltips diff --git a/man/idlwave.texi b/man/idlwave.texi index fde5cd389d6..9c803790171 100644 --- a/man/idlwave.texi +++ b/man/idlwave.texi @@ -832,7 +832,7 @@ level can be somewhat dynamic in continued statements with special continuation indentation, especially if @code{idlwave-max-extra-continuation-indent} is small, the key @kbd{C-u @key{TAB}} will re-indent all lines in the current statement. -Note that @code{idlwave-indent-to-open-paren}, if non-nil, overrides +Note that @code{idlwave-indent-to-open-paren}, if non-@code{nil}, overrides the @code{idlwave-max-extra-continuation-indent} limit, for parentheses only, forcing them always to line up. diff --git a/man/reftex.texi b/man/reftex.texi index 9108747af4f..c40dda36a2f 100644 --- a/man/reftex.texi +++ b/man/reftex.texi @@ -568,7 +568,7 @@ document.@refill @item r @vindex reftex-enable-partial-scans Reparse the LaTeX document and rebuild the @file{*toc*} buffer. When -@code{reftex-enable-partial-scans} is non-nil, rescan only the file this +@code{reftex-enable-partial-scans} is non-@code{nil}, rescan only the file this location is defined in, not the entire document.@refill @item C-u r @@ -2355,7 +2355,7 @@ will move to the correct position.@refill @item r @vindex reftex-enable-partial-scans Reparse the LaTeX document and rebuild the @file{*Index*} buffer. When -@code{reftex-enable-partial-scans} is non-nil, rescan only the file this +@code{reftex-enable-partial-scans} is non-@code{nil}, rescan only the file this location is defined in, not the entire document.@refill @item C-u r @@ -4348,7 +4348,7 @@ index entry. If you have a macro should be @samp{Molecules!}.@refill @var{exclude} can be a function. If this function exists and returns a -non-nil value, the index entry at point is ignored. This was +non-@code{nil} value, the index entry at point is ignored. This was implemented to support the (deprecated) @samp{^} and @samp{_} shortcuts in the LaTeX2e @code{index} package.@refill diff --git a/man/speedbar.texi b/man/speedbar.texi index 246aa1b7caf..62cce0024ae 100644 --- a/man/speedbar.texi +++ b/man/speedbar.texi @@ -1066,7 +1066,7 @@ summary to display in the minibuffer. There are several helper functions you can use if you are going to use built in tagging. These functions can be @code{or}ed since each one -returns non-nil if it displays a message. They are: +returns non-@code{nil} if it displays a message. They are: @table @code @cindex @code{speedbar-item-info-file-helper} @@ -1165,7 +1165,7 @@ when the mouse passes over it. @var{function} is called whenever the user clicks on the text. The optional argument @var{token} is extra data to associated with the -text. Lastly @var{prevline} should be non-nil if you want this line to +text. Lastly @var{prevline} should be non-@code{nil} if you want this line to appear directly after the last button which was created instead of on the next line. @end defun From bc99a9685c7f646dc5e1db1404ad82ca2f6ef781 Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Wed, 3 Nov 2004 14:16:14 +0000 Subject: [PATCH 104/146] (vc-cvs-annotate-command): Delete extraneous lines from beginning of buffer. --- lisp/vc-cvs.el | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/lisp/vc-cvs.el b/lisp/vc-cvs.el index 0c1e6bc1745..273700ed6a4 100644 --- a/lisp/vc-cvs.el +++ b/lisp/vc-cvs.el @@ -5,7 +5,7 @@ ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Andre Spiegel -;; $Id: vc-cvs.el,v 1.67 2004/01/20 17:41:18 uid65624 Exp $ +;; $Id$ ;; This file is part of GNU Emacs. @@ -89,12 +89,12 @@ and past information to determine the current status of a file. The value can also be a regular expression or list of regular expressions to match against the host name of a repository; then VC only stays local for hosts that match it. Alternatively, the value -can be a list of regular expressions where the first element is the -symbol `except'; then VC always stays local except for hosts matched +can be a list of regular expressions where the first element is the +symbol `except'; then VC always stays local except for hosts matched by these regular expressions." :type '(choice (const :tag "Always stay local" t) (const :tag "Don't stay local" nil) - (list :format "\nExamine hostname and %v" :tag "Examine hostname ..." + (list :format "\nExamine hostname and %v" :tag "Examine hostname ..." (set :format "%v" :inline t (const :format "%t" :tag "don't" except)) (regexp :format " stay local,\n%t: %v" :tag "if it matches") (repeat :format "%v%i\n" :inline t (regexp :tag "or")))) @@ -590,7 +590,11 @@ The changes are between FIRST-VERSION and SECOND-VERSION." (defun vc-cvs-annotate-command (file buffer &optional version) "Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER. Optional arg VERSION is a version to annotate from." - (vc-cvs-command buffer 0 file "annotate" (if version (concat "-r" version)))) + (vc-cvs-command buffer 0 file "annotate" (if version (concat "-r" version))) + (with-current-buffer buffer + (goto-char (point-min)) + (re-search-forward "^[0-9]") + (delete-region (point-min) (1- (point))))) (defun vc-cvs-annotate-current-time () "Return the current time, based at midnight of the current day, and @@ -839,7 +843,7 @@ CVS/Entries should only be accessed through this function." (let ((coding-system-for-read (or file-name-coding-system default-file-name-coding-system))) (vc-insert-file (expand-file-name "CVS/Entries" dir)))) - + (defun vc-cvs-valid-symbolic-tag-name-p (tag) "Return non-nil if TAG is a valid symbolic tag name." ;; According to the CVS manual, a valid symbolic tag must start with @@ -929,7 +933,7 @@ is non-nil." "\\(.*\\)")) ;Sticky tag (vc-file-setprop file 'vc-workfile-version (match-string 1)) (vc-file-setprop file 'vc-cvs-sticky-tag - (vc-cvs-parse-sticky-tag (match-string 4) + (vc-cvs-parse-sticky-tag (match-string 4) (match-string 5))) ;; Compare checkout time and modification time. ;; This is intentionally different from the algorithm that CVS uses From cd227df34ce1a9716dad95acc3cccf602611ae39 Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Wed, 3 Nov 2004 14:18:53 +0000 Subject: [PATCH 105/146] (vc-mcvs-annotate-command): Delete extraneous lines from beginning of buffer. --- lisp/ChangeLog | 4 ++++ lisp/vc-mcvs.el | 10 +++++++--- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index a7c72f3bd68..9e6bdf07cb9 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,9 @@ 2004-11-03 Thien-Thi Nguyen + * vc-cvs.el (vc-cvs-annotate-command): + Delete extraneous lines from beginning of buffer. + * vc-mcvs.el (vc-mcvs-annotate-command): Likewise. + * progmodes/grep.el (grep-default-command): Take empty string for tag if all other methods yield nil. Shell-quote the tag. diff --git a/lisp/vc-mcvs.el b/lisp/vc-mcvs.el index d2ac776170f..ea577489239 100644 --- a/lisp/vc-mcvs.el +++ b/lisp/vc-mcvs.el @@ -26,9 +26,9 @@ ;;; Commentary: ;; The home page of the Meta-CVS version control system is at -;; +;; ;; http://users.footprints.net/~kaz/mcvs.html -;; +;; ;; This is derived from vc-cvs.el as follows: ;; - cp vc-cvs.el vc-mcvs.el ;; - Replace CVS/ with MCVS/CVS/ @@ -478,7 +478,11 @@ Optional arg VERSION is a version to annotate from." (vc-mcvs-command buffer (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0) - file "annotate" (if version (concat "-r" version)))) + file "annotate" (if version (concat "-r" version))) + (with-current-buffer buffer + (goto-char (point-min)) + (re-search-forward "^[0-9]") + (delete-region (point-min) (1- (point))))) (defalias 'vc-mcvs-annotate-current-time 'vc-cvs-annotate-current-time) (defalias 'vc-mcvs-annotate-time 'vc-cvs-annotate-time) From b44a1825e5b5de262b51dde301a145ec3f59cf98 Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Wed, 3 Nov 2004 14:28:31 +0000 Subject: [PATCH 106/146] (vc-cvs-local-month-numbers): Delete var. (vc-cvs-annotate-time): Incorporate value of deleted var. Remove special-case handling of beginning-of-buffer cruft. Cache ending position (point) and return value in text property `vc-cvs-annotate-time', and consult it on subsequent invocations. --- lisp/ChangeLog | 6 +++++ lisp/vc-cvs.el | 59 +++++++++++++++++++++++++------------------------- 2 files changed, 36 insertions(+), 29 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 9e6bdf07cb9..91cd415c9fd 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,11 @@ 2004-11-03 Thien-Thi Nguyen + * vc-cvs.el (vc-cvs-local-month-numbers): Delete var. + (vc-cvs-annotate-time): Incorporate value of deleted var. + Remove special-case handling of beginning-of-buffer cruft. + Cache ending position (point) and return value in text property + `vc-cvs-annotate-time', and consult it on subsequent invocations. + * vc-cvs.el (vc-cvs-annotate-command): Delete extraneous lines from beginning of buffer. * vc-mcvs.el (vc-mcvs-annotate-command): Likewise. diff --git a/lisp/vc-cvs.el b/lisp/vc-cvs.el index 273700ed6a4..45ff233eb86 100644 --- a/lisp/vc-cvs.el +++ b/lisp/vc-cvs.el @@ -152,12 +152,6 @@ See also variable `vc-cvs-sticky-date-format-string'." ;;; Internal variables ;;; -(defvar vc-cvs-local-month-numbers - '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4) - ("May" . 5) ("Jun" . 6) ("Jul" . 7) ("Aug" . 8) - ("Sep" . 9) ("Oct" . 10) ("Nov" . 11) ("Dec" . 12)) - "Local association list of month numbers.") - ;;; ;;; State-querying functions @@ -605,29 +599,36 @@ encoded as fractional days." (defun vc-cvs-annotate-time () "Return the time of the next annotation (as fraction of days) systime, or nil if there is none." - (let ((time-stamp - "^\\S-+\\s-+\\S-+\\s-+\\([0-9]+\\)-\\(\\sw+\\)-\\([0-9]+\\)): ")) - (if (looking-at time-stamp) - (progn - (let* ((day (string-to-number (match-string 1))) - (month (cdr (assoc (match-string 2) - vc-cvs-local-month-numbers))) - (year-tmp (string-to-number (match-string 3))) - ;; Years 0..68 are 2000..2068. - ;; Years 69..99 are 1969..1999. - (year (+ (cond ((> 69 year-tmp) 2000) - ((> 100 year-tmp) 1900) - (t 0)) - year-tmp))) - (goto-char (match-end 0)) ; Position at end makes for nicer overlay result - (vc-annotate-convert-time (encode-time 0 0 0 day month year)))) - ;; If we did not look directly at an annotation, there might be - ;; some further down. This is the case if we are positioned at - ;; the very top of the buffer, for instance. - (if (re-search-forward time-stamp nil t) - (progn - (beginning-of-line nil) - (vc-cvs-annotate-time)))))) + (let* ((bol (point)) + (cache (get-text-property bol 'vc-cvs-annotate-time)) + buffer-read-only) + (cond + (cache) + ((looking-at + "^\\S-+\\s-+\\S-+\\s-+\\([0-9]+\\)-\\(\\sw+\\)-\\([0-9]+\\)): ") + (let ((day (string-to-number (match-string 1))) + (month (cdr (assq (intern (match-string 2)) + '((Jan . 1) (Feb . 2) (Mar . 3) + (Apr . 4) (May . 5) (Jun . 6) + (Jul . 7) (Aug . 8) (Sep . 9) + (Oct . 10) (Nov . 11) (Dec . 12))))) + (year (let ((tmp (string-to-number (match-string 3)))) + ;; Years 0..68 are 2000..2068. + ;; Years 69..99 are 1969..1999. + (+ (cond ((> 69 tmp) 2000) + ((> 100 tmp) 1900) + (t 0)) + tmp)))) + (put-text-property + bol (1+ bol) 'vc-cvs-annotate-time + (setq cache (cons + ;; Position at end makes for nicer overlay result. + (match-end 0) + (vc-annotate-convert-time + (encode-time 0 0 0 day month year)))))))) + (when cache + (goto-char (car cache)) ; fontify from here to eol + (cdr cache)))) ; days (float) (defun vc-cvs-annotate-extract-revision-at-line () (save-excursion From 4ac1d37a80316cc0a013326f1ebbdfe166d4928a Mon Sep 17 00:00:00 2001 From: Daniel Pfeiffer Date: Wed, 3 Nov 2004 21:44:49 +0000 Subject: [PATCH 107/146] (xml-based-modes): Delete var. (magic-mode-alist): New var. (set-auto-mode): Use it. --- lisp/files.el | 76 ++++++++++++++++++++++++++++----------------------- 1 file changed, 42 insertions(+), 34 deletions(-) diff --git a/lisp/files.el b/lisp/files.el index 888f9dc81e9..901e0a65f6b 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1845,20 +1845,27 @@ be interpreted by the interpreter matched by the second group of the regular expression. The mode is then determined as the mode associated with that interpreter in `interpreter-mode-alist'.") -(defvar xml-based-modes '(html-mode) - "Modes that override an XML declaration. -When `set-auto-mode' sees an ]*>\\)?\\s *<\\(?:!--\\(?:.\\|\n\\)*?-->\\s *<\\)*\\(?:!DOCTYPE\\s +[^>]*>\\s *<\\)?\\s *\\(?:!--\\(?:.\\|\n\\)*?-->\\s *<\\)*[Hh][Tt][Mm][Ll]" . html-mode) + ;; These two must come after html, because they are more general: + ("<\\?xml " . xml-mode) + ("\\s *<\\(?:!--\\(?:.\\|\n\\)*?-->\\s *<\\)*!DOCTYPE " . sgml-mode) + ("%![^V]" . ps-mode)) + "Alist of buffer beginnings vs corresponding major mode functions. +Each element looks like (REGEXP . FUNCTION). FUNCTION will be +called, unless it is nil.") (defun set-auto-mode (&optional keep-mode-if-same) "Select major mode appropriate for current buffer. + This checks for a -*- mode tag in the buffer's text, checks the interpreter that runs this file against `interpreter-mode-alist', -looks for an Date: Wed, 3 Nov 2004 21:53:26 +0000 Subject: [PATCH 108/146] *** empty log message *** --- lisp/ChangeLog | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 91cd415c9fd..561164b8584 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2004-11-03 Daniel Pfeiffer + + * files.el (xml-based-modes): Delete var. + (magic-mode-alist): New more general var. + (set-auto-mode): Use it. + + * buff-menu.el (Buffer-menu-make-sort-button): Preserve point even + when clicking from another window. + 2004-11-03 Thien-Thi Nguyen * vc-cvs.el (vc-cvs-local-month-numbers): Delete var. From 589f233e08f973b96acfc75b3c53157a807495f5 Mon Sep 17 00:00:00 2001 From: Daniel Pfeiffer Date: Wed, 3 Nov 2004 21:55:28 +0000 Subject: [PATCH 109/146] (Buffer-menu-make-sort-button): Preserve point even when clicking from another window. --- lisp/buff-menu.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index da21f5336d8..e980055d422 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -627,8 +627,9 @@ For more information, see the function `buffer-menu'." (define-key map [header-line mouse-2] `(lambda (e) (interactive "e") - (if e (set-buffer (window-buffer (posn-window (event-end e))))) - (Buffer-menu-sort ,column))) + (save-window-excursion + (if e (mouse-select-window e)) + (Buffer-menu-sort ,column)))) map))) (defun list-buffers-noselect (&optional files-only) From b912921c670907a0c62f0f6459fe5f1155eead9a Mon Sep 17 00:00:00 2001 From: Kenichi Handa Date: Thu, 4 Nov 2004 02:28:51 +0000 Subject: [PATCH 110/146] (fontset_pattern_regexp): If '*' is preceded by '\', treat it as a literal character. --- src/ChangeLog | 5 +++++ src/fontset.c | 4 ++-- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 201bbcba661..01d35ba8e9b 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2004-11-04 Kenichi Handa + + * fontset.c (fontset_pattern_regexp): If '*' is preceded by '\', + treat it as a literal character. + 2004-11-03 Kim F. Storm * .gdbinit (ppt): New function. diff --git a/src/fontset.c b/src/fontset.c index bccbce8bf45..fc4da1305f3 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -796,7 +796,7 @@ fontset_pattern_regexp (pattern) { if (*p0 == '-') ndashes++; - else if (*p0 == '*') + else if (*p0 == '*' && p0 > SDATA (pattern) && p0[-1] != '\\') nstars++; } @@ -811,7 +811,7 @@ fontset_pattern_regexp (pattern) *p1++ = '^'; for (p0 = (char *) SDATA (pattern); *p0; p0++) { - if (*p0 == '*') + if (*p0 == '*' && p0 > SDATA (pattern) && p0[-1] != '\\') { if (ndashes < 14) *p1++ = '.'; From 0683d2414d4de8626f7c46f59937f9bef27302ce Mon Sep 17 00:00:00 2001 From: Miles Bader Date: Thu, 4 Nov 2004 08:12:39 +0000 Subject: [PATCH 111/146] Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-668 Merge from gnus--rel--5.10 Patches applied: * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-66 - miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-68 Update from CVS 2004-11-04 Katsumi Yamaoka * lisp/gnus/gnus-art. (gnus-article-edit-article): Don't associate the article buffer with a draft file. This is a temporary measure against the 2004-08-22 change to gnus-article-edit-mode. 2004-11-02 Katsumi Yamaoka * lisp/gnus/html2text.el (html2text-get-attr): Remove unused argument `tag'. (html2text-format-tags): Remove unused variable `attr'. * lisp/gnus/mm-util.el (mm-enrich-utf-8-by-mule-ucs): Fix cleaning of after-load-alist. * lisp/gnus/mm-util.el (mm-mime-mule-charset-alist): Add the windows-1251 entry. From Ilya N. Golubev . (mm-enrich-utf-8-by-mule-ucs): New function run when Mule-UCS is loaded under XEmacs. (): Don't make duplicated entries in mm-mime-mule-charset-alist. * lisp/gnus/mm-util.el (mm-coding-system-p): Return a coding-system. (mm-mime-mule-charset-alist): Use shift_jis instead of iso-2022-jp-2 for the katakana-jisx0201 mule charset; add new entries for the mime charsets iso-2022-jp-3 and shift_jis. (mm-coding-system-priorities): Use shift_jis and iso-8859-1 instead of japanese-shift-jis and iso-latin-1 respectively in order to share the default value with both Emacs and XEmacs-mule. (mm-mule-charset-to-mime-charset): Make mm-coding-system-priorities effective. (mm-sort-coding-systems-predicate): Canonicalize coding-systems while predicating of candidates upon the priorities. 2004-11-02 Katsumi Yamaoka * man/emacs-mime.texi (Encoding Customization): Fix mm-coding-system-priorities entry. --- lisp/gnus/ChangeLog | 32 +++++++++++++ lisp/gnus/gnus-art.el | 5 +- lisp/gnus/html2text.el | 7 ++- lisp/gnus/mm-util.el | 106 +++++++++++++++++++++++++++-------------- man/ChangeLog | 5 ++ man/emacs-mime.texi | 8 ++-- 6 files changed, 119 insertions(+), 44 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index df6fa771f87..0b93724e9e5 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,35 @@ +2004-11-04 Katsumi Yamaoka + + * gnus-art. (gnus-article-edit-article): Don't associate the + article buffer with a draft file. This is a temporary measure + against the 2004-08-22 change to gnus-article-edit-mode. + +2004-11-02 Katsumi Yamaoka + + * html2text.el (html2text-get-attr): Remove unused argument `tag'. + (html2text-format-tags): Remove unused variable `attr'. + + * mm-util.el (mm-enrich-utf-8-by-mule-ucs): Fix cleaning of + after-load-alist. + + * mm-util.el (mm-mime-mule-charset-alist): Add the windows-1251 + entry. From Ilya N. Golubev . + (mm-enrich-utf-8-by-mule-ucs): New function run when Mule-UCS is + loaded under XEmacs. + (): Don't make duplicated entries in mm-mime-mule-charset-alist. + + * mm-util.el (mm-coding-system-p): Return a coding-system. + (mm-mime-mule-charset-alist): Use shift_jis instead of + iso-2022-jp-2 for the katakana-jisx0201 mule charset; add new + entries for the mime charsets iso-2022-jp-3 and shift_jis. + (mm-coding-system-priorities): Use shift_jis and iso-8859-1 + instead of japanese-shift-jis and iso-latin-1 respectively in + order to share the default value with both Emacs and XEmacs-mule. + (mm-mule-charset-to-mime-charset): Make + mm-coding-system-priorities effective. + (mm-sort-coding-systems-predicate): Canonicalize coding-systems + while predicating of candidates upon the priorities. + 2004-11-01 Reiner Steib * gnus-msg.el (gnus-summary-resend-default-address): Add :version. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index d12186ca370..c0266300983 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -5651,7 +5651,10 @@ groups." "Start editing the contents of the current article buffer." (let ((winconf (current-window-configuration))) (set-buffer gnus-article-buffer) - (gnus-article-edit-mode) + (let ((message-auto-save-directory + ;; Don't associate the article buffer with a draft file. + nil)) + (gnus-article-edit-mode)) (funcall start-func) (set-buffer-modified-p nil) (gnus-configure-windows 'edit-article) diff --git a/lisp/gnus/html2text.el b/lisp/gnus/html2text.el index 7decfc8adb1..ef05af9bae6 100644 --- a/lisp/gnus/html2text.el +++ b/lisp/gnus/html2text.el @@ -144,7 +144,7 @@ formatting, and then moved afterward.") "Get value of ATTRIBUTE from LIST." (nth 1 (assoc attribute list))) -(defun html2text-get-attr (p1 p2 tag) +(defun html2text-get-attr (p1 p2) (goto-char p1) (re-search-forward " +[^ ]" p2 t) (let* ((attr-string (buffer-substring-no-properties (1- (point)) (1- p2))) @@ -320,7 +320,7 @@ formatting, and then moved afterward.") ;; If someone can explain how to make the URL clickable I will surely ;; improve upon this. ;; Maybe `goto-addr.el' can be used here. - (let* ((attr-list (html2text-get-attr p1 p2 "a")) + (let* ((attr-list (html2text-get-attr p1 p2)) (href (html2text-attr-value attr-list "href"))) (delete-region p1 p4) (when href @@ -418,8 +418,7 @@ See the documentation for that variable." (point-max) t) (let ((p1) (p2 (point)) - (p3) (p4) - (attr (match-string 1))) + (p3) (p4)) (search-backward "<" (point-min) t) (setq p1 (point)) (re-search-forward (format "" tag) (point-max) t) diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index b68b4ec584c..382133a027e 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -123,13 +123,16 @@ (defun mm-coding-system-p (cs) "Return non-nil if CS is a symbol naming a coding system. -In XEmacs, also return non-nil if CS is a coding system object." +In XEmacs, also return non-nil if CS is a coding system object. +If CS is available, return CS itself in Emacs, and return a coding +system object in XEmacs." (if (fboundp 'find-coding-system) (find-coding-system cs) (if (fboundp 'coding-system-p) - (coding-system-p cs) + (when (coding-system-p cs) + cs) ;; Is this branch ever actually useful? - (memq cs (mm-get-coding-system-list))))) + (car (memq cs (mm-get-coding-system-list)))))) (defvar mm-charset-synonym-alist `( @@ -219,12 +222,12 @@ In XEmacs, also return non-nil if CS is a coding system object." (big5 chinese-big5-1 chinese-big5-2) (tibetan tibetan) (thai-tis620 thai-tis620) + (windows-1251 cyrillic-iso8859-5) (iso-2022-7bit ethiopic arabic-1-column arabic-2-column) (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7 latin-jisx0201 japanese-jisx0208-1978 chinese-gb2312 japanese-jisx0208 - korean-ksc5601 japanese-jisx0212 - katakana-jisx0201) + korean-ksc5601 japanese-jisx0212) (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7 latin-jisx0201 japanese-jisx0208-1978 chinese-gb2312 japanese-jisx0208 @@ -239,6 +242,9 @@ In XEmacs, also return non-nil if CS is a coding system object." chinese-cns11643-3 chinese-cns11643-4 chinese-cns11643-5 chinese-cns11643-6 chinese-cns11643-7) + (iso-2022-jp-3 latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208 + japanese-jisx0213-1 japanese-jisx0213-2) + (shift_jis latin-jisx0201 katakana-jisx0201 japanese-jisx0208) ,(if (or (not (fboundp 'charsetp)) ;; non-Mule case (charsetp 'unicode-a) (not (mm-coding-system-p 'mule-utf-8))) @@ -249,24 +255,47 @@ In XEmacs, also return non-nil if CS is a coding system object." (coding-system-get 'mule-utf-8 'safe-charsets))))) "Alist of MIME-charset/MULE-charsets.") -;; Correct by construction, but should be unnecessary: -;; XEmacs hates it. -(when (and (not (featurep 'xemacs)) - (fboundp 'coding-system-list) - (fboundp 'sort-coding-systems)) - (setq mm-mime-mule-charset-alist - (apply - 'nconc - (mapcar - (lambda (cs) - (when (and (or (coding-system-get cs :mime-charset) ; Emacs 22 - (coding-system-get cs 'mime-charset)) - (not (eq t (coding-system-get cs 'safe-charsets)))) - (list (cons (or (coding-system-get cs :mime-charset) - (coding-system-get cs 'mime-charset)) - (delq 'ascii - (coding-system-get cs 'safe-charsets)))))) - (sort-coding-systems (coding-system-list 'base-only)))))) +(defun mm-enrich-utf-8-by-mule-ucs () + "Make the `utf-8' MIME charset usable by the Mule-UCS package. +This function will run when the `un-define' module is loaded under +XEmacs, and fill the `utf-8' entry in `mm-mime-mule-charset-alist' +with Mule charsets. It is completely useless for Emacs." + (unless (cdr (delete '(mm-enrich-utf-8-by-mule-ucs) + (assoc "un-define" after-load-alist))) + (setq after-load-alist + (delete '("un-define") after-load-alist))) + (when (boundp 'unicode-basic-translation-charset-order-list) + (condition-case nil + (let ((val (delq + 'ascii + (copy-sequence + (symbol-value + 'unicode-basic-translation-charset-order-list)))) + (elem (assq 'utf-8 mm-mime-mule-charset-alist))) + (if elem + (setcdr elem val) + (setq mm-mime-mule-charset-alist + (nconc mm-mime-mule-charset-alist + (list (cons 'utf-8 val)))))) + (error)))) + +;; Correct by construction, but should be unnecessary for Emacs: +(if (featurep 'xemacs) + (eval-after-load "un-define" '(mm-enrich-utf-8-by-mule-ucs)) + (when (and (fboundp 'coding-system-list) + (fboundp 'sort-coding-systems)) + (let ((css (sort-coding-systems (coding-system-list 'base-only))) + cs mime mule alist) + (while css + (setq cs (pop css) + mime (or (coding-system-get cs :mime-charset) ; Emacs 22 + (coding-system-get cs 'mime-charset))) + (when (and mime + (not (eq t (setq mule + (coding-system-get cs 'safe-charsets)))) + (not (assq mime alist))) + (push (cons mime (delq 'ascii mule)) alist))) + (setq mm-mime-mule-charset-alist (nreverse alist))))) (defvar mm-hack-charsets '(iso-8859-15 iso-2022-jp-2) "A list of special charsets. @@ -332,16 +361,20 @@ mail with multiple parts is preferred to sending a Unicode one.") "Return the MIME charset corresponding to the given Mule CHARSET." (if (and (fboundp 'find-coding-systems-for-charsets) (fboundp 'sort-coding-systems)) - (let (mime) - (dolist (cs (sort-coding-systems - (copy-sequence - (find-coding-systems-for-charsets (list charset))))) - (unless mime - (when cs - (setq mime (or (coding-system-get cs :mime-charset) - (coding-system-get cs 'mime-charset)))))) + (let ((css (sort (sort-coding-systems + (find-coding-systems-for-charsets (list charset))) + 'mm-sort-coding-systems-predicate)) + cs mime) + (while (and (not mime) + css) + (when (setq cs (pop css)) + (setq mime (or (coding-system-get cs :mime-charset) + (coding-system-get cs 'mime-charset))))) mime) - (let ((alist mm-mime-mule-charset-alist) + (let ((alist (mapcar (lambda (cs) + (assq cs mm-mime-mule-charset-alist)) + (sort (mapcar 'car mm-mime-mule-charset-alist) + 'mm-sort-coding-systems-predicate))) out) (while alist (when (memq charset (cdar alist)) @@ -534,11 +567,14 @@ This affects whether coding conversion should be attempted generally." (let ((priorities (mapcar (lambda (cs) ;; Note: invalid entries are dropped silently - (and (coding-system-p cs) + (and (setq cs (mm-coding-system-p cs)) (coding-system-base cs))) mm-coding-system-priorities))) - (> (length (memq a priorities)) - (length (memq b priorities))))) + (and (setq a (mm-coding-system-p a)) + (if (setq b (mm-coding-system-p b)) + (> (length (memq (coding-system-base a) priorities)) + (length (memq (coding-system-base b) priorities))) + t)))) (defun mm-find-mime-charset-region (b e &optional hack-charsets) "Return the MIME charsets needed to encode the region between B and E. diff --git a/man/ChangeLog b/man/ChangeLog index f80bb2fc502..22ac03e8677 100644 --- a/man/ChangeLog +++ b/man/ChangeLog @@ -1,3 +1,8 @@ +2004-11-02 Katsumi Yamaoka + + * emacs-mime.texi (Encoding Customization): Fix + mm-coding-system-priorities entry. + 2004-11-03 Jan Dj,Ad(Brv * frames.texi (Dialog Boxes): diff --git a/man/emacs-mime.texi b/man/emacs-mime.texi index d60e40ebbd0..c128ed096c3 100644 --- a/man/emacs-mime.texi +++ b/man/emacs-mime.texi @@ -814,12 +814,12 @@ by using the @code{encoding} @acronym{MML} tag (@pxref{MML Definition}). @vindex mm-coding-system-priorities Prioritize coding systems to use for outgoing messages. The default is @code{nil}, which means to use the defaults in Emacs. It is a list of -coding system symbols (aliases of coding systems does not work, use -@kbd{M-x describe-coding-system} to make sure you are not specifying -an alias in this variable). For example, if you have configured Emacs +coding system symbols (aliases of coding systems are also allowed, use +@kbd{M-x describe-coding-system} to make sure you are specifying correct +coding system names). For example, if you have configured Emacs to prefer UTF-8, but wish that outgoing messages should be sent in ISO-8859-1 if possible, you can set this variable to -@code{(iso-latin-1)}. You can override this setting on a per-message +@code{(iso-8859-1)}. You can override this setting on a per-message basis by using the @code{charset} @acronym{MML} tag (@pxref{MML Definition}). @item mm-content-transfer-encoding-defaults From fb40303edc53790535f27caa7b57695518a150f5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Thu, 4 Nov 2004 09:21:52 +0000 Subject: [PATCH 112/146] Add menu items "New File..." and "Open File...". Add Mac to text about file selection and use-file-dialog. --- etc/NEWS | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 5ed7b753578..5d08bd4d030 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -931,13 +931,19 @@ amount of text shown any more (only a crude approximation of it). --- ** The pop up menus for Lucid now stay up if you do a fast click and can -be navigated with the arrow keys (like Gtk+ and W32). +be navigated with the arrow keys (like Gtk+, Mac and W32). --- -** Dialogs for Lucid/Athena and Lesstif/Motif pops down when pressing ESC. +** Dialogs for Lucid/Athena and Lesstif/Motif now pops down when pressing +ESC, like they do for Gtk+, Mac and W32. + +--- +** The menu item "Open File..." has been split into two items, "New File..." +and "Open File...". "Open File..." now opens only existing files. This is +to support existing GUI file selection dialogs better. +++ -** The file selection dialog for Gtk+, W32 and Motif/Lesstif can be +** The file selection dialog for Gtk+, Mac, W32 and Motif/Lesstif can be disabled by customizing the variable `use-file-dialog'. +++ From 485ecb5cc45f6e9664bb8ddae99a319bc9de33c6 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Thu, 4 Nov 2004 09:59:56 +0000 Subject: [PATCH 113/146] (filesets group): Add :version. --- lisp/filesets.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/filesets.el b/lisp/filesets.el index cd42be63738..74a2a72bb34 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -295,7 +295,8 @@ key is supported." (defgroup filesets nil "The fileset swapper." :prefix "filesets-" - :group 'convenience) + :group 'convenience + :version "21.4") (defcustom filesets-menu-name "Filesets" "*Filesets' menu name." From 977bbd4d38382bd0c9322b8d6f01216d3753d8a3 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Thu, 4 Nov 2004 10:00:53 +0000 Subject: [PATCH 114/146] (imenu-eager-completion-buffer): Add :version. --- lisp/imenu.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/imenu.el b/lisp/imenu.el index 7c775dc6337..16116025fb8 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -126,7 +126,9 @@ If `on-mouse' use a popup menu when `imenu' was invoked with the mouse." (defcustom imenu-eager-completion-buffer (not (eq imenu-always-use-completion-buffer-p 'never)) "If non-nil, eagerly popup the completion buffer." - :type 'boolean) + :type 'boolean + :group 'imenu + :version "21.4") (defcustom imenu-after-jump-hook nil "*Hooks called after jumping to a place in the buffer. From 9e6856a7a4c07f3cb009768554e81624615c570c Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Thu, 4 Nov 2004 10:02:38 +0000 Subject: [PATCH 115/146] (mouse-show-mark): Get positions to delete from mark and point, not from mouse-drag-overlay. --- lisp/mouse.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/mouse.el b/lisp/mouse.el index 2a467aa8069..865b5e96297 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -1068,8 +1068,7 @@ If MODE is 2 then do the same for lines." (unless ignore ;; For certain special keys, delete the region. (if (member key mouse-region-delete-keys) - (delete-region (overlay-start mouse-drag-overlay) - (overlay-end mouse-drag-overlay)) + (delete-region (mark t) (point)) ;; Otherwise, unread the key so it gets executed normally. (setq unread-command-events (nconc events unread-command-events)))) From 89bf74f828fc00e65e00ade6757bd08c50fc2f08 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Thu, 4 Nov 2004 10:04:16 +0000 Subject: [PATCH 116/146] Comment change. --- lisp/files.el | 2 +- src/xmenu.c | 6 +++++- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/lisp/files.el b/lisp/files.el index 901e0a65f6b..e9ae0fb834f 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -676,7 +676,7 @@ The truename of a file name is found by chasing symbolic links both at the level of the file and at the level of the directories containing it, until no links are left at any level. -\(fn FILENAME)" +\(fn FILENAME)" ;; Don't document the optional arguments. ;; COUNTER and PREV-DIRS are only used in recursive calls. ;; COUNTER can be a cons cell whose car is the count of how many ;; more links to chase before getting an error. diff --git a/src/xmenu.c b/src/xmenu.c index 371ae14f12e..d47c1767c31 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -1120,9 +1120,13 @@ on the left of the dialog box and all following items on the right. popped down (deactivated). This is used for x-popup-menu and x-popup-dialog; it is not used for the menu bar. - If DO_TIMERS is nonzero, run timers. If DOWN_ON_KEYPRESS is nonzero, pop down if a key is pressed. + This function used to have a DO_TIMERS argument which was + 1 in the dialog case, and caused it to run Lisp-level timers. + That was unsafe so we removed it, but does anyone remember + why menus and dialogs were treated differently? + NOTE: All calls to popup_get_selection should be protected with BLOCK_INPUT, UNBLOCK_INPUT wrappers. */ From 3e80ba3c4f2db828282a978ba6cf0f747216a340 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Thu, 4 Nov 2004 10:05:52 +0000 Subject: [PATCH 117/146] (eshell-show-maximum-output): Don't use interactive-p. (eshell-truncate-buffer): Just message, no error, if buffer is short. --- lisp/eshell/esh-mode.el | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index f76900bf482..ea9ae01a2f4 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -943,10 +943,11 @@ With a prefix argument, narrows region to last command output." (eshell-bol) (kill-region (point) here)))) -(defun eshell-show-maximum-output () - "Put the end of the buffer at the bottom of the window." - (interactive) - (if (interactive-p) +(defun eshell-show-maximum-output (&optional interactive) + "Put the end of the buffer at the bottom of the window. +When run interactively, widen the buffer first." + (interactive "p") + (if interactive (widen)) (goto-char (point-max)) (recenter -1)) @@ -1002,7 +1003,7 @@ a key." (let ((pos (point))) (if (bobp) (if (interactive-p) - (error "Buffer too short to truncate")) + (message "Buffer too short to truncate")) (delete-region (point-min) (point)) (if (interactive-p) (message "Truncated buffer from %d to %d lines (%.1fk freed)" From d9ef27108b6c8dde40f6eb32c692a54f253a5142 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Thu, 4 Nov 2004 10:06:40 +0000 Subject: [PATCH 118/146] (pgg group): Add :version. --- lisp/gnus/pgg-def.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/gnus/pgg-def.el b/lisp/gnus/pgg-def.el index b8d9cbec807..046f57dbbfe 100644 --- a/lisp/gnus/pgg-def.el +++ b/lisp/gnus/pgg-def.el @@ -29,7 +29,8 @@ (defgroup pgg () "Glue for the various PGP implementations." - :group 'mime) + :group 'mime + :version "21.4") (defcustom pgg-default-scheme 'gpg "Default PGP scheme." From ba5037ec091f7b251c43953a63eb351e7798f7cb Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Thu, 4 Nov 2004 10:07:27 +0000 Subject: [PATCH 119/146] (spam group): Add :version. --- lisp/gnus/spam.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index 1dc9058dd1f..075408b8fc7 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -76,7 +76,8 @@ ;;; Main parameters. (defgroup spam nil - "Spam configuration.") + "Spam configuration." + :version "21.4") (defcustom spam-directory (nnheader-concat gnus-directory "spam/") "Directory for spam whitelists and blacklists." From e893eae2cb38b308ecf73e610f030ee0bfc7e32a Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Thu, 4 Nov 2004 10:10:35 +0000 Subject: [PATCH 120/146] (set-input-method, toggle-input-method): Don't use interactive-p. Add arg INTERACTIVE. --- lisp/international/mule-cmds.el | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 0d4abab120c..448144d6b28 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -1368,12 +1368,14 @@ If INPUT-METHOD is nil, deactivate any current input method." current-input-method-title nil) (force-mode-line-update))))) -(defun set-input-method (input-method) +(defun set-input-method (input-method &optional interactive) "Select and activate input method INPUT-METHOD for the current buffer. This also sets the default input method to the one you specify. If INPUT-METHOD is nil, this function turns off the input method, and also causes you to be prompted for a name of an input method the next time you invoke \\[toggle-input-method]. +When called interactively, the optional arg INTERACTIVE is non-nil, +which marks the variable `default-input-method' as set for Custom buffers. To deactivate the input method interactively, use \\[toggle-input-method]. To deactivate it programmatically, use \\[inactivate-input-method]." @@ -1381,14 +1383,15 @@ To deactivate it programmatically, use \\[inactivate-input-method]." (let* ((default (or (car input-method-history) default-input-method))) (list (read-input-method-name (if default "Select input method (default %s): " "Select input method: ") - default t)))) + default t) + t))) (activate-input-method input-method) (setq default-input-method input-method) - (when (interactive-p) + (when interactive (customize-mark-as-set 'default-input-method)) default-input-method) -(defun toggle-input-method (&optional arg) +(defun toggle-input-method (&optional arg interactive) "Enable or disable multilingual text input method for the current buffer. Only one input method can be enabled at any time in a given buffer. @@ -1401,9 +1404,12 @@ minibuffer. With a prefix argument, read an input method name with the minibuffer and enable that one. The default is the most recent input method specified -\(not including the currently active input method, if any)." +\(not including the currently active input method, if any). - (interactive "P") +When called interactively, the optional arg INTERACTIVE is non-nil, +which marks the variable `default-input-method' as set for Custom buffers." + + (interactive "P\np") (if (and current-input-method (not arg)) (inactivate-input-method) (let ((default (or (car input-method-history) default-input-method))) @@ -1420,7 +1426,7 @@ and enable that one. The default is the most recent input method specified (unless default-input-method (prog1 (setq default-input-method current-input-method) - (when (interactive-p) + (when interactive (customize-mark-as-set 'default-input-method))))))) (defun describe-input-method (input-method) From 3fc1b2647547d95bbb2418f87fec6dd17f615bd4 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Thu, 4 Nov 2004 10:14:47 +0000 Subject: [PATCH 121/146] (sc-cite-region): Don't use interactive-p. Add arg INTERACTIVE. (sc-version): Don't use interactive-p. Rename arg to MESSAGE. --- lisp/mail/supercite.el | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el index af7f8b62e03..0f5925021e8 100644 --- a/lisp/mail/supercite.el +++ b/lisp/mail/supercite.el @@ -1424,18 +1424,21 @@ Optional CITATION overrides any citation automatically selected." nil) ;; interactive functions -(defun sc-cite-region (start end &optional confirm-p) +(defun sc-cite-region (start end &optional confirm-p interactive) "Cite a region delineated by START and END. If optional CONFIRM-P is non-nil, the attribution is confirmed before its use in the citation string. This function first runs -`sc-pre-cite-hook'." - (interactive "r\nP") +`sc-pre-cite-hook'. + +When called interactively, the optional arg INTERACTIVE is non-nil, +and that means call `sc-select-attribution' too." + (interactive "r\nP\np") (undo-boundary) (let ((frame (or (sc-scan-info-alist sc-cite-frame-alist) sc-default-cite-frame)) (sc-confirm-always-p (if confirm-p t sc-confirm-always-p))) (run-hooks 'sc-pre-cite-hook) - (if (interactive-p) + (if interactive (sc-select-attribution)) (regi-interpret frame start end))) @@ -1978,16 +1981,15 @@ cited." (insert (sc-mail-field "sc-citation")) (error "Line is already cited")))) -(defun sc-version (arg) +(defun sc-version (message) "Echo the current version of Supercite in the minibuffer. -With \\[universal-argument] (universal-argument), or if run non-interactively, +If MESSAGE is non-nil (interactively, with no prefix argument), inserts the version string in the current buffer instead." - (interactive "P") + (interactive (not current-prefix-arg)) (let ((verstr (format "Using Supercite.el %s" sc-version))) - (if (or (consp arg) - (not (interactive-p))) - (insert "`sc-version' says: " verstr) - (message verstr)))) + (if message + (message verstr) + (insert "`sc-version' says: " verstr)))) (defun sc-describe () " From 2de9d0c3be3d4e02d57ae96ae5bfe40cd4f45767 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Thu, 4 Nov 2004 10:15:37 +0000 Subject: [PATCH 122/146] (browse-url-maybe-new-window): Use called-interactively-p. --- lisp/net/browse-url.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 1dbd97f0073..c5a2218e36e 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -596,10 +596,11 @@ for use in `interactive'." (not (eq (null browse-url-new-window-flag) (null current-prefix-arg))))) -;; interactive-p needs to be called at a function's top-level, hence -;; the macro. +;; called-interactive-p needs to be called at a function's top-level, hence +;; this macro. We use that rather than interactive-p because +;; use in a keyboard macro should not change this behavior. (defmacro browse-url-maybe-new-window (arg) - `(if (not (interactive-p)) + `(if (or noninteractive (not (called-interactively-p))) ,arg browse-url-new-window-flag)) From 5e6c7c3c8d44bc2545db281cce97a6aa07387d15 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Thu, 4 Nov 2004 10:16:51 +0000 Subject: [PATCH 123/146] (f90-end-of-block): Don't use interactive-p. --- lisp/progmodes/f90.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index 53165fbecb7..a1c4d539dd7 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -1223,14 +1223,16 @@ Return (TYPE NAME), or nil if not found." With optional argument NUM, go forward that many balanced blocks. If NUM is negative, go backward to the start of a block. Checks for consistency of block types and labels (if present), -and completes outermost block if necessary." +and completes outermost block if necessary. +Some of these things (which?) are not done if NUM is nil, +which only happens in a noninteractive call." (interactive "p") (if (and num (< num 0)) (f90-beginning-of-block (- num))) (let ((f90-smart-end nil) ; for the final `f90-match-end' (case-fold-search t) (count (or num 1)) start-list start-this start-type start-label end-type end-label) - (if (interactive-p) (push-mark (point) t)) + (if num (push-mark (point) t)) (end-of-line) ; probably want this (while (and (> count 0) (re-search-forward f90-blocks-re nil 'move)) (beginning-of-line) @@ -1266,7 +1268,7 @@ and completes outermost block if necessary." (end-of-line)) (if (> count 0) (error "Missing block end")) ;; Check outermost block. - (if (interactive-p) + (if num (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9") From 5a2045cea776b8dc66111d01740601aa9b3b692c Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Thu, 4 Nov 2004 10:20:35 +0000 Subject: [PATCH 124/146] (flyspell-word): Don't alter FOLLOWING; set it only thru `interactive' spec. --- lisp/textmodes/flyspell.el | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 93a7ebd52e4..556369077d8 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -956,9 +956,7 @@ Mostly we check word delimiters." ;*---------------------------------------------------------------------*/ (defun flyspell-word (&optional following) "Spell check a word." - (interactive (list current-prefix-arg)) - (if (interactive-p) - (setq following ispell-following-word)) + (interactive (list ispell-following-word)) (save-excursion ;; use the correct dictionary (flyspell-accept-buffer-local-defs) From a259d74c68fe3a5ecc5d015968985668c219764d Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Thu, 4 Nov 2004 10:22:24 +0000 Subject: [PATCH 125/146] (ispell-word): Don't alter args; set them only thru `interactive' spec. --- lisp/textmodes/ispell.el | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index f0547d6d596..d221d39180f 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1410,12 +1410,9 @@ nil word is correct or spelling is accepted. \(\"word\" arg\) word is hand entered. quit spell session exited." - (interactive (list nil nil current-prefix-arg)) + (interactive (list ispell-following-word ispell-quietly current-prefix-arg)) (if continue (ispell-continue) - (if (interactive-p) - (setq following ispell-following-word - quietly ispell-quietly)) (ispell-accept-buffer-local-defs) ; use the correct dictionary (let ((cursor-location (point)) ; retain cursor location (word (ispell-get-word following)) From 836504434f4a3f84eda175537a4654e8116803c5 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Thu, 4 Nov 2004 10:23:05 +0000 Subject: [PATCH 126/146] (table group): Add :version. --- lisp/textmodes/table.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index 7b13d498b2e..f064dd4dee0 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el @@ -645,7 +645,8 @@ See `table-insert' for examples about how to use." :group 'editing :group 'wp :group 'paragraphs - :group 'fill) + :group 'fill + :version "21.4") (defgroup table-hooks nil "Hooks for table manipulation utilities" From fb54e72e289a810b1c4c90e78c720c23c4e1d47d Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Thu, 4 Nov 2004 10:23:45 +0000 Subject: [PATCH 127/146] *** empty log message *** --- lisp/ChangeLog | 39 +++++++++++++++++++++++++++++++++++++++ lisp/gnus/ChangeLog | 6 ++++++ 2 files changed, 45 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 561164b8584..38d78529b29 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,36 @@ +2004-11-04 Richard M. Stallman + + * textmodes/table.el (table group): Add :version. + + * textmodes/ispell.el (ispell-word): + Don't alter args; set them only thru `interactive' spec. + + * textmodes/flyspell.el (flyspell-word): + Don't alter FOLLOWING; set it only thru `interactive' spec. + + * progmodes/f90.el (f90-end-of-block): Don't use interactive-p. + + * net/browse-url.el (browse-url-maybe-new-window): + Use called-interactively-p. + + * mail/supercite.el (sc-cite-region): + Don't use interactive-p. Add arg INTERACTIVE. + (sc-version): Don't use interactive-p. Rename arg to MESSAGE. + + * international/mule-cmds.el (set-input-method, toggle-input-method): + Don't use interactive-p. Add arg INTERACTIVE. + + * eshell/esh-mode.el (eshell-show-maximum-output): + Don't use interactive-p. + (eshell-truncate-buffer): Just message, no error, if buffer is short. + + * mouse.el (mouse-show-mark): Get positions to delete from mark + and point, not from mouse-drag-overlay. + + * imenu.el (imenu-eager-completion-buffer): Add :version. + + * filesets.el (filesets group): Add :version. + 2004-11-03 Daniel Pfeiffer * files.el (xml-based-modes): Delete var. @@ -28,6 +61,12 @@ 2004-11-02 Richard M. Stallman + * cus-edit.el (customize-group-other-window): + Select the window that displays the custom buffer. + (custom-buffer-create-other-window): Likewise. + + * comint.el (comint-insert-input): Fix previous change. + * emacs-lisp/elp.el (elp-instrument-function): Use called-interactively-p. diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 0b93724e9e5..d7ebedc53f8 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,9 @@ +2004-11-04 Richard M. Stallman + + * spam.el (spam group): Add :version. + + * pgg-def.el (pgg group): Add :version. + 2004-11-04 Katsumi Yamaoka * gnus-art. (gnus-article-edit-article): Don't associate the From a872928c524e28d328ad5abd87ed3bb0f0ebc771 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Thu, 4 Nov 2004 14:18:22 +0000 Subject: [PATCH 128/146] * gtkutil.c (xg_get_file_with_chooser): Expand DEFAULT_FILENAME if it doesn't start with /. --- src/ChangeLog | 5 +++++ src/gtkutil.c | 20 ++++++++++++++++++-- 2 files changed, 23 insertions(+), 2 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 01d35ba8e9b..4b88374e71e 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2004-11-04 Jan Dj,Ad(Brv + + * gtkutil.c (xg_get_file_with_chooser): Expand DEFAULT_FILENAME if + it doesn't start with /. + 2004-11-04 Kenichi Handa * fontset.c (fontset_pattern_regexp): If '*' is preceded by '\', diff --git a/src/gtkutil.c b/src/gtkutil.c index e1331891140..f59ccecbcb8 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -1178,8 +1178,24 @@ xg_get_file_with_chooser (f, prompt, default_filename, mustmatch_p, only_dir_p) if (default_filename) - gtk_file_chooser_set_filename (GTK_FILE_CHOOSER (filewin), - default_filename); + { + Lisp_Object file; + struct gcpro gcpro1; + GCPRO1 (file); + + /* File chooser does not understand ~/... in the file name. It must be + an absolute name starting with /. */ + if (default_filename[0] != '/') + { + file = Fexpand_file_name (build_string (default_filename), Qnil); + default_filename = SDATA (file); + } + + gtk_file_chooser_set_filename (GTK_FILE_CHOOSER (filewin), + default_filename); + + UNGCPRO; + } gtk_widget_show (filewin); From 0a4f23f30e353cbe4c85cef460eca779a2553037 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Thu, 4 Nov 2004 15:05:27 +0000 Subject: [PATCH 129/146] * gtkutil.h: Declare use_old_gtk_file_dialog. * gtkutil.c: Make use_old_gtk_file_dialog non-static. (xg_initialize): Moved DEFVAR_BOOL for use_old_gtk_file_dialog ... * xfns.c (syms_of_xfns): ... to here. --- src/ChangeLog | 6 ++++++ src/gtkutil.c | 10 +--------- src/gtkutil.h | 4 ++++ src/xfns.c | 8 ++++++++ 4 files changed, 19 insertions(+), 9 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 4b88374e71e..0921957b577 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,11 @@ 2004-11-04 Jan Dj,Ad(Brv + * gtkutil.h: Declare use_old_gtk_file_dialog. + + * gtkutil.c: Make use_old_gtk_file_dialog non-static. + (xg_initialize): Moved DEFVAR_BOOL for use_old_gtk_file_dialog ... + * xfns.c (syms_of_xfns): ... to here. + * gtkutil.c (xg_get_file_with_chooser): Expand DEFAULT_FILENAME if it doesn't start with /. diff --git a/src/gtkutil.c b/src/gtkutil.c index f59ccecbcb8..f5f05709e48 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -1131,7 +1131,7 @@ enum }; #ifdef HAVE_GTK_FILE_BOTH -static int use_old_gtk_file_dialog; +int use_old_gtk_file_dialog; #endif @@ -3554,14 +3554,6 @@ xg_initialize () "gtk-key-theme-name", "Emacs", EMACS_CLASS); - -#ifdef HAVE_GTK_FILE_BOTH - DEFVAR_BOOL ("use-old-gtk-file-dialog", &use_old_gtk_file_dialog, - doc: /* *Non-nil means that the old GTK file selection dialog is used. - If nil the new GTK file chooser is used instead. To turn off - all file dialogs set the variable `use-file-dialog'. */); - use_old_gtk_file_dialog = 0; -#endif } #endif /* USE_GTK */ diff --git a/src/gtkutil.h b/src/gtkutil.h index b2e2c5f2fff..44e82885d7f 100644 --- a/src/gtkutil.h +++ b/src/gtkutil.h @@ -126,6 +126,10 @@ typedef struct _widget_value struct _widget_value *free_list; } widget_value; +#ifdef HAVE_GTK_FILE_BOTH +extern int use_old_gtk_file_dialog; +#endif + extern widget_value *malloc_widget_value P_ ((void)); extern void free_widget_value P_ ((widget_value *)); diff --git a/src/xfns.c b/src/xfns.c index 2cf8a59ca52..3179fa1c77b 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -5557,6 +5557,14 @@ Chinese, Japanese, and Korean. */); Fprovide (intern ("x-toolkit"), Qnil); Fprovide (intern ("gtk"), Qnil); +#ifdef HAVE_GTK_FILE_BOTH + DEFVAR_BOOL ("use-old-gtk-file-dialog", &use_old_gtk_file_dialog, + doc: /* *Non-nil means that the old GTK file selection dialog is used. +If nil the new GTK file chooser is used instead. To turn off +all file dialogs set the variable `use-file-dialog'. */); + use_old_gtk_file_dialog = 0; +#endif + DEFVAR_LISP ("gtk-version-string", &Vgtk_version_string, doc: /* Version info for GTK+. */); { From 88208bb85c778985d26a5990bf03980ba71e4b9d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Thu, 4 Nov 2004 15:19:49 +0000 Subject: [PATCH 130/146] * fileio.c (Fnext_read_file_uses_dialog_p): New function. --- src/ChangeLog | 2 ++ src/fileio.c | 23 +++++++++++++++++++---- 2 files changed, 21 insertions(+), 4 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 0921957b577..1c0f23196aa 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,7 @@ 2004-11-04 Jan Dj,Ad(Brv + * fileio.c (Fnext_read_file_uses_dialog_p): New function. + * gtkutil.h: Declare use_old_gtk_file_dialog. * gtkutil.c: Make use_old_gtk_file_dialog non-static. diff --git a/src/fileio.c b/src/fileio.c index 68ca97cf57f..4b5f4942566 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -6174,6 +6174,23 @@ DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_inte return Ffile_exists_p (string); } +DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p, + Snext_read_file_uses_dialog_p, 0, 0, 0, + doc: /* Return t if a call to `read-file-name' will use a dialog. +The return value is only relevant for a call to `read-file-name' that happens +before any other event (mouse or keypress) is handeled. */) + () +{ +#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (TARGET_API_MAC_CARBON) + if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) + && use_dialog_box + && use_file_dialog + && have_menus_p ()) + return Qt; +#endif + return Qnil; +} + DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 6, 0, doc: /* Read file name, prompting with PROMPT and completing in directory DIR. Value is not expanded---you must call `expand-file-name' yourself. @@ -6306,10 +6323,7 @@ and `read-file-name-function'. */) GCPRO2 (insdef, default_filename); #if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (TARGET_API_MAC_CARBON) - if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) - && use_dialog_box - && use_file_dialog - && have_menus_p ()) + if (! NILP (Fnext_read_file_uses_dialog_p ())) { /* If DIR contains a file name, split it. */ Lisp_Object file; @@ -6694,6 +6708,7 @@ a non-nil value. */); defsubr (&Sread_file_name_internal); defsubr (&Sread_file_name); + defsubr (&Snext_read_file_uses_dialog_p); #ifdef unix defsubr (&Sunix_sync); From 8d9e2a494025f771da16061f4ef3562a8e4578b0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Thu, 4 Nov 2004 15:22:00 +0000 Subject: [PATCH 131/146] * dired.el (dired-read-dir-and-switches): Call read-directory-name if a dialog will be used, read-file-name otherwise. --- lisp/ChangeLog | 5 +++++ lisp/dired.el | 10 ++++++++-- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 38d78529b29..9b05528a24f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2004-11-04 Jan Dj,Ad(Brv + + * dired.el (dired-read-dir-and-switches): Call read-directory-name + if a dialog will be used, read-file-name otherwise. + 2004-11-04 Richard M. Stallman * textmodes/table.el (table group): Add :version. diff --git a/lisp/dired.el b/lisp/dired.el index c0fc33729c2..4553683b181 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -546,8 +546,14 @@ Optional third argument FILTER, if non-nil, is a function to select (if current-prefix-arg (read-string "Dired listing switches: " dired-listing-switches)) - (read-directory-name (format "Dired %s(directory): " str) - nil default-directory nil)))) + ;; If a dialog is about to be used, call read-directory-name so + ;; the dialog code knows we want directories. Some dialogs can + ;; only select directories or files when popped up, not both. + (if (next-read-file-uses-dialog-p) + (read-directory-name (format "Dired %s(directory): " str) + nil default-directory nil) + (read-file-name (format "Dired %s(directory): " str) + nil default-directory nil))))) ;;;###autoload (define-key ctl-x-map "d" 'dired) ;;;###autoload From 5dcd636bafa5ea99c11559e3a89bbbbaef604f52 Mon Sep 17 00:00:00 2001 From: Daniel Pfeiffer Date: Thu, 4 Nov 2004 20:24:29 +0000 Subject: [PATCH 132/146] *** empty log message *** --- lisp/ChangeLog | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 9b05528a24f..4620dbb495b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,13 +1,18 @@ +2004-11-04 Daniel Pfeiffer + + * files.el (set-auto-mode): Don't get error after setting + -*-mode-*-. + 2004-11-04 Jan Dj,Ad(Brv * dired.el (dired-read-dir-and-switches): Call read-directory-name if a dialog will be used, read-file-name otherwise. - + 2004-11-04 Richard M. Stallman * textmodes/table.el (table group): Add :version. - * textmodes/ispell.el (ispell-word): + * textmodes/ispell.el (ispell-word): Don't alter args; set them only thru `interactive' spec. * textmodes/flyspell.el (flyspell-word): @@ -18,11 +23,11 @@ * net/browse-url.el (browse-url-maybe-new-window): Use called-interactively-p. - * mail/supercite.el (sc-cite-region): + * mail/supercite.el (sc-cite-region): Don't use interactive-p. Add arg INTERACTIVE. (sc-version): Don't use interactive-p. Rename arg to MESSAGE. - * international/mule-cmds.el (set-input-method, toggle-input-method): + * international/mule-cmds.el (set-input-method, toggle-input-method): Don't use interactive-p. Add arg INTERACTIVE. * eshell/esh-mode.el (eshell-show-maximum-output): From df4d061346b75da5366205536c74ac6442abbd7e Mon Sep 17 00:00:00 2001 From: Daniel Pfeiffer Date: Thu, 4 Nov 2004 20:25:08 +0000 Subject: [PATCH 133/146] (set-auto-mode): Don't get error after setting -*-mode-*-. --- lisp/files.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lisp/files.el b/lisp/files.el index e9ae0fb834f..6ade94cd14d 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1912,6 +1912,7 @@ only set the major mode, if that would change it." (message "Ignoring unknown mode `%s'" mode) (setq done t) (or (set-auto-mode-0 mode keep-mode-if-same) + ;; continuing would call minor modes again, toggling them off (throw 'nop nil))))) ;; If we didn't, look for an interpreter specified in the first line. ;; As a special case, allow for things like "#!/bin/env perl", which @@ -1924,10 +1925,11 @@ only set the major mode, if that would change it." ;; Map interpreter name to a mode, signalling we're done at the ;; same time. done (assoc (file-name-nondirectory mode) - interpreter-mode-alist))) + interpreter-mode-alist)) + (if done + (set-auto-mode-0 (cdr done) keep-mode-if-same))) ;; If we found an interpreter mode to use, invoke it now. - (if done - (set-auto-mode-0 (cdr done) keep-mode-if-same) + (unless done (if (setq done (save-excursion (goto-char (point-min)) (assoc-default nil magic-mode-alist From a33b89de67bdddffadf7d2fe15fbad9de9e16d88 Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Thu, 4 Nov 2004 23:08:07 +0000 Subject: [PATCH 134/146] *** empty log message *** --- src/ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/ChangeLog b/src/ChangeLog index 1c0f23196aa..43bf4f56154 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2004-11-05 Kim F. Storm + + * fontset.c (fontset_pattern_regexp): Use unsigned char. + 2004-11-04 Jan Dj,Ad(Brv * fileio.c (Fnext_read_file_uses_dialog_p): New function. From 6cc06608ad4a8d97ab0bdd10879ceeb18593f425 Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Thu, 4 Nov 2004 23:12:33 +0000 Subject: [PATCH 135/146] (fontset_pattern_regexp): Use unsigned char. --- src/fontset.c | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/fontset.c b/src/fontset.c index fc4da1305f3..6d2840ffd26 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -789,9 +789,9 @@ fontset_pattern_regexp (pattern) || strcmp (SDATA (pattern), CACHED_FONTSET_NAME)) { /* We must at first update the cached data. */ - char *regex, *p0, *p1; + unsigned char *regex, *p0, *p1; int ndashes = 0, nstars = 0; - + for (p0 = SDATA (pattern); *p0; p0++) { if (*p0 == '-') @@ -804,12 +804,12 @@ fontset_pattern_regexp (pattern) we convert "*" to "[^-]*" which is much faster in regular expression matching. */ if (ndashes < 14) - p1 = regex = (char *) alloca (SBYTES (pattern) + 2 * nstars + 1); + p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 2 * nstars + 1); else - p1 = regex = (char *) alloca (SBYTES (pattern) + 5 * nstars + 1); + p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 5 * nstars + 1); *p1++ = '^'; - for (p0 = (char *) SDATA (pattern); *p0; p0++) + for (p0 = SDATA (pattern); *p0; p0++) { if (*p0 == '*' && p0 > SDATA (pattern) && p0[-1] != '\\') { From 9c3ad9e13b31eb85dfd4fc401cc858157aa2bce6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Dj=C3=A4rv?= Date: Fri, 5 Nov 2004 07:05:13 +0000 Subject: [PATCH 136/146] * xselect.c (TRACE3): New debug macro. (x_reply_selection_request): Use it. (receive_incremental_selection): In call to TRACE0, the name of a symbol is in xname. --- src/ChangeLog | 7 +++++++ src/xselect.c | 18 ++++++++++++++++-- 2 files changed, 23 insertions(+), 2 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 43bf4f56154..559ffd672d9 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,10 @@ +2004-11-05 Jan Dj,Ad(Brv + + * xselect.c (TRACE3): New debug macro. + (x_reply_selection_request): Use it. + (receive_incremental_selection): In call to TRACE0, the name of + a symbol is in xname. + 2004-11-05 Kim F. Storm * fontset.c (fontset_pattern_regexp): Use unsigned char. diff --git a/src/xselect.c b/src/xselect.c index 35f4586b754..0d327da85a2 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -85,10 +85,13 @@ static void initialize_cut_buffers P_ ((Display *, Window)); fprintf (stderr, "%d: " fmt "\n", getpid (), a0) #define TRACE2(fmt, a0, a1) \ fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1) +#define TRACE3(fmt, a0, a1, a2) \ + fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1, a2) #else #define TRACE0(fmt) (void) 0 #define TRACE1(fmt, a0) (void) 0 #define TRACE2(fmt, a0, a1) (void) 0 +#define TRACE3(fmt, a0, a1) (void) 0 #endif @@ -623,6 +626,17 @@ x_reply_selection_request (event, format, data, size, type) BLOCK_INPUT; count = x_catch_errors (display); +#ifdef TRACE_SELECTION + { + static int cnt; + char *sel = XGetAtomName (display, reply.selection); + char *tgt = XGetAtomName (display, reply.target); + TRACE3 ("%s, target %s (%d)", sel, tgt, ++cnt); + if (sel) XFree (sel); + if (tgt) XFree (tgt); + } +#endif /* TRACE_SELECTION */ + /* Store the data on the requested property. If the selection is large, only store the first N bytes of it. */ @@ -1445,10 +1459,10 @@ receive_incremental_selection (display, window, property, target_type, BLOCK_INPUT; XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask); TRACE1 (" Delete property %s", - XSYMBOL (x_atom_to_symbol (display, property))->name->data); + SDATA (XSYMBOL (x_atom_to_symbol (display, property))->xname)); XDeleteProperty (display, window, property); TRACE1 (" Expect new value of property %s", - XSYMBOL (x_atom_to_symbol (display, property))->name->data); + SDATA (XSYMBOL (x_atom_to_symbol (display, property))->xname)); wait_object = expect_property_change (display, window, property, PropertyNewValue); XFlush (display); From 36a2b04c38431656111b7740cb71db60e1e1b545 Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Fri, 5 Nov 2004 11:05:08 +0000 Subject: [PATCH 137/146] *** empty log message *** --- src/ChangeLog | 44 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) diff --git a/src/ChangeLog b/src/ChangeLog index 559ffd672d9..ce45e97514f 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,47 @@ +2004-11-05 Kim F. Storm + + * xselect.c (struct selection_event_queue, selection_queue) + (x_queue_selection_requests, x_queue_event) + (x_start_queuing_selection_requests) + (x_stop_queuing_selection_requests): Add new queue for selection + input events to replace previous XEvent queue in xterm.c. + (queue_selection_requests_unwind): Adapt to new queue. + (x_reply_selection_request): Adapt to new queue. Unexpect + wait_object in case of x errors (memory leak). + (x_handle_selection_request, x_handle_selection_clear): Make static. + (x_handle_selection_event): New function. May queue selection events. + (wait_for_property_change_unwind): Use save_value instead of cons. + Clear property_change_reply_object. + (wait_for_property_change): Abort if already waiting. + Use save_value instead of cons for unwind data. + (x_handle_property_notify): Skip events already arrived, but don't + free them, as "arrived" field is checked by wait_for_property_change, + and it will be freed by unwind or explicit unexpect_property_change. + (x_get_foreign_selection): Add to new queue. + (receive_incremental_selection): Don't unexpect wait_object when done + as it has already been freed by previous wait_for_property_change. + + * xterm.h (x_start_queuing_selection_requests) + (x_stop_queuing_selection_requests, x_handle_selection_request) + (x_handle_selection_clear): Remove prototypes. + (x_handle_selection_event): Add prototype. + + * xterm.c (handle_one_xevent): Don't queue X selection events + here, it may be too late if we start queuing after we have already + stored some selection events into the kbd buffer. + (struct selection_event_queue, queue, x_queue_selection_requests) + (x_queue_event, x_unqueue_events, x_start_queuing_selection_requests) + (x_stop_queuing_selection_requests): Remove/move to xselect.c. + (x_catch_errors_unwind): Block input around final XSync. + + * keyboard.h (kbd_buffer_unget_event): Add prototype. + + * keyboard.c (kbd_buffer_store_event_hold): Remove obsolete code. + (kbd_buffer_unget_event): New function. + (kbd_buffer_get_event, swallow_events): Combine SELECTION events + and use x_handle_selection_event. + (mark_kboards): Don't mark x and y of SELECTION_CLEAR_EVENT. + 2004-11-05 Jan Dj,Ad(Brv * xselect.c (TRACE3): New debug macro. From e3f6e7c7d0a41ada6734f8386e13f8d5e5ac2d88 Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Fri, 5 Nov 2004 11:30:01 +0000 Subject: [PATCH 138/146] (kbd_buffer_store_event_hold): Remove obsolete code. (kbd_buffer_unget_event): New function. (kbd_buffer_get_event, swallow_events): Combine SELECTION events and use x_handle_selection_event. (mark_kboards): Don't mark x and y of SELECTION_CLEAR_EVENT. --- src/keyboard.c | 93 ++++++++++++++------------------------------------ 1 file changed, 26 insertions(+), 67 deletions(-) diff --git a/src/keyboard.c b/src/keyboard.c index ba9db5b6e94..d145ec50d2c 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -3698,40 +3698,30 @@ kbd_buffer_store_event_hold (event, hold_quit) Discard the event if it would fill the last slot. */ if (kbd_fetch_ptr - 1 != kbd_store_ptr) { - -#if 0 /* The SELECTION_REQUEST_EVENT case looks bogus, and it's error - prone to assign individual members for other events, in case - the input_event structure is changed. --2000-07-13, gerd. */ - struct input_event *sp = kbd_store_ptr; - sp->kind = event->kind; - if (event->kind == SELECTION_REQUEST_EVENT) - { - /* We must not use the ordinary copying code for this case, - since `part' is an enum and copying it might not copy enough - in this case. */ - bcopy (event, (char *) sp, sizeof (*event)); - } - else - - { - sp->code = event->code; - sp->part = event->part; - sp->frame_or_window = event->frame_or_window; - sp->arg = event->arg; - sp->modifiers = event->modifiers; - sp->x = event->x; - sp->y = event->y; - sp->timestamp = event->timestamp; - } -#else *kbd_store_ptr = *event; -#endif - ++kbd_store_ptr; } } +/* Put an input event back in the head of the event queue. */ + +void +kbd_buffer_unget_event (event) + register struct input_event *event; +{ + if (kbd_fetch_ptr == kbd_buffer) + kbd_fetch_ptr = kbd_buffer + KBD_BUFFER_SIZE; + + /* Don't let the very last slot in the buffer become full, */ + if (kbd_fetch_ptr - 1 != kbd_store_ptr) + { + --kbd_fetch_ptr; + *kbd_fetch_ptr = *event; + } +} + + /* Generate HELP_EVENT input_events in BUFP which has room for SIZE events. If there's not enough room in BUFP, ignore this event. @@ -3942,7 +3932,8 @@ kbd_buffer_get_event (kbp, used_mouse_menu) /* These two kinds of events get special handling and don't actually appear to the command loop. We return nil for them. */ - if (event->kind == SELECTION_REQUEST_EVENT) + if (event->kind == SELECTION_REQUEST_EVENT + || event->kind == SELECTION_CLEAR_EVENT) { #ifdef HAVE_X11 struct input_event copy; @@ -3953,7 +3944,7 @@ kbd_buffer_get_event (kbp, used_mouse_menu) copy = *event; kbd_fetch_ptr = event + 1; input_pending = readable_events (0); - x_handle_selection_request (©); + x_handle_selection_event (©); #else /* We're getting selection request events, but we don't have a window system. */ @@ -3961,22 +3952,6 @@ kbd_buffer_get_event (kbp, used_mouse_menu) #endif } - else if (event->kind == SELECTION_CLEAR_EVENT) - { -#ifdef HAVE_X11 - struct input_event copy; - - /* Remove it from the buffer before processing it. */ - copy = *event; - kbd_fetch_ptr = event + 1; - input_pending = readable_events (0); - x_handle_selection_clear (©); -#else - /* We're getting selection request events, but we don't have - a window system. */ - abort (); -#endif - } #if defined (HAVE_X11) || defined (HAVE_NTGUI) || defined (MAC_OS) else if (event->kind == DELETE_WINDOW_EVENT) { @@ -4201,7 +4176,8 @@ swallow_events (do_display) /* These two kinds of events get special handling and don't actually appear to the command loop. */ - if (event->kind == SELECTION_REQUEST_EVENT) + if (event->kind == SELECTION_REQUEST_EVENT + || event->kind == SELECTION_CLEAR_EVENT) { #ifdef HAVE_X11 struct input_event copy; @@ -4212,25 +4188,7 @@ swallow_events (do_display) copy = *event; kbd_fetch_ptr = event + 1; input_pending = readable_events (0); - x_handle_selection_request (©); -#else - /* We're getting selection request events, but we don't have - a window system. */ - abort (); -#endif - } - - else if (event->kind == SELECTION_CLEAR_EVENT) - { -#ifdef HAVE_X11 - struct input_event copy; - - /* Remove it from the buffer before processing it, */ - copy = *event; - - kbd_fetch_ptr = event + 1; - input_pending = readable_events (0); - x_handle_selection_clear (©); + x_handle_selection_event (©); #else /* We're getting selection request events, but we don't have a window system. */ @@ -11456,7 +11414,8 @@ mark_kboards () { if (event == kbd_buffer + KBD_BUFFER_SIZE) event = kbd_buffer; - if (event->kind != SELECTION_REQUEST_EVENT) + if (event->kind != SELECTION_REQUEST_EVENT + && event->kind != SELECTION_CLEAR_EVENT) { mark_object (event->x); mark_object (event->y); From 87d78665be8f47e32768d30d84ce421dc216c9d0 Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Fri, 5 Nov 2004 11:30:12 +0000 Subject: [PATCH 139/146] (kbd_buffer_unget_event): Add prototype. --- src/keyboard.h | 1 + 1 file changed, 1 insertion(+) diff --git a/src/keyboard.h b/src/keyboard.h index 08cb934d3fe..8df3a2452a7 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -330,6 +330,7 @@ extern int lucid_event_type_list_p P_ ((Lisp_Object)); extern void kbd_buffer_store_event P_ ((struct input_event *)); extern void kbd_buffer_store_event_hold P_ ((struct input_event *, struct input_event *)); +extern void kbd_buffer_unget_event P_ ((struct input_event *)); #ifdef POLL_FOR_INPUT extern void poll_for_input_1 P_ ((void)); #endif From dd0fe424b211c09aae652be0179b6c1658d98776 Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Fri, 5 Nov 2004 11:30:31 +0000 Subject: [PATCH 140/146] * xselect.c (struct selection_event_queue, selection_queue) (x_queue_selection_requests, x_queue_event) (x_start_queuing_selection_requests) (x_stop_queuing_selection_requests): Add new queue for selection input events to replace previous XEvent queue in xterm.c. (queue_selection_requests_unwind): Adapt to new queue. (x_reply_selection_request): Adapt to new queue. Unexpect wait_object in case of x errors (memory leak). (x_handle_selection_request, x_handle_selection_clear): Make static. (x_handle_selection_event): New function. May queue selection events. (wait_for_property_change_unwind): Use save_value instead of cons. Clear property_change_reply_object. (wait_for_property_change): Abort if already waiting. Use save_value instead of cons for unwind data. (x_handle_property_notify): Skip events already arrived, but don't free them, as "arrived" field is checked by wait_for_property_change, and it will be freed by unwind or explicit unexpect_property_change. (x_get_foreign_selection): Add to new queue. (receive_incremental_selection): Don't unexpect wait_object when done as it has already been freed by previous wait_for_property_change. --- src/xselect.c | 162 ++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 130 insertions(+), 32 deletions(-) diff --git a/src/xselect.c b/src/xselect.c index 0d327da85a2..e3698bae9a6 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -32,6 +32,7 @@ Boston, MA 02111-1307, USA. */ #include "buffer.h" #include "process.h" #include "termhooks.h" +#include "keyboard.h" #include @@ -171,6 +172,86 @@ static void lisp_data_to_selection_data (); static Lisp_Object selection_data_to_lisp_data (); static Lisp_Object x_get_window_property_as_lisp_data (); + + +/* Define a queue to save up SelectionRequest events for later handling. */ + +struct selection_event_queue + { + struct input_event event; + struct selection_event_queue *next; + }; + +static struct selection_event_queue *selection_queue; + +/* Nonzero means queue up certain events--don't process them yet. */ + +static int x_queue_selection_requests; + +/* Queue up an X event *EVENT, to be processed later. */ + +static void +x_queue_event (event) + struct input_event *event; +{ + struct selection_event_queue *queue_tmp; + + /* Don't queue repeated requests */ + for (queue_tmp = selection_queue; queue_tmp; queue_tmp = queue_tmp->next) + { + if (!bcmp (&queue_tmp->event, event, sizeof (*event))) + { + TRACE1 ("IGNORE DUP SELECTION EVENT %08x", (unsigned long)queue_tmp); + return; + } + } + + queue_tmp + = (struct selection_event_queue *) xmalloc (sizeof (struct selection_event_queue)); + + if (queue_tmp != NULL) + { + TRACE1 ("QUEUE SELECTION EVENT %08x", (unsigned long)queue_tmp); + queue_tmp->event = *event; + queue_tmp->next = selection_queue; + selection_queue = queue_tmp; + } +} + +/* Start queuing SelectionRequest events. */ + +static void +x_start_queuing_selection_requests () +{ + if (x_queue_selection_requests) + abort (); + + x_queue_selection_requests++; + TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests); +} + +/* Stop queuing SelectionRequest events. */ + +static void +x_stop_queuing_selection_requests () +{ + TRACE1 ("x_stop_queuing_selection_requests %d", x_queue_selection_requests); + --x_queue_selection_requests; + + /* Take all the queued events and put them back + so that they get processed afresh. */ + + while (selection_queue != NULL) + { + struct selection_event_queue *queue_tmp = selection_queue; + TRACE1 ("RESTORE SELECTION EVENT %08x", (unsigned long)queue_tmp); + kbd_buffer_unget_event (&queue_tmp->event); + selection_queue = queue_tmp->next; + xfree ((char *)queue_tmp); + } +} + + /* This converts a Lisp symbol to a server Atom, avoiding a server roundtrip whenever possible. */ @@ -560,13 +641,10 @@ static struct prop_location *property_change_reply_object; static struct prop_location *property_change_wait_list; static Lisp_Object -queue_selection_requests_unwind (frame) - Lisp_Object frame; +queue_selection_requests_unwind (tem) + Lisp_Object tem; { - FRAME_PTR f = XFRAME (frame); - - if (! NILP (frame)) - x_stop_queuing_selection_requests (FRAME_X_DISPLAY (f)); + x_stop_queuing_selection_requests (); return Qnil; } @@ -664,10 +742,10 @@ x_reply_selection_request (event, format, data, size, type) bother trying to queue them. */ if (!NILP (frame)) { - x_start_queuing_selection_requests (display); + x_start_queuing_selection_requests (); record_unwind_protect (queue_selection_requests_unwind, - frame); + Qnil); } if (x_window_to_frame (dpyinfo, window)) /* #### debug */ @@ -701,6 +779,8 @@ x_reply_selection_request (event, format, data, size, type) XGetAtomName (display, reply.property)); wait_for_property_change (wait_object); } + else + unexpect_property_change (wait_object); TRACE0 ("Got ACK"); while (bytes_remaining) @@ -774,7 +854,7 @@ x_reply_selection_request (event, format, data, size, type) /* Handle a SelectionRequest event EVENT. This is called from keyboard.c when such an event is found in the queue. */ -void +static void x_handle_selection_request (event) struct input_event *event; { @@ -789,6 +869,8 @@ x_handle_selection_request (event) struct x_display_info *dpyinfo = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event)); + TRACE0 ("x_handle_selection_request"); + local_selection_data = Qnil; target_symbol = Qnil; converted_selection = Qnil; @@ -883,7 +965,7 @@ x_handle_selection_request (event) client cleared out our previously asserted selection. This is called from keyboard.c when such an event is found in the queue. */ -void +static void x_handle_selection_clear (event) struct input_event *event; { @@ -896,6 +978,8 @@ x_handle_selection_clear (event) struct x_display_info *dpyinfo = x_display_info_for_display (display); struct x_display_info *t_dpyinfo; + TRACE0 ("x_handle_selection_clear"); + /* If the new selection owner is also Emacs, don't clear the new selection. */ BLOCK_INPUT; @@ -964,6 +1048,24 @@ x_handle_selection_clear (event) } } +void +x_handle_selection_event (event) + struct input_event *event; +{ + TRACE0 ("x_handle_selection_event"); + + if (event->kind == SELECTION_REQUEST_EVENT) + { + if (x_queue_selection_requests) + x_queue_event (event); + else + x_handle_selection_request (event); + } + else + x_handle_selection_clear (event); +} + + /* Clear all selections that were made from frame F. We do this when about to delete a frame. */ @@ -1094,12 +1196,14 @@ unexpect_property_change (location) /* Remove the property change expectation element for IDENTIFIER. */ static Lisp_Object -wait_for_property_change_unwind (identifierval) - Lisp_Object identifierval; +wait_for_property_change_unwind (loc) + Lisp_Object loc; { - unexpect_property_change ((struct prop_location *) - (XFASTINT (XCAR (identifierval)) << 16 - | XFASTINT (XCDR (identifierval)))); + struct prop_location *location = XSAVE_VALUE (loc)->pointer; + + unexpect_property_change (location); + if (location == property_change_reply_object) + property_change_reply_object = 0; return Qnil; } @@ -1112,18 +1216,17 @@ wait_for_property_change (location) { int secs, usecs; int count = SPECPDL_INDEX (); - Lisp_Object tem; - tem = Fcons (Qnil, Qnil); - XSETCARFASTINT (tem, (EMACS_UINT)location >> 16); - XSETCDRFASTINT (tem, (EMACS_UINT)location & 0xffff); + if (property_change_reply_object) + abort (); /* Make sure to do unexpect_property_change if we quit or err. */ - record_unwind_protect (wait_for_property_change_unwind, tem); + record_unwind_protect (wait_for_property_change_unwind, + make_save_value (location, 0)); XSETCAR (property_change_reply, Qnil); - property_change_reply_object = location; + /* If the event we are waiting for arrives beyond here, it will set property_change_reply, because property_change_reply_object says so. */ if (! location->arrived) @@ -1154,7 +1257,8 @@ x_handle_property_notify (event) while (rest) { - if (rest->property == event->atom + if (!rest->arrived + && rest->property == event->atom && rest->window == event->window && rest->display == event->display && rest->desired_state == event->state) @@ -1170,11 +1274,6 @@ x_handle_property_notify (event) if (rest == property_change_reply_object) XSETCAR (property_change_reply, Qt); - if (prev) - prev->next = rest->next; - else - property_change_wait_list = rest->next; - xfree (rest); return; } @@ -1300,10 +1399,10 @@ x_get_foreign_selection (selection_symbol, target_type, time_stamp) bother trying to queue them. */ if (!NILP (frame)) { - x_start_queuing_selection_requests (display); + x_start_queuing_selection_requests (); record_unwind_protect (queue_selection_requests_unwind, - frame); + Qnil); } UNBLOCK_INPUT; @@ -1459,10 +1558,10 @@ receive_incremental_selection (display, window, property, target_type, BLOCK_INPUT; XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask); TRACE1 (" Delete property %s", - SDATA (XSYMBOL (x_atom_to_symbol (display, property))->xname)); + SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property)))); XDeleteProperty (display, window, property); TRACE1 (" Expect new value of property %s", - SDATA (XSYMBOL (x_atom_to_symbol (display, property))->xname)); + SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property)))); wait_object = expect_property_change (display, window, property, PropertyNewValue); XFlush (display); @@ -1492,7 +1591,6 @@ receive_incremental_selection (display, window, property, target_type, if (! waiting_for_other_props_on_window (display, window)) XSelectInput (display, window, STANDARD_EVENT_SET); - unexpect_property_change (wait_object); /* Use xfree, not XFree, because x_get_window_property calls xmalloc itself. */ if (tmp_data) xfree (tmp_data); From 958f04e8f01d0a86a2c1411b96c1ab1c910158e1 Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Fri, 5 Nov 2004 11:30:44 +0000 Subject: [PATCH 141/146] * xterm.c (handle_one_xevent): Don't queue X selection events here, it may be too late if we start queuing after we have already stored some selection events into the kbd buffer. (struct selection_event_queue, queue, x_queue_selection_requests) (x_queue_event, x_unqueue_events, x_start_queuing_selection_requests) (x_stop_queuing_selection_requests): Remove/move to xselect.c. (x_catch_errors_unwind): Block input around final XSync. --- src/xterm.c | 81 +++++------------------------------------------------ 1 file changed, 7 insertions(+), 74 deletions(-) diff --git a/src/xterm.c b/src/xterm.c index df99a8667f8..586d0002e8a 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -5574,73 +5574,6 @@ x_scroll_bar_clear (f) #endif /* not USE_TOOLKIT_SCROLL_BARS */ } - -/* Define a queue to save up SelectionRequest events for later handling. */ - -struct selection_event_queue - { - XEvent event; - struct selection_event_queue *next; - }; - -static struct selection_event_queue *queue; - -/* Nonzero means queue up certain events--don't process them yet. */ - -static int x_queue_selection_requests; - -/* Queue up an X event *EVENT, to be processed later. */ - -static void -x_queue_event (f, event) - FRAME_PTR f; - XEvent *event; -{ - struct selection_event_queue *queue_tmp - = (struct selection_event_queue *) xmalloc (sizeof (struct selection_event_queue)); - - if (queue_tmp != NULL) - { - queue_tmp->event = *event; - queue_tmp->next = queue; - queue = queue_tmp; - } -} - -/* Take all the queued events and put them back - so that they get processed afresh. */ - -static void -x_unqueue_events (display) - Display *display; -{ - while (queue != NULL) - { - struct selection_event_queue *queue_tmp = queue; - XPutBackEvent (display, &queue_tmp->event); - queue = queue_tmp->next; - xfree ((char *)queue_tmp); - } -} - -/* Start queuing SelectionRequest events. */ - -void -x_start_queuing_selection_requests (display) - Display *display; -{ - x_queue_selection_requests++; -} - -/* Stop queuing SelectionRequest events. */ - -void -x_stop_queuing_selection_requests (display) - Display *display; -{ - x_queue_selection_requests--; - x_unqueue_events (display); -} /* The main X event-reading loop - XTread_socket. */ @@ -6019,11 +5952,7 @@ handle_one_xevent (dpyinfo, eventp, finish, hold_quit) if (!x_window_to_frame (dpyinfo, event.xselectionrequest.owner)) goto OTHER; #endif /* USE_X_TOOLKIT */ - if (x_queue_selection_requests) - x_queue_event (x_window_to_frame (dpyinfo, event.xselectionrequest.owner), - &event); - else - { + { XSelectionRequestEvent *eventp = (XSelectionRequestEvent *) &event; @@ -6035,7 +5964,7 @@ handle_one_xevent (dpyinfo, eventp, finish, hold_quit) SELECTION_EVENT_PROPERTY (&inev) = eventp->property; SELECTION_EVENT_TIME (&inev) = eventp->time; inev.frame_or_window = Qnil; - } + } break; case PropertyNotify: @@ -7619,7 +7548,11 @@ x_catch_errors_unwind (old_val) /* The display may have been closed before this function is called. Check if it is still open before calling XSync. */ if (x_display_info_for_display (dpy) != 0) - XSync (dpy, False); + { + BLOCK_INPUT; + XSync (dpy, False); + UNBLOCK_INPUT; + } x_error_message_string = XCDR (old_val); return Qnil; From cc68f410e53bb7782501b24eb78645f604afa1a2 Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Fri, 5 Nov 2004 11:31:03 +0000 Subject: [PATCH 142/146] (x_start_queuing_selection_requests) (x_stop_queuing_selection_requests, x_handle_selection_request) (x_handle_selection_clear): Remove prototypes. (x_handle_selection_event): Add prototype. --- src/xterm.h | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/src/xterm.h b/src/xterm.h index 7ec690d2e24..5dd3ecfdef7 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -52,7 +52,7 @@ typedef GtkWidget *xt_or_gtk_widget; #undef XSync #define XSync(d, b) do { gdk_window_process_all_updates (); \ XSync (d, b); } while (0) - + #endif /* USE_GTK */ @@ -973,8 +973,6 @@ int x_alloc_nearest_color P_ ((struct frame *, Colormap, XColor *)); extern void cancel_mouse_face P_ ((struct frame *)); extern void x_scroll_bar_clear P_ ((struct frame *)); -extern void x_start_queuing_selection_requests P_ ((Display *)); -extern void x_stop_queuing_selection_requests P_ ((Display *)); extern int x_text_icon P_ ((struct frame *, char *)); extern int x_bitmap_icon P_ ((struct frame *, Lisp_Object)); extern int x_catch_errors P_ ((Display *)); @@ -1010,8 +1008,7 @@ extern int x_dispatch_event P_ ((XEvent *, Display *)); extern void x_handle_property_notify P_ ((XPropertyEvent *)); extern void x_handle_selection_notify P_ ((XSelectionEvent *)); -extern void x_handle_selection_request P_ ((struct input_event *)); -extern void x_handle_selection_clear P_ ((struct input_event *)); +extern void x_handle_selection_event P_ ((struct input_event *)); extern void x_clear_frame_selections P_ ((struct frame *)); extern int x_handle_dnd_message P_ ((struct frame *, From d4a42098b27cfecb4b22c03e0fe4bc85b0e81d51 Mon Sep 17 00:00:00 2001 From: "Kim F. Storm" Date: Fri, 5 Nov 2004 12:33:07 +0000 Subject: [PATCH 143/146] (Ffile_modes): Doc fix. (auto_save_1): Check for Ffile_modes nil value. --- src/ChangeLog | 5 +++++ src/fileio.c | 27 ++++++++++++++++----------- 2 files changed, 21 insertions(+), 11 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index ce45e97514f..a38c3f7baeb 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2004-11-05 Kim F. Storm + + * fileio.c (Ffile_modes): Doc fix. + (auto_save_1): Check for Ffile_modes nil value. + 2004-11-05 Kim F. Storm * xselect.c (struct selection_event_queue, selection_queue) diff --git a/src/fileio.c b/src/fileio.c index 4b5f4942566..aa37c296eb3 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -3366,7 +3366,8 @@ This is the sort of file that holds an ordinary stream of data bytes. */) } DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0, - doc: /* Return mode bits of file named FILENAME, as an integer. */) + doc: /* Return mode bits of file named FILENAME, as an integer. +Return nil, if file does not exist or is not accessible. */) (filename) Lisp_Object filename; { @@ -5712,17 +5713,21 @@ Lisp_Object auto_save_1 () { struct stat st; + Lisp_Object modes; + + auto_save_mode_bits = 0666; /* Get visited file's mode to become the auto save file's mode. */ - if (! NILP (current_buffer->filename) - && stat (SDATA (current_buffer->filename), &st) >= 0) - /* But make sure we can overwrite it later! */ - auto_save_mode_bits = st.st_mode | 0600; - else if (! NILP (current_buffer->filename)) - /* Remote files don't cooperate with stat. */ - auto_save_mode_bits = XINT (Ffile_modes (current_buffer->filename)) | 0600; - else - auto_save_mode_bits = 0666; + if (! NILP (current_buffer->filename)) + { + if (stat (SDATA (current_buffer->filename), &st) >= 0) + /* But make sure we can overwrite it later! */ + auto_save_mode_bits = st.st_mode | 0600; + else if ((modes = Ffile_modes (current_buffer->filename), + INTEGERP (modes))) + /* Remote files don't cooperate with stat. */ + auto_save_mode_bits = XINT (modes) | 0600; + } return Fwrite_region (Qnil, Qnil, @@ -6190,7 +6195,7 @@ before any other event (mouse or keypress) is handeled. */) #endif return Qnil; } - + DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 6, 0, doc: /* Read file name, prompting with PROMPT and completing in directory DIR. Value is not expanded---you must call `expand-file-name' yourself. From 3296d21b53c19d620538dae1179a6c9d6dc5de8f Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Fri, 5 Nov 2004 19:05:44 +0000 Subject: [PATCH 144/146] *** empty log message *** --- lisp/ChangeLog | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 4620dbb495b..8e55dcd6270 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,11 @@ +2004-11-05 Juri Linkov + + * info.el (Info-search): Don't search in node header lines + and file headers. + + * emacs-lisp/edebug.el (edebug-next-token-class): Allow all + symbol-constituent characters after dot, not only digits. + 2004-11-04 Daniel Pfeiffer * files.el (set-auto-mode): Don't get error after setting From ca53db337fe95e923eb0b030999d313e16b100a9 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Fri, 5 Nov 2004 19:06:24 +0000 Subject: [PATCH 145/146] (Info-search): Don't search in node header lines and file headers. --- lisp/info.el | 26 +++++++++++++++++++++++--- 1 file changed, 23 insertions(+), 3 deletions(-) diff --git a/lisp/info.el b/lisp/info.el index 2e0ddd0fb02..8aaf7755df2 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -1476,11 +1476,21 @@ If DIRECTION is `backward', search in the reverse direction." (save-excursion (save-restriction (widen) + (when backward + ;; Hide Info file header for backward search + (narrow-to-region (save-excursion + (goto-char (point-min)) + (search-forward "\n\^_") + (1- (point))) + (point-max))) (while (and (not give-up) (or (null found) (if backward (isearch-range-invisible found beg-found) - (isearch-range-invisible beg-found found)))) + (isearch-range-invisible beg-found found)) + ;; Skip node header line + (save-excursion (forward-line -1) + (looking-at "\^_")))) (if (if backward (re-search-backward regexp bound t) (re-search-forward regexp bound t)) @@ -1531,14 +1541,24 @@ If DIRECTION is `backward', search in the reverse direction." (while list (message "Searching subfile %s..." (cdr (car list))) (Info-read-subfile (car (car list))) - (if backward (goto-char (point-max))) + (when backward + ;; Hide Info file header for backward search + (narrow-to-region (save-excursion + (goto-char (point-min)) + (search-forward "\n\^_") + (1- (point))) + (point-max)) + (goto-char (point-max))) (setq list (cdr list)) (setq give-up nil found nil) (while (and (not give-up) (or (null found) (if backward (isearch-range-invisible found beg-found) - (isearch-range-invisible beg-found found)))) + (isearch-range-invisible beg-found found)) + ;; Skip node header line + (save-excursion (forward-line -1) + (looking-at "\^_")))) (if (if backward (re-search-backward regexp nil t) (re-search-forward regexp nil t)) From 392cf16dd0ee9358f8af0cd0d8048b822456bbeb Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Fri, 5 Nov 2004 19:07:07 +0000 Subject: [PATCH 146/146] (edebug-next-token-class): Allow all symbol-constituent characters after dot, not only digits. --- lisp/emacs-lisp/edebug.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 9a7b9efc333..0a6e3fed349 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -714,8 +714,10 @@ already is one.)" (if (and (eq (following-char) ?.) (save-excursion (forward-char 1) - (and (>= (following-char) ?0) - (<= (following-char) ?9)))) + (or (and (eq (aref edebug-read-syntax-table (following-char)) + 'symbol) + (not (= (following-char) ?\;))) + (memq (following-char) '(?\, ?\.))))) 'symbol (aref edebug-read-syntax-table (following-char))))