aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorMiles Bader2004-07-23 04:30:44 +0000
committerMiles Bader2004-07-23 04:30:44 +0000
commit6bb4a8bf9aaa63141ad7c12ab6b6ba9939050178 (patch)
treeffe1b6fc55a6ef858938f3e80a9fd79ae096ad10 /lisp
parentcd9fc52e16bd2c780919c927bbf734039dd9a7dc (diff)
parent9586e1d3a4255c58bf827400ab7c038a3ee988a3 (diff)
downloademacs-6bb4a8bf9aaa63141ad7c12ab6b6ba9939050178.tar.gz
emacs-6bb4a8bf9aaa63141ad7c12ab6b6ba9939050178.zip
Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-25
Merge from emacs--cvs-trunk--0 Patches applied: * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-459 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-463 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-464 Update from CVS: lisp/progmodes/make-mode.el: Fix comments. * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-465 Update from CVS
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog116
-rw-r--r--lisp/autorevert.el12
-rw-r--r--lisp/dired-aux.el40
-rw-r--r--lisp/emacs-lisp/testcover.el223
-rw-r--r--lisp/font-lock.el12
-rw-r--r--lisp/frame.el2
-rw-r--r--lisp/mail/footnote.el7
-rw-r--r--lisp/net/tramp-smb.el2
-rw-r--r--lisp/net/tramp-vc.el18
-rw-r--r--lisp/net/tramp.el210
-rw-r--r--lisp/printing.el51
-rw-r--r--lisp/progmodes/make-mode.el6
-rw-r--r--lisp/progmodes/which-func.el28
-rw-r--r--lisp/ps-print.el47
-rw-r--r--lisp/replace.el3
-rw-r--r--lisp/textmodes/fill.el7
16 files changed, 539 insertions, 245 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 6b2d3eb4145..3ece6ce0fb8 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,119 @@
12004-07-22 Vinicius Jose Latorre <viniciusjl@ig.com.br>
2
3 * ps-print.el: Doc fix. Improve the DSC compliance of the generated
4 PostScript. Suggested by Michael Piotrowski <mxp@dynalabs.de>.
5 (ps-print-version): New version 6.6.5.
6 (ps-printing-region): Doc fix.
7 (ps-generate-string-list): Comment fix.
8 (ps-message-log-max, ps-begin-file): Code fix.
9
102004-07-22 Kim F. Storm <storm@cua.dk>
11
12 * progmodes/make-mode.el: Fix comments.
13
142004-07-21 Vinicius Jose Latorre <viniciusjl@ig.com.br>
15
16 * printing.el: Doc fix.
17
182004-07-20 Luc Teirlinck <teirllm@auburn.edu>
19
20 * frame.el (modify-all-frames-parameters): Minor doc fix.
21
222004-07-20 Richard M. Stallman <rms@gnu.org>
23
24 * textmodes/fill.el (fill-comment-paragraph): Handle indent-tabs-mode.
25 (fill-delete-newlines): Call sentence-end as function.
26 (fill-nobreak-p, canonically-space-region): Likewise.
27 (fill-nobreak-p): If this break point is at the end of the line,
28 don't consider the newline which follows as a reason to return t.
29
302004-07-19 John Paul Wallington <jpw@gnu.org>
31
32 * dired-aux.el (dired-file-set-difference): Don't use `caddr'.
33
342004-07-18 Luc Teirlinck <teirllm@auburn.edu>
35
36 * dired-aux.el (dired-do-kill-lines): Expand docstring.
37 Delete irrelevant code.
38
392004-07-17 Kai Grossjohann <kai.grossjohann@gmx.net>
40
41 * net/tramp.el (tramp-handle-verify-visited-file-modtime): New
42 docstring. From Luc Teirlinck.
43
442004-07-17 Luc Teirlinck <teirllm@auburn.edu>
45
46 * autorevert.el: Describe `Auto Revert Tail Mode' in `Commentary'
47 section.
48 (auto-revert-handler): Do not check `auto-revert-tail-mode' for
49 non-file buffers. We know it is nil.
50
512004-07-17 Kai Grossjohann <kai.grossjohann@gmx.net>
52
53 Sync with Tramp 2.0.43.
54
55 * net/tramp.el (tramp-handle-verify-visited-file-modtime): Remove
56 outdated comment.
57 (tramp-locked, tramp-locker): New variables for implementing a
58 global lock.
59 (tramp-sh-file-name-handler): Use them to implement the global
60 lock.
61
622004-07-13 Michael Albinus <michael.albinus@gmx.de>
63
64 * net/tramp.el (all): Code cleanup. Change all `tramp-handle-xxx'
65 calls to respective `xxx` calls.
66 (tramp-process-alive-regexp): Precise doc string.
67 (tramp-multi-action-process-alive): New defun.
68 (tramp-multi-actions): Use it.
69 (tramp-handle-find-backup-file-name): `copy-tree' is available
70 since Emacs 21.4 only (XEmacs has it). Implementation rewritten
71 in order to avoid this function.
72 (tramp-handle-write-region): Set current buffer. If connection
73 wasn't open, `file-modes' has changed it accidently. Reported by
74 David Kastrup <dak@gnu.org>.
75 (tramp-enter-password, tramp-read-passwd): New arguments USER and
76 HOST.
77 (tramp-action-password, tramp-multi-action-password): Apply it.
78 (tramp-open-connection-rsh): If a port is given, the Tramp buffer
79 name must still contain the port number. Otherwise, we have two
80 Tramp buffers, with all the confusion. Reported by Myron Selby
81 <myron@xytech.com> and Rolf Dubitzky
82 <Dubitzky@physi.uni-heidelberg.de>.
83
84 * net/tramp-smb.el (tramp-smb-open-connection): Apply USER and
85 HOST to `tramp-enter-passwd'.
86
87 * net/tramp-vc.el (all): Code cleanup. Change all
88 `tramp-handle-xxx' calls to respective `xxx` calls.
89
902004-07-17 Jonathan Yavner <jyavner@member.fsf.org>
91
92 * emacs-lisp/testcover.el: New category "potentially-1valued" for
93 functions that are not erroneous if either 1-valued or
94 multi-valued. Detect functions in this class.
95 (testcover-1value-functions, testcover-compose-functions,
96 testcover-progn-functions) Added some additional functions to lists.
97 (testcover-mark): Bugfix when marking up the definition for an
98 empty function.
99
1002004-07-17 Richard M. Stallman <rms@gnu.org>
101
102 * replace.el (occur-read-primary-args): Pass default to read-from-minibuffer.
103
104 * mail/footnote.el (footnote-section-tag): Use defcustom.
105
106 * font-lock.el (font-lock-add-keywords, font-lock-remove-keywords):
107 Compile font-lock-keywords, not KEYWORDS.
108 (lisp-font-lock-keywords-2): Add multiple-value-prog1, go.
109 Add warn, check-type. Handle cerror like error.
110
1112004-07-14 Daniel Pfeiffer <occitan@esperanto.org>
112
113 * progmodes/which-func.el (which-func-keymap): New var.
114 (which-func-face): New face.
115 (which-func-format): Use them.
116
12004-07-16 Stephan Stahl <stahl@eos.franken.de> (tiny change) 1172004-07-16 Stephan Stahl <stahl@eos.franken.de> (tiny change)
2 118
3 * buff-menu.el (list-buffers-noselect): Append the buffer's 119 * buff-menu.el (list-buffers-noselect): Append the buffer's
diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index 596c7ff8997..ef438eb4b97 100644
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -34,7 +34,8 @@
34;; 34;;
35;; This package contains two minor modes: Global Auto-Revert Mode and 35;; This package contains two minor modes: Global Auto-Revert Mode and
36;; Auto-Revert Mode. Both modes automatically revert buffers 36;; Auto-Revert Mode. Both modes automatically revert buffers
37;; whenever the corresponding files have been changed on disk. 37;; whenever the corresponding files have been changed on disk and the
38;; buffer contains no unsaved changes.
38;; 39;;
39;; Auto-Revert Mode can be activated for individual buffers. Global 40;; Auto-Revert Mode can be activated for individual buffers. Global
40;; Auto-Revert Mode applies to all file buffers. (If the user option 41;; Auto-Revert Mode applies to all file buffers. (If the user option
@@ -59,6 +60,13 @@
59;; Just put point at the end of the buffer and it will stay there. 60;; Just put point at the end of the buffer and it will stay there.
60;; These rules apply to file buffers. For non-file buffers, the 61;; These rules apply to file buffers. For non-file buffers, the
61;; behavior may be mode dependent. 62;; behavior may be mode dependent.
63;;
64;; While you can use Auto Revert Mode to tail a file, this package
65;; contains a third minor mode, Auto Revert Tail Mode, which does so
66;; more efficiently, as long as you are sure that the file will only
67;; change by growing at the end. It only appends the new output,
68;; instead of reverting the entire buffer. It does so even if the
69;; buffer contains unsaved changes. (Because they will not be lost.)
62 70
63;; Usage: 71;; Usage:
64;; 72;;
@@ -389,7 +397,7 @@ This is an internal function used by Auto-Revert Mode."
389 (not (file-remote-p buffer-file-name)) 397 (not (file-remote-p buffer-file-name))
390 (file-readable-p buffer-file-name) 398 (file-readable-p buffer-file-name)
391 (not (verify-visited-file-modtime buffer))) 399 (not (verify-visited-file-modtime buffer)))
392 (and (or auto-revert-mode auto-revert-tail-mode 400 (and (or auto-revert-mode
393 global-auto-revert-non-file-buffers) 401 global-auto-revert-non-file-buffers)
394 revert-buffer-function 402 revert-buffer-function
395 (boundp 'buffer-stale-function) 403 (boundp 'buffer-stale-function)
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index bf7c9c00d18..6c1a9ad36f0 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -163,8 +163,8 @@ condition. Two file items are considered to match if they are equal
163 (unless (let ((list list2)) 163 (unless (let ((list list2))
164 (while (and list 164 (while (and list
165 (not (let* ((file2 (car list)) 165 (not (let* ((file2 (car list))
166 (fa1 (caddr file1)) 166 (fa1 (car (cddr file1)))
167 (fa2 (caddr file2)) 167 (fa2 (car (cddr file2)))
168 (size1 (nth 7 fa1)) 168 (size1 (nth 7 fa1))
169 (size2 (nth 7 fa2)) 169 (size2 (nth 7 fa2))
170 (mtime1 (float-time (nth 5 fa1))) 170 (mtime1 (float-time (nth 5 fa1)))
@@ -627,9 +627,14 @@ the list of file names explicitly with the FILE-LIST argument."
627(defun dired-do-kill-lines (&optional arg fmt) 627(defun dired-do-kill-lines (&optional arg fmt)
628 "Kill all marked lines (not the files). 628 "Kill all marked lines (not the files).
629With a prefix argument, kill that many lines starting with the current line. 629With a prefix argument, kill that many lines starting with the current line.
630\(A negative argument kills lines before the current line.) 630\(A negative argument kills backward.)
631To kill an entire subdirectory, go to its directory header line 631If you use this command with a prefix argument to kill the line
632and use this command with a prefix argument (the value does not matter)." 632for a file that is a directory, which you have inserted in the
633Dired buffer as a subdirectory, then it deletes that subdirectory
634from the buffer as well.
635To kill an entire subdirectory \(without killing its line in the
636parent directory), go to its directory header line and use this
637command with a prefix argument (the value does not matter)."
633 ;; Returns count of killed lines. FMT="" suppresses message. 638 ;; Returns count of killed lines. FMT="" suppresses message.
634 (interactive "P") 639 (interactive "P")
635 (if arg 640 (if arg
@@ -638,23 +643,14 @@ and use this command with a prefix argument (the value does not matter)."
638 (dired-kill-line arg)) 643 (dired-kill-line arg))
639 (save-excursion 644 (save-excursion
640 (goto-char (point-min)) 645 (goto-char (point-min))
641 (let (buffer-read-only (count 0)) 646 (let (buffer-read-only
642 (if (not arg) ; kill marked lines 647 (count 0)
643 (let ((regexp (dired-marker-regexp))) 648 (regexp (dired-marker-regexp)))
644 (while (and (not (eobp)) 649 (while (and (not (eobp))
645 (re-search-forward regexp nil t)) 650 (re-search-forward regexp nil t))
646 (setq count (1+ count)) 651 (setq count (1+ count))
647 (delete-region (progn (beginning-of-line) (point)) 652 (delete-region (progn (beginning-of-line) (point))
648 (progn (forward-line 1) (point))))) 653 (progn (forward-line 1) (point))))
649 ;; else kill unmarked lines
650 (while (not (eobp))
651 (if (or (dired-between-files)
652 (not (looking-at "^ ")))
653 (forward-line 1)
654 (setq count (1+ count))
655 (delete-region (point) (save-excursion
656 (forward-line 1)
657 (point))))))
658 (or (equal "" fmt) 654 (or (equal "" fmt)
659 (message (or fmt "Killed %d line%s.") count (dired-plural-s count))) 655 (message (or fmt "Killed %d line%s.") count (dired-plural-s count)))
660 count)))) 656 count))))
diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el
index 547e2cbd32d..23e9a54b1bb 100644
--- a/lisp/emacs-lisp/testcover.el
+++ b/lisp/emacs-lisp/testcover.el
@@ -38,9 +38,9 @@
38;; instrumentation callbacks, then replace edebug's callbacks with ours. 38;; instrumentation callbacks, then replace edebug's callbacks with ours.
39;; * To show good coverage, we want to see two values for every form, except 39;; * To show good coverage, we want to see two values for every form, except
40;; functions that always return the same value and `defconst' variables 40;; functions that always return the same value and `defconst' variables
41;; need show only value for good coverage. To avoid the brown splotch, the 41;; need show only one value for good coverage. To avoid the brown
42;; definitions for constants and 1-valued functions must precede the 42;; splotch, the definitions for constants and 1-valued functions must
43;; references. 43;; precede the references.
44;; * Use the macro `1value' in your Lisp code to mark spots where the local 44;; * Use the macro `1value' in your Lisp code to mark spots where the local
45;; code environment causes a function or variable to always have the same 45;; code environment causes a function or variable to always have the same
46;; value, but the function or variable is not intrinsically 1-valued. 46;; value, but the function or variable is not intrinsically 1-valued.
@@ -55,12 +55,14 @@
55;; call has the same value! Also, equal thinks two strings are the same 55;; call has the same value! Also, equal thinks two strings are the same
56;; if they differ only in properties. 56;; if they differ only in properties.
57;; * Because we have only a "1value" class and no "always nil" class, we have 57;; * Because we have only a "1value" class and no "always nil" class, we have
58;; to treat as 1-valued any `and' whose last term is 1-valued, in case the 58;; to treat as potentially 1-valued any `and' whose last term is 1-valued,
59;; last term is always nil. Example: 59;; in case the last term is always nil. Example:
60;; (and (< (point) 1000) (forward-char 10)) 60;; (and (< (point) 1000) (forward-char 10))
61;; This form always returns nil. Similarly, `if' and `cond' are 61;; This form always returns nil. Similarly, `or', `if', and `cond' are
62;; treated as 1-valued if all clauses are, in case those values are 62;; treated as potentially 1-valued if all clauses are, in case those
63;; always nil. 63;; values are always nil. Unlike truly 1-valued functions, it is not an
64;; error if these "potentially" 1-valued forms actually return differing
65;; values.
64 66
65(require 'edebug) 67(require 'edebug)
66(provide 'testcover) 68(provide 'testcover)
@@ -86,12 +88,14 @@ these. This list is quite incomplete!"
86 88
87(defcustom testcover-1value-functions 89(defcustom testcover-1value-functions
88 '(backward-char barf-if-buffer-read-only beginning-of-line 90 '(backward-char barf-if-buffer-read-only beginning-of-line
89 buffer-disable-undo buffer-enable-undo current-global-map deactivate-mark 91 buffer-disable-undo buffer-enable-undo current-global-map
90 delete-char delete-region ding error forward-char function* insert 92 deactivate-mark delete-backward-char delete-char delete-region ding
91 insert-and-inherit kill-all-local-variables lambda mapc narrow-to-region 93 forward-char function* insert insert-and-inherit kill-all-local-variables
92 noreturn push-mark put-text-property run-hooks set-text-properties signal 94 kill-line kill-paragraph kill-region kill-sexp lambda
93 substitute-key-definition suppress-keymap throw undo use-local-map while 95 minibuffer-complete-and-exit narrow-to-region next-line push-mark
94 widen yank) 96 put-text-property run-hooks set-match-data signal
97 substitute-key-definition suppress-keymap undo use-local-map while widen
98 yank)
95 "Functions that always return the same value. No brown splotch is shown 99 "Functions that always return the same value. No brown splotch is shown
96for these. This list is quite incomplete! Notes: Nobody ever changes the 100for these. This list is quite incomplete! Notes: Nobody ever changes the
97current global map. The macro `lambda' is self-evaluating, hence always 101current global map. The macro `lambda' is self-evaluating, hence always
@@ -108,9 +112,9 @@ them as having returned nil just before calling them."
108 :type 'hook) 112 :type 'hook)
109 113
110(defcustom testcover-compose-functions 114(defcustom testcover-compose-functions
111 '(+ - * / length list make-keymap make-sparse-keymap message propertize 115 '(+ - * / = append length list make-keymap make-sparse-keymap
112 replace-regexp-in-string run-with-idle-timer 116 mapcar message propertize replace-regexp-in-string
113 set-buffer-modified-p) 117 run-with-idle-timer set-buffer-modified-p)
114 "Functions that are 1-valued if all their args are either constants or 118 "Functions that are 1-valued if all their args are either constants or
115calls to one of the `testcover-1value-functions', so if that's true then no 119calls to one of the `testcover-1value-functions', so if that's true then no
116brown splotch is shown for these. This list is quite incomplete! Most 120brown splotch is shown for these. This list is quite incomplete! Most
@@ -119,16 +123,16 @@ side-effect-free functions should be here."
119 :type 'hook) 123 :type 'hook)
120 124
121(defcustom testcover-progn-functions 125(defcustom testcover-progn-functions
122 '(define-key fset function goto-char or overlay-put progn save-current-buffer 126 '(define-key fset function goto-char mapc overlay-put progn
123 save-excursion save-match-data save-restriction save-selected-window 127 save-current-buffer save-excursion save-match-data
124 save-window-excursion set set-default setq setq-default 128 save-restriction save-selected-window save-window-excursion
125 with-output-to-temp-buffer with-syntax-table with-temp-buffer 129 set set-default set-marker-insertion-type setq setq-default
126 with-temp-file with-temp-message with-timeout) 130 with-current-buffer with-output-to-temp-buffer with-syntax-table
131 with-temp-buffer with-temp-file with-temp-message with-timeout)
127 "Functions whose return value is the same as their last argument. No 132 "Functions whose return value is the same as their last argument. No
128brown splotch is shown for these if the last argument is a constant or a 133brown splotch is shown for these if the last argument is a constant or a
129call to one of the `testcover-1value-functions'. This list is probably 134call to one of the `testcover-1value-functions'. This list is probably
130incomplete! Note: `or' is here in case the last argument is a function that 135incomplete!"
131always returns nil."
132 :group 'testcover 136 :group 'testcover
133 :type 'hook) 137 :type 'hook)
134 138
@@ -140,6 +144,11 @@ call to one of the `testcover-1value-functions'."
140 :group 'testcover 144 :group 'testcover
141 :type 'hook) 145 :type 'hook)
142 146
147(defcustom testcover-potentially-1value-functions
148 '(add-hook and beep or remove-hook unless when)
149 "Functions that are potentially 1-valued. No brown splotch if actually
1501-valued, no error if actually multi-valued.")
151
143(defface testcover-nohits-face 152(defface testcover-nohits-face
144 '((t (:background "DeepPink2"))) 153 '((t (:background "DeepPink2")))
145 "Face for forms that had no hits during coverage test" 154 "Face for forms that had no hits during coverage test"
@@ -161,7 +170,11 @@ call to one of the `testcover-1value-functions'."
161 170
162(defvar testcover-module-1value-functions nil 171(defvar testcover-module-1value-functions nil
163 "Symbols declared with defun in the last file processed by 172 "Symbols declared with defun in the last file processed by
164`testcover-start', whose functions always return the same value.") 173`testcover-start', whose functions should always return the same value.")
174
175(defvar testcover-module-potentially-1value-functions nil
176 "Symbols declared with defun in the last file processed by
177`testcover-start', whose functions might always return the same value.")
165 178
166(defvar testcover-vector nil 179(defvar testcover-vector nil
167 "Locally bound to coverage vector for function in progress.") 180 "Locally bound to coverage vector for function in progress.")
@@ -206,25 +219,32 @@ non-nil, byte-compiles each function after instrumenting."
206 x)) 219 x))
207 220
208(defun testcover-reinstrument (form) 221(defun testcover-reinstrument (form)
209 "Reinstruments FORM to use testcover instead of edebug. This function 222 "Reinstruments FORM to use testcover instead of edebug. This
210modifies the list that FORM points to. Result is non-nil if FORM will 223function modifies the list that FORM points to. Result is nil if
211always return the same value." 224FORM should return multiple vlues, t if should always return same
225value, 'maybe if either is acceptable."
212 (let ((fun (car-safe form)) 226 (let ((fun (car-safe form))
213 id) 227 id val)
214 (cond 228 (cond
215 ((not fun) ;Atom 229 ((not fun) ;Atom
216 (or (not (symbolp form)) 230 (when (or (not (symbolp form))
217 (memq form testcover-constants) 231 (memq form testcover-constants)
218 (memq form testcover-module-constants))) 232 (memq form testcover-module-constants))
219 ((consp fun) ;Embedded list 233 t))
234 ((consp fun) ;Embedded list
220 (testcover-reinstrument fun) 235 (testcover-reinstrument fun)
221 (testcover-reinstrument-list (cdr form)) 236 (testcover-reinstrument-list (cdr form))
222 nil) 237 nil)
223 ((or (memq fun testcover-1value-functions) 238 ((or (memq fun testcover-1value-functions)
224 (memq fun testcover-module-1value-functions)) 239 (memq fun testcover-module-1value-functions))
225 ;;Always return same value 240 ;;Should always return same value
226 (testcover-reinstrument-list (cdr form)) 241 (testcover-reinstrument-list (cdr form))
227 t) 242 t)
243 ((or (memq fun testcover-potentially-1value-functions)
244 (memq fun testcover-module-potentially-1value-functions))
245 ;;Might always return same value
246 (testcover-reinstrument-list (cdr form))
247 'maybe)
228 ((memq fun testcover-progn-functions) 248 ((memq fun testcover-progn-functions)
229 ;;1-valued if last argument is 249 ;;1-valued if last argument is
230 (testcover-reinstrument-list (cdr form))) 250 (testcover-reinstrument-list (cdr form)))
@@ -233,11 +253,9 @@ always return the same value."
233 (testcover-reinstrument-list (cddr form)) 253 (testcover-reinstrument-list (cddr form))
234 (testcover-reinstrument (cadr form))) 254 (testcover-reinstrument (cadr form)))
235 ((memq fun testcover-compose-functions) 255 ((memq fun testcover-compose-functions)
236 ;;1-valued if all arguments are 256 ;;1-valued if all arguments are. Potentially 1-valued if all
237 (setq id t) 257 ;;arguments are either definitely or potentially.
238 (mapc #'(lambda (x) (setq id (or (testcover-reinstrument x) id))) 258 (testcover-reinstrument-compose (cdr form) 'testcover-reinstrument))
239 (cdr form))
240 id)
241 ((eq fun 'edebug-enter) 259 ((eq fun 'edebug-enter)
242 ;;(edebug-enter 'SYM ARGS #'(lambda nil FORMS)) 260 ;;(edebug-enter 'SYM ARGS #'(lambda nil FORMS))
243 ;; => (testcover-enter 'SYM #'(lambda nil FORMS)) 261 ;; => (testcover-enter 'SYM #'(lambda nil FORMS))
@@ -252,33 +270,44 @@ always return the same value."
252 (aset testcover-vector (cadr (cadr form)) 'ok-coverage)) 270 (aset testcover-vector (cadr (cadr form)) 'ok-coverage))
253 (setq id (nth 2 form)) 271 (setq id (nth 2 form))
254 (setcdr form (nthcdr 2 form)) 272 (setcdr form (nthcdr 2 form))
273 (setq val (testcover-reinstrument (nth 2 form)))
274 (if (eq val t)
275 (setcar form 'testcover-1value)
276 (setcar form 'testcover-after))
277 (when val
278 ;;1-valued or potentially 1-valued
279 (aset testcover-vector id '1value))
255 (cond 280 (cond
256 ((memq (car-safe (nth 2 form)) testcover-noreturn-functions) 281 ((memq (car-safe (nth 2 form)) testcover-noreturn-functions)
257 ;;This function won't return, so set the value in advance 282 ;;This function won't return, so set the value in advance
258 ;;(edebug-after (edebug-before XXX) YYY FORM) 283 ;;(edebug-after (edebug-before XXX) YYY FORM)
259 ;; => (progn (edebug-after YYY nil) FORM) 284 ;; => (progn (edebug-after YYY nil) FORM)
285 (setcar (cdr form) `(,(car form) ,id nil))
260 (setcar form 'progn) 286 (setcar form 'progn)
261 (setcar (cdr form) `(testcover-after ,id nil))) 287 (aset testcover-vector id '1value)
288 (setq val t))
262 ((eq (car-safe (nth 2 form)) '1value) 289 ((eq (car-safe (nth 2 form)) '1value)
263 ;;This function is always supposed to return the same value 290 ;;This function is always supposed to return the same value
264 (setcar form 'testcover-1value)) 291 (setq val t)
265 (t 292 (aset testcover-vector id '1value)
266 (setcar form 'testcover-after))) 293 (setcar form 'testcover-1value)))
267 (when (testcover-reinstrument (nth 2 form)) 294 val)
268 (aset testcover-vector id '1value)))
269 ((eq fun 'defun) 295 ((eq fun 'defun)
270 (if (testcover-reinstrument-list (nthcdr 3 form)) 296 (setq val (testcover-reinstrument-list (nthcdr 3 form)))
271 (push (cadr form) testcover-module-1value-functions))) 297 (when (eq val t)
272 ((eq fun 'defconst) 298 (push (cadr form) testcover-module-1value-functions))
299 (when (eq val 'maybe)
300 (push (cadr form) testcover-module-potentially-1value-functions)))
301 ((memq fun '(defconst defcustom))
273 ;;Define this symbol as 1-valued 302 ;;Define this symbol as 1-valued
274 (push (cadr form) testcover-module-constants) 303 (push (cadr form) testcover-module-constants)
275 (testcover-reinstrument-list (cddr form))) 304 (testcover-reinstrument-list (cddr form)))
276 ((memq fun '(dotimes dolist)) 305 ((memq fun '(dotimes dolist))
277 ;;Always returns third value from SPEC 306 ;;Always returns third value from SPEC
278 (testcover-reinstrument-list (cddr form)) 307 (testcover-reinstrument-list (cddr form))
279 (setq fun (testcover-reinstrument-list (cadr form))) 308 (setq val (testcover-reinstrument-list (cadr form)))
280 (if (nth 2 (cadr form)) 309 (if (nth 2 (cadr form))
281 fun 310 val
282 ;;No third value, always returns nil 311 ;;No third value, always returns nil
283 t)) 312 t))
284 ((memq fun '(let let*)) 313 ((memq fun '(let let*))
@@ -286,23 +315,23 @@ always return the same value."
286 (mapc 'testcover-reinstrument-list (cadr form)) 315 (mapc 'testcover-reinstrument-list (cadr form))
287 (testcover-reinstrument-list (cddr form))) 316 (testcover-reinstrument-list (cddr form)))
288 ((eq fun 'if) 317 ((eq fun 'if)
289 ;;1-valued if both THEN and ELSE clauses are 318 ;;Potentially 1-valued if both THEN and ELSE clauses are
290 (testcover-reinstrument (cadr form)) 319 (testcover-reinstrument (cadr form))
291 (let ((then (testcover-reinstrument (nth 2 form))) 320 (let ((then (testcover-reinstrument (nth 2 form)))
292 (else (testcover-reinstrument-list (nthcdr 3 form)))) 321 (else (testcover-reinstrument-list (nthcdr 3 form))))
293 (and then else))) 322 (and then else 'maybe)))
294 ((memq fun '(when unless and))
295 ;;1-valued if last clause of BODY is
296 (testcover-reinstrument-list (cdr form)))
297 ((eq fun 'cond) 323 ((eq fun 'cond)
298 ;;1-valued if all clauses are 324 ;;Potentially 1-valued if all clauses are
299 (testcover-reinstrument-clauses (cdr form))) 325 (when (testcover-reinstrument-compose (cdr form)
326 'testcover-reinstrument-list)
327 'maybe))
300 ((eq fun 'condition-case) 328 ((eq fun 'condition-case)
301 ;;1-valued if BODYFORM is and all HANDLERS are 329 ;;Potentially 1-valued if BODYFORM is and all HANDLERS are
302 (let ((body (testcover-reinstrument (nth 2 form))) 330 (let ((body (testcover-reinstrument (nth 2 form)))
303 (errs (testcover-reinstrument-clauses (mapcar #'cdr 331 (errs (testcover-reinstrument-compose
304 (nthcdr 3 form))))) 332 (mapcar #'cdr (nthcdr 3 form))
305 (and body errs))) 333 'testcover-reinstrument-list)))
334 (and body errs 'maybe)))
306 ((eq fun 'quote) 335 ((eq fun 'quote)
307 ;;Don't reinstrument what's inside! 336 ;;Don't reinstrument what's inside!
308 ;;This doesn't apply within a backquote 337 ;;This doesn't apply within a backquote
@@ -317,16 +346,55 @@ always return the same value."
317 (let ((testcover-1value-functions 346 (let ((testcover-1value-functions
318 (remq 'quote testcover-1value-functions))) 347 (remq 'quote testcover-1value-functions)))
319 (testcover-reinstrument (cadr form)))) 348 (testcover-reinstrument (cadr form))))
320 ((memq fun '(1value noreturn)) 349 ((eq fun '1value)
321 ;;Hack - pretend the arg is 1-valued here 350 ;;Hack - pretend the arg is 1-valued here
322 (if (symbolp (cadr form)) ;A pseudoconstant variable 351 (cond
323 t 352 ((symbolp (cadr form))
353 ;;A pseudoconstant variable
354 t)
355 ((and (eq (car (cadr form)) 'edebug-after)
356 (symbolp (nth 3 (cadr form))))
357 ;;Reference to pseudoconstant
358 (aset testcover-vector (nth 2 (cadr form)) '1value)
359 (setcar (cdr form) `(testcover-1value ,(nth 2 (cadr form))
360 ,(nth 3 (cadr form))))
361 t)
362 (t
324 (if (eq (car (cadr form)) 'edebug-after) 363 (if (eq (car (cadr form)) 'edebug-after)
325 (setq id (car (nth 3 (cadr form)))) 364 (setq id (car (nth 3 (cadr form))))
326 (setq id (car (cadr form)))) 365 (setq id (car (cadr form))))
327 (let ((testcover-1value-functions 366 (let ((testcover-1value-functions
328 (cons id testcover-1value-functions))) 367 (cons id testcover-1value-functions)))
329 (testcover-reinstrument (cadr form))))) 368 (testcover-reinstrument (cadr form))))))
369 ((eq fun 'noreturn)
370 ;;Hack - pretend the arg has no return
371 (cond
372 ((symbolp (cadr form))
373 ;;A pseudoconstant variable
374 'maybe)
375 ((and (eq (car (cadr form)) 'edebug-after)
376 (symbolp (nth 3 (cadr form))))
377 ;;Reference to pseudoconstant
378 (aset testcover-vector (nth 2 (cadr form)) '1value)
379 (setcar (cdr form) `(progn (testcover-after ,(nth 2 (cadr form)) nil)
380 ,(nth 3 (cadr form))))
381 'maybe)
382 (t
383 (if (eq (car (cadr form)) 'edebug-after)
384 (setq id (car (nth 3 (cadr form))))
385 (setq id (car (cadr form))))
386 (let ((testcover-noreturn-functions
387 (cons id testcover-noreturn-functions)))
388 (testcover-reinstrument (cadr form))))))
389 ((and (eq fun 'apply)
390 (eq (car-safe (cadr form)) 'quote)
391 (symbolp (cadr (cadr form))))
392 ;;Apply of a constant symbol. Process as 1value or noreturn
393 ;;depending on symbol.
394 (setq fun (cons (cadr (cadr form)) (cddr form))
395 val (testcover-reinstrument fun))
396 (setcdr (cdr form) (cdr fun))
397 val)
330 (t ;Some other function or weird thing 398 (t ;Some other function or weird thing
331 (testcover-reinstrument-list (cdr form)) 399 (testcover-reinstrument-list (cdr form))
332 nil)))) 400 nil))))
@@ -341,13 +409,22 @@ always be nil, so we return t for 1-valued."
341 (setq result (testcover-reinstrument (pop list)))) 409 (setq result (testcover-reinstrument (pop list))))
342 result)) 410 result))
343 411
344(defun testcover-reinstrument-clauses (clauselist) 412(defun testcover-reinstrument-compose (list fun)
345 "Reinstrument each list in CLAUSELIST. 413 "For a compositional function, the result is 1-valued if all
346Result is t if every clause is 1-valued." 414arguments are, potentially 1-valued if all arguments are either
415definitely or potentially 1-valued, and multi-valued otherwise.
416FUN should be `testcover-reinstrument' for compositional functions,
417 `testcover-reinstrument-list' for clauses in a `cond'."
347 (let ((result t)) 418 (let ((result t))
348 (mapc #'(lambda (x) 419 (mapc #'(lambda (x)
349 (setq result (and (testcover-reinstrument-list x) result))) 420 (setq x (funcall fun x))
350 clauselist) 421 (cond
422 ((eq result t)
423 (setq result x))
424 ((eq result 'maybe)
425 (when (not x)
426 (setq result nil)))))
427 list)
351 result)) 428 result))
352 429
353(defun testcover-end (buffer) 430(defun testcover-end (buffer)
@@ -387,7 +464,7 @@ same value during coverage testing."
387 (aset testcover-vector idx (cons '1value val))) 464 (aset testcover-vector idx (cons '1value val)))
388 ((not (and (eq (car-safe (aref testcover-vector idx)) '1value) 465 ((not (and (eq (car-safe (aref testcover-vector idx)) '1value)
389 (equal (cdr (aref testcover-vector idx)) val))) 466 (equal (cdr (aref testcover-vector idx)) val)))
390 (error "Value of form marked with `1value' does vary."))) 467 (error "Value of form marked with `1value' does vary: %s" val)))
391 val) 468 val)
392 469
393 470
@@ -415,7 +492,7 @@ eliminated by adding more test cases."
415 ov j item) 492 ov j item)
416 (or (and def-mark points coverage) 493 (or (and def-mark points coverage)
417 (error "Missing edebug data for function %s" def)) 494 (error "Missing edebug data for function %s" def))
418 (when len 495 (when (> len 0)
419 (set-buffer (marker-buffer def-mark)) 496 (set-buffer (marker-buffer def-mark))
420 (mapc 'delete-overlay 497 (mapc 'delete-overlay
421 (overlays-in def-mark (+ def-mark (aref points (1- len)) 1))) 498 (overlays-in def-mark (+ def-mark (aref points (1- len)) 1)))
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 9d3fdd6de5f..6e46676c871 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -693,7 +693,7 @@ see the variables `c-font-lock-extra-types', `c++-font-lock-extra-types',
693 ;; If the keywords were compiled before, compile them again. 693 ;; If the keywords were compiled before, compile them again.
694 (if was-compiled 694 (if was-compiled
695 (set (make-local-variable 'font-lock-keywords) 695 (set (make-local-variable 'font-lock-keywords)
696 (font-lock-compile-keywords keywords t))))))) 696 (font-lock-compile-keywords font-lock-keywords t)))))))
697 697
698(defun font-lock-update-removed-keyword-alist (mode keywords append) 698(defun font-lock-update-removed-keyword-alist (mode keywords append)
699 ;; Update `font-lock-removed-keywords-alist' when adding new 699 ;; Update `font-lock-removed-keywords-alist' when adding new
@@ -801,7 +801,7 @@ subtle problems due to details of the implementation."
801 ;; If the keywords were compiled before, compile them again. 801 ;; If the keywords were compiled before, compile them again.
802 (if was-compiled 802 (if was-compiled
803 (set (make-local-variable 'font-lock-keywords) 803 (set (make-local-variable 'font-lock-keywords)
804 (font-lock-compile-keywords keywords t))))))) 804 (font-lock-compile-keywords font-lock-keywords t)))))))
805 805
806;;; Font Lock Support mode. 806;;; Font Lock Support mode.
807 807
@@ -1945,12 +1945,12 @@ This function could be MATCHER in a MATCH-ANCHORED `font-lock-keywords' item."
1945 '("when" "unless" "case" "ecase" "typecase" "etypecase" 1945 '("when" "unless" "case" "ecase" "typecase" "etypecase"
1946 "ccase" "ctypecase" "handler-case" "handler-bind" 1946 "ccase" "ctypecase" "handler-case" "handler-bind"
1947 "restart-bind" "restart-case" "in-package" 1947 "restart-bind" "restart-case" "in-package"
1948 "cerror" "break" "ignore-errors" 1948 "break" "ignore-errors"
1949 "loop" "do" "do*" "dotimes" "dolist" "the" "locally" 1949 "loop" "do" "do*" "dotimes" "dolist" "the" "locally"
1950 "proclaim" "declaim" "declare" "symbol-macrolet" 1950 "proclaim" "declaim" "declare" "symbol-macrolet"
1951 "lexical-let" "lexical-let*" "flet" "labels" "compiler-let" 1951 "lexical-let" "lexical-let*" "flet" "labels" "compiler-let"
1952 "destructuring-bind" "macrolet" "tagbody" "block" 1952 "destructuring-bind" "macrolet" "tagbody" "block" "go"
1953 "multiple-value-bind" 1953 "multiple-value-bind" "multiple-value-prog1"
1954 "return" "return-from" 1954 "return" "return-from"
1955 "with-accessors" "with-compilation-unit" 1955 "with-accessors" "with-compilation-unit"
1956 "with-condition-restarts" "with-hash-table-iterator" 1956 "with-condition-restarts" "with-hash-table-iterator"
@@ -1968,7 +1968,7 @@ This function could be MATCHER in a MATCH-ANCHORED `font-lock-keywords' item."
1968 '(2 font-lock-constant-face nil t)) 1968 '(2 font-lock-constant-face nil t))
1969 ;; 1969 ;;
1970 ;; Erroneous structures. 1970 ;; Erroneous structures.
1971 '("(\\(abort\\|assert\\|error\\|signal\\)\\>" 1 font-lock-warning-face) 1971 '("(\\(abort\\|assert\\|warn\\|check-type\\|cerror\\|error\\|signal\\)\\>" 1 font-lock-warning-face)
1972 ;; 1972 ;;
1973 ;; Words inside \\[] tend to be for `substitute-command-keys'. 1973 ;; Words inside \\[] tend to be for `substitute-command-keys'.
1974 '("\\\\\\\\\\[\\(\\sw+\\)]" 1 font-lock-constant-face prepend) 1974 '("\\\\\\\\\\[\\(\\sw+\\)]" 1 font-lock-constant-face prepend)
diff --git a/lisp/frame.el b/lisp/frame.el
index 446bda55775..521938cfc18 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -520,7 +520,7 @@ React to settings of `default-frame-alist', `initial-frame-alist' there."
520;;;; Creation of additional frames, and other frame miscellanea 520;;;; Creation of additional frames, and other frame miscellanea
521 521
522(defun modify-all-frames-parameters (alist) 522(defun modify-all-frames-parameters (alist)
523 "modify all current and future frames parameters according to ALIST. 523 "Modify all current and future frames parameters according to ALIST.
524This changes `default-frame-alist' and possibly `initial-frame-alist'. 524This changes `default-frame-alist' and possibly `initial-frame-alist'.
525See help of `modify-frame-parameters' for more information." 525See help of `modify-frame-parameters' for more information."
526 (let (element) ;; temp 526 (let (element) ;; temp
diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el
index 4644d36ad25..b5ec6f02260 100644
--- a/lisp/mail/footnote.el
+++ b/lisp/mail/footnote.el
@@ -87,8 +87,11 @@ If nil, no blank line will be inserted."
87 87
88;;; Interface variables that probably shouldn't be changed 88;;; Interface variables that probably shouldn't be changed
89 89
90(defconst footnote-section-tag "Footnotes: " 90(defcustom footnote-section-tag "Footnotes: "
91 "*Tag inserted at beginning of footnote section.") 91 "*Tag inserted at beginning of footnote section."
92 :version "21.4"
93 :type 'string
94 :group 'footnote)
92 95
93(defcustom footnote-section-tag-regexp "Footnotes\\(\\[.\\]\\)?: " 96(defcustom footnote-section-tag-regexp "Footnotes\\(\\[.\\]\\)?: "
94 "*Regexp which indicates the start of a footnote section. 97 "*Regexp which indicates the start of a footnote section.
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index cca01d169b6..6a888d9d75d 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1012,7 +1012,7 @@ Domain names in USER and port numbers in HOST are acknowledged."
1012 (when real-user 1012 (when real-user
1013 (let ((pw-prompt "Password:")) 1013 (let ((pw-prompt "Password:"))
1014 (tramp-message 9 "Sending password") 1014 (tramp-message 9 "Sending password")
1015 (tramp-enter-password p pw-prompt))) 1015 (tramp-enter-password p pw-prompt user host)))
1016 1016
1017 (unless (tramp-smb-wait-for-output user host) 1017 (unless (tramp-smb-wait-for-output user host)
1018 (tramp-clear-passwd user host) 1018 (tramp-clear-passwd user host)
diff --git a/lisp/net/tramp-vc.el b/lisp/net/tramp-vc.el
index 839a8702dd9..e720deb8f07 100644
--- a/lisp/net/tramp-vc.el
+++ b/lisp/net/tramp-vc.el
@@ -77,7 +77,7 @@
77 "Like `vc-do-command' but invoked for tramp files. 77 "Like `vc-do-command' but invoked for tramp files.
78See `vc-do-command' for more information." 78See `vc-do-command' for more information."
79 (save-match-data 79 (save-match-data
80 (and file (setq file (tramp-handle-expand-file-name file))) 80 (and file (setq file (expand-file-name file)))
81 (if (not buffer) (setq buffer "*vc*")) 81 (if (not buffer) (setq buffer "*vc*"))
82 (if vc-command-messages 82 (if vc-command-messages
83 (message "Running `%s' on `%s'..." command file)) 83 (message "Running `%s' on `%s'..." command file))
@@ -85,7 +85,7 @@ See `vc-do-command' for more information."
85 (squeezed nil) 85 (squeezed nil)
86 (olddir default-directory) 86 (olddir default-directory)
87 vc-file status) 87 vc-file status)
88 (let* ((v (tramp-dissect-file-name (tramp-handle-expand-file-name file))) 88 (let* ((v (tramp-dissect-file-name (expand-file-name file)))
89 (multi-method (tramp-file-name-multi-method v)) 89 (multi-method (tramp-file-name-multi-method v))
90 (method (tramp-file-name-method v)) 90 (method (tramp-file-name-method v))
91 (user (tramp-file-name-user v)) 91 (user (tramp-file-name-user v))
@@ -130,7 +130,7 @@ See `vc-do-command' for more information."
130 (save-excursion 130 (save-excursion
131 (save-window-excursion 131 (save-window-excursion
132 ;; Actually execute remote command 132 ;; Actually execute remote command
133 (tramp-handle-shell-command 133 (shell-command
134 (mapconcat 'tramp-shell-quote-argument 134 (mapconcat 'tramp-shell-quote-argument
135 (cons command squeezed) " ") t) 135 (cons command squeezed) " ") t)
136 ;;(tramp-wait-for-output) 136 ;;(tramp-wait-for-output)
@@ -190,7 +190,7 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either."
190 (let ((w32-quote-process-args t)) 190 (let ((w32-quote-process-args t))
191 (when (eq okstatus 'async) 191 (when (eq okstatus 'async)
192 (message "Tramp doesn't do async commands, running synchronously.")) 192 (message "Tramp doesn't do async commands, running synchronously."))
193 (setq status (tramp-handle-shell-command 193 (setq status (shell-command
194 (mapconcat 'tramp-shell-quote-argument 194 (mapconcat 'tramp-shell-quote-argument
195 (cons command squeezed) " ") t)) 195 (cons command squeezed) " ") t))
196 (when (or (not (integerp status)) 196 (when (or (not (integerp status))
@@ -257,7 +257,7 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either."
257 ;; Don't switch to the *vc-info* buffer before running the 257 ;; Don't switch to the *vc-info* buffer before running the
258 ;; command, because that would change its default directory 258 ;; command, because that would change its default directory
259 (save-match-data 259 (save-match-data
260 (let* ((v (tramp-dissect-file-name (tramp-handle-expand-file-name file))) 260 (let* ((v (tramp-dissect-file-name (expand-file-name file)))
261 (multi-method (tramp-file-name-multi-method v)) 261 (multi-method (tramp-file-name-multi-method v))
262 (method (tramp-file-name-method v)) 262 (method (tramp-file-name-method v))
263 (user (tramp-file-name-user v)) 263 (user (tramp-file-name-user v))
@@ -284,7 +284,7 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either."
284 (save-excursion 284 (save-excursion
285 (save-window-excursion 285 (save-window-excursion
286 ;; Actually execute remote command 286 ;; Actually execute remote command
287 (tramp-handle-shell-command 287 (shell-command
288 (mapconcat 'tramp-shell-quote-argument 288 (mapconcat 'tramp-shell-quote-argument
289 (append (list command) args (list localname)) " ") 289 (append (list command) args (list localname)) " ")
290 (get-buffer-create"*vc-info*")) 290 (get-buffer-create"*vc-info*"))
@@ -414,7 +414,7 @@ filename we are thinking about..."
414 (nth 2 (file-attributes file))))) 414 (nth 2 (file-attributes file)))))
415 (if (and uid (/= uid remote-uid)) 415 (if (and uid (/= uid remote-uid))
416 (error "tramp-handle-vc-user-login-name cannot map a uid to a name") 416 (error "tramp-handle-vc-user-login-name cannot map a uid to a name")
417 (let* ((v (tramp-dissect-file-name (tramp-handle-expand-file-name file))) 417 (let* ((v (tramp-dissect-file-name (expand-file-name file)))
418 (u (tramp-file-name-user v))) 418 (u (tramp-file-name-user v)))
419 (cond ((stringp u) u) 419 (cond ((stringp u) u)
420 ((vectorp u) (elt u (1- (length u)))) 420 ((vectorp u) (elt u (1- (length u))))
@@ -445,8 +445,8 @@ filename we are thinking about..."
445(defun tramp-file-owner (filename) 445(defun tramp-file-owner (filename)
446 "Return who owns FILE (user name, as a string)." 446 "Return who owns FILE (user name, as a string)."
447 (let ((v (tramp-dissect-file-name 447 (let ((v (tramp-dissect-file-name
448 (tramp-handle-expand-file-name filename)))) 448 (expand-file-name filename))))
449 (if (not (tramp-handle-file-exists-p filename)) 449 (if (not (file-exists-p filename))
450 nil ; file cannot be opened 450 nil ; file cannot be opened
451 ;; file exists, find out stuff 451 ;; file exists, find out stuff
452 (save-excursion 452 (save-excursion
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index d9a8d14309a..02b076483c1 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -916,8 +916,8 @@ The answer will be provided by `tramp-action-terminal', which see."
916 "Regular expression indicating a process has finished. 916 "Regular expression indicating a process has finished.
917In fact this expression is empty by intention, it will be used only to 917In fact this expression is empty by intention, it will be used only to
918check regularly the status of the associated process. 918check regularly the status of the associated process.
919The answer will be provided by `tramp-action-process-alive' and 919The answer will be provided by `tramp-action-process-alive',
920`tramp-action-out-of-band', which see." 920`tramp-multi-action-process-alive' and`tramp-action-out-of-band', which see."
921 :group 'tramp 921 :group 'tramp
922 :type 'regexp) 922 :type 'regexp)
923 923
@@ -1321,7 +1321,7 @@ See `tramp-actions-before-shell' for more info."
1321 (shell-prompt-pattern tramp-multi-action-succeed) 1321 (shell-prompt-pattern tramp-multi-action-succeed)
1322 (tramp-shell-prompt-pattern tramp-multi-action-succeed) 1322 (tramp-shell-prompt-pattern tramp-multi-action-succeed)
1323 (tramp-wrong-passwd-regexp tramp-multi-action-permission-denied) 1323 (tramp-wrong-passwd-regexp tramp-multi-action-permission-denied)
1324 (tramp-process-alive-regexp tramp-action-process-alive)) 1324 (tramp-process-alive-regexp tramp-multi-action-process-alive))
1325 "List of pattern/action pairs. 1325 "List of pattern/action pairs.
1326This list is used for each hop in multi-hop connections. 1326This list is used for each hop in multi-hop connections.
1327See `tramp-actions-before-shell' for more info." 1327See `tramp-actions-before-shell' for more info."
@@ -2165,7 +2165,7 @@ target of the symlink differ."
2165 (let ((nonnumeric (and id-format (equal id-format 'string))) 2165 (let ((nonnumeric (and id-format (equal id-format 'string)))
2166 result) 2166 result)
2167 (with-parsed-tramp-file-name filename nil 2167 (with-parsed-tramp-file-name filename nil
2168 (when (tramp-handle-file-exists-p filename) 2168 (when (file-exists-p filename)
2169 ;; file exists, find out stuff 2169 ;; file exists, find out stuff
2170 (save-excursion 2170 (save-excursion
2171 (if (tramp-get-remote-perl multi-method method user host) 2171 (if (tramp-get-remote-perl multi-method method user host)
@@ -2331,7 +2331,12 @@ If it doesn't exist, generate a new one."
2331;; This function makes the same assumption as 2331;; This function makes the same assumption as
2332;; `tramp-handle-set-visited-file-modtime'. 2332;; `tramp-handle-set-visited-file-modtime'.
2333(defun tramp-handle-verify-visited-file-modtime (buf) 2333(defun tramp-handle-verify-visited-file-modtime (buf)
2334 "Like `verify-visited-file-modtime' for tramp files." 2334 "Like `verify-visited-file-modtime' for tramp files.
2335At the time `verify-visited-file-modtime' calls this function, we
2336already know that the buffer is visiting a file and that
2337`visited-file-modtime' does not return 0. Do not call this
2338function directly, unless those two cases are already taken care
2339of."
2335 (with-current-buffer buf 2340 (with-current-buffer buf
2336 (let ((f (buffer-file-name))) 2341 (let ((f (buffer-file-name)))
2337 (with-parsed-tramp-file-name f nil 2342 (with-parsed-tramp-file-name f nil
@@ -2509,19 +2514,19 @@ if the remote host can't provide the modtime."
2509(defun tramp-handle-file-writable-p (filename) 2514(defun tramp-handle-file-writable-p (filename)
2510 "Like `file-writable-p' for tramp files." 2515 "Like `file-writable-p' for tramp files."
2511 (with-parsed-tramp-file-name filename nil 2516 (with-parsed-tramp-file-name filename nil
2512 (if (tramp-handle-file-exists-p filename) 2517 (if (file-exists-p filename)
2513 ;; Existing files must be writable. 2518 ;; Existing files must be writable.
2514 (zerop (tramp-run-test "-w" filename)) 2519 (zerop (tramp-run-test "-w" filename))
2515 ;; If file doesn't exist, check if directory is writable. 2520 ;; If file doesn't exist, check if directory is writable.
2516 (and (zerop (tramp-run-test 2521 (and (zerop (tramp-run-test
2517 "-d" (tramp-handle-file-name-directory filename))) 2522 "-d" (file-name-directory filename)))
2518 (zerop (tramp-run-test 2523 (zerop (tramp-run-test
2519 "-w" (tramp-handle-file-name-directory filename))))))) 2524 "-w" (file-name-directory filename)))))))
2520 2525
2521(defun tramp-handle-file-ownership-preserved-p (filename) 2526(defun tramp-handle-file-ownership-preserved-p (filename)
2522 "Like `file-ownership-preserved-p' for tramp files." 2527 "Like `file-ownership-preserved-p' for tramp files."
2523 (with-parsed-tramp-file-name filename nil 2528 (with-parsed-tramp-file-name filename nil
2524 (or (not (tramp-handle-file-exists-p filename)) 2529 (or (not (file-exists-p filename))
2525 ;; Existing files must be writable. 2530 ;; Existing files must be writable.
2526 (zerop (tramp-run-test "-O" filename))))) 2531 (zerop (tramp-run-test "-O" filename)))))
2527 2532
@@ -3064,7 +3069,7 @@ This is like `dired-recursive-delete-directory' for tramp files."
3064 (with-parsed-tramp-file-name filename nil 3069 (with-parsed-tramp-file-name filename nil
3065 ;; run a shell command 'rm -r <localname>' 3070 ;; run a shell command 'rm -r <localname>'
3066 ;; Code shamelessly stolen for the dired implementation and, um, hacked :) 3071 ;; Code shamelessly stolen for the dired implementation and, um, hacked :)
3067 (or (tramp-handle-file-exists-p filename) 3072 (or (file-exists-p filename)
3068 (signal 3073 (signal
3069 'file-error 3074 'file-error
3070 (list "Removing old file name" "no such directory" filename))) 3075 (list "Removing old file name" "no such directory" filename)))
@@ -3075,7 +3080,7 @@ This is like `dired-recursive-delete-directory' for tramp files."
3075 ;; This might take a while, allow it plenty of time. 3080 ;; This might take a while, allow it plenty of time.
3076 (tramp-wait-for-output 120) 3081 (tramp-wait-for-output 120)
3077 ;; Make sure that it worked... 3082 ;; Make sure that it worked...
3078 (and (tramp-handle-file-exists-p filename) 3083 (and (file-exists-p filename)
3079 (error "Failed to recusively delete %s" filename)))) 3084 (error "Failed to recusively delete %s" filename))))
3080 3085
3081(defun tramp-handle-dired-call-process (program discard &rest arguments) 3086(defun tramp-handle-dired-call-process (program discard &rest arguments)
@@ -3607,45 +3612,47 @@ This will break if COMMAND prints a newline, followed by the value of
3607 3612
3608(defun tramp-handle-find-backup-file-name (filename) 3613(defun tramp-handle-find-backup-file-name (filename)
3609 "Like `find-backup-file-name' for tramp files." 3614 "Like `find-backup-file-name' for tramp files."
3615 (with-parsed-tramp-file-name filename nil
3616 ;; We set both variables. It doesn't matter whether it is
3617 ;; Emacs or XEmacs
3618 (let ((backup-directory-alist
3619 ;; Emacs case
3620 (when (boundp 'backup-directory-alist)
3621 (if (boundp 'tramp-backup-directory-alist)
3622 (mapcar
3623 '(lambda (x)
3624 (cons
3625 (car x)
3626 (if (and (stringp (cdr x))
3627 (file-name-absolute-p (cdr x))
3628 (not (tramp-file-name-p (cdr x))))
3629 (tramp-make-tramp-file-name
3630 multi-method method user host (cdr x))
3631 (cdr x))))
3632 (symbol-value 'tramp-backup-directory-alist))
3633 (symbol-value 'backup-directory-alist))))
3634
3635 (bkup-backup-directory-info
3636 ;; XEmacs case
3637 (when (boundp 'bkup-backup-directory-info)
3638 (if (boundp 'tramp-bkup-backup-directory-info)
3639 (mapcar
3640 '(lambda (x)
3641 (nconc
3642 (list (car x))
3643 (list
3644 (if (and (stringp (car (cdr x)))
3645 (file-name-absolute-p (car (cdr x)))
3646 (not (tramp-file-name-p (car (cdr x)))))
3647 (tramp-make-tramp-file-name
3648 multi-method method user host (car (cdr x)))
3649 (car (cdr x))))
3650 (cdr (cdr x))))
3651 (symbol-value 'tramp-bkup-backup-directory-info))
3652 (symbol-value 'bkup-backup-directory-info)))))
3653
3654 (tramp-run-real-handler 'find-backup-file-name (list filename)))))
3610 3655
3611 (if (or (and (not (featurep 'xemacs))
3612 (not (boundp 'tramp-backup-directory-alist)))
3613 (and (featurep 'xemacs)
3614 (not (boundp 'tramp-bkup-backup-directory-info))))
3615
3616 ;; No tramp backup directory alist defined, or nil
3617 (tramp-run-real-handler 'find-backup-file-name (list filename))
3618
3619 (with-parsed-tramp-file-name filename nil
3620 (let* ((backup-var
3621 (copy-tree
3622 (if (featurep 'xemacs)
3623 ;; XEmacs case
3624 (symbol-value 'tramp-bkup-backup-directory-info)
3625 ;; Emacs case
3626 (symbol-value 'tramp-backup-directory-alist))))
3627
3628 ;; We set both variables. It doesn't matter whether it is
3629 ;; Emacs or XEmacs
3630 (backup-directory-alist backup-var)
3631 (bkup-backup-directory-info backup-var))
3632
3633 (mapcar
3634 '(lambda (x)
3635 (let ((dir (if (consp (cdr x)) (car (cdr x)) (cdr x))))
3636 (when (and (stringp dir)
3637 (file-name-absolute-p dir)
3638 (not (tramp-file-name-p dir)))
3639 ;; Prepend absolute directory names with tramp prefix
3640 (if (consp (cdr x))
3641 (setcar (cdr x)
3642 (tramp-make-tramp-file-name
3643 multi-method method user host dir))
3644 (setcdr x (tramp-make-tramp-file-name
3645 multi-method method user host dir))))))
3646 backup-var)
3647
3648 (tramp-run-real-handler 'find-backup-file-name (list filename))))))
3649 3656
3650;; CCC grok APPEND, LOCKNAME, CONFIRM 3657;; CCC grok APPEND, LOCKNAME, CONFIRM
3651(defun tramp-handle-write-region 3658(defun tramp-handle-write-region
@@ -3689,6 +3696,9 @@ This will break if COMMAND prints a newline, followed by the value of
3689 ;; use an encoding function, but currently we use it always 3696 ;; use an encoding function, but currently we use it always
3690 ;; because this makes the logic simpler. 3697 ;; because this makes the logic simpler.
3691 (setq tmpfil (tramp-make-temp-file)) 3698 (setq tmpfil (tramp-make-temp-file))
3699 ;; Set current buffer. If connection wasn't open, `file-modes' has
3700 ;; changed it accidently.
3701 (set-buffer curbuf)
3692 ;; We say `no-message' here because we don't want the visited file 3702 ;; We say `no-message' here because we don't want the visited file
3693 ;; modtime data to be clobbered from the temp file. We call 3703 ;; modtime data to be clobbered from the temp file. We call
3694 ;; `set-visited-file-modtime' ourselves later on. 3704 ;; `set-visited-file-modtime' ourselves later on.
@@ -3972,14 +3982,50 @@ Falls back to normal file name handler if no tramp file name handler exists."
3972 (foreign (apply foreign operation args)) 3982 (foreign (apply foreign operation args))
3973 (t (tramp-run-real-handler operation args)))))) 3983 (t (tramp-run-real-handler operation args))))))
3974 3984
3985
3986;; In Emacs, there is some concurrency due to timers. If a timer
3987;; interrupts Tramp and wishes to use the same connection buffer as
3988;; the "main" Emacs, then garbage might occur in the connection
3989;; buffer. Therefore, we need to make sure that a timer does not use
3990;; the same connection buffer as the "main" Emacs. We implement a
3991;; cheap global lock, instead of locking each connection buffer
3992;; separately. The global lock is based on two variables,
3993;; `tramp-locked' and `tramp-locker'. `tramp-locked' is set to true
3994;; (with setq) to indicate a lock. But Tramp also calls itself during
3995;; processing of a single file operation, so we need to allow
3996;; recursive calls. That's where the `tramp-locker' variable comes in
3997;; -- it is let-bound to t during the execution of the current
3998;; handler. So if `tramp-locked' is t and `tramp-locker' is also t,
3999;; then we should just proceed because we have been called
4000;; recursively. But if `tramp-locker' is nil, then we are a timer
4001;; interrupting the "main" Emacs, and then we signal an error.
4002
4003(defvar tramp-locked nil
4004 "If non-nil, then Tramp is currently busy.
4005Together with `tramp-locker', this implements a locking mechanism
4006preventing reentrant calls of Tramp.")
4007
4008(defvar tramp-locker nil
4009 "If non-nil, then a caller has locked Tramp.
4010Together with `tramp-locked', this implements a locking mechanism
4011preventing reentrant calls of Tramp.")
4012
3975(defun tramp-sh-file-name-handler (operation &rest args) 4013(defun tramp-sh-file-name-handler (operation &rest args)
3976 "Invoke remote-shell Tramp file name handler. 4014 "Invoke remote-shell Tramp file name handler.
3977Fall back to normal file name handler if no Tramp handler exists." 4015Fall back to normal file name handler if no Tramp handler exists."
3978 (save-match-data 4016 (when (and tramp-locked (not tramp-locker))
3979 (let ((fn (assoc operation tramp-file-name-handler-alist))) 4017 (signal 'file-error "Forbidden reentrant call of Tramp"))
3980 (if fn 4018 (let ((tl tramp-locked))
3981 (apply (cdr fn) args) 4019 (unwind-protect
3982 (tramp-run-real-handler operation args))))) 4020 (progn
4021 (setq tramp-locked t)
4022 (let ((tramp-locker t))
4023 (save-match-data
4024 (let ((fn (assoc operation tramp-file-name-handler-alist)))
4025 (if fn
4026 (apply (cdr fn) args)
4027 (tramp-run-real-handler operation args))))))
4028 (setq tramp-locked tl))))
3983 4029
3984;;;###autoload 4030;;;###autoload
3985(defun tramp-completion-file-name-handler (operation &rest args) 4031(defun tramp-completion-file-name-handler (operation &rest args)
@@ -4062,7 +4108,7 @@ necessary anymore."
4062 (tramp-make-tramp-file-name multi-method method 4108 (tramp-make-tramp-file-name multi-method method
4063 user host x))) 4109 user host x)))
4064 (read (current-buffer)))))) 4110 (read (current-buffer))))))
4065 (list (tramp-handle-expand-file-name name)))))) 4111 (list (expand-file-name name))))))
4066 4112
4067;; Check for complete.el and override PC-expand-many-files if appropriate. 4113;; Check for complete.el and override PC-expand-many-files if appropriate.
4068(eval-and-compile 4114(eval-and-compile
@@ -4073,7 +4119,7 @@ necessary anymore."
4073 (symbol-function 'PC-expand-many-files)) 4119 (symbol-function 'PC-expand-many-files))
4074 (defun PC-expand-many-files (name) 4120 (defun PC-expand-many-files (name)
4075 (if (tramp-tramp-file-p name) 4121 (if (tramp-tramp-file-p name)
4076 (tramp-handle-expand-many-files name) 4122 (expand-many-files name)
4077 (tramp-save-PC-expand-many-files name)))) 4123 (tramp-save-PC-expand-many-files name))))
4078 4124
4079;; Why isn't eval-after-load sufficient? 4125;; Why isn't eval-after-load sufficient?
@@ -4824,17 +4870,17 @@ file exists and nonzero exit status otherwise."
4824 ;; `/usr/bin/test -e' In case `/bin/test' does not exist. 4870 ;; `/usr/bin/test -e' In case `/bin/test' does not exist.
4825 (unless (or 4871 (unless (or
4826 (and (setq tramp-file-exists-command "test -e %s") 4872 (and (setq tramp-file-exists-command "test -e %s")
4827 (tramp-handle-file-exists-p existing) 4873 (file-exists-p existing)
4828 (not (tramp-handle-file-exists-p nonexisting))) 4874 (not (file-exists-p nonexisting)))
4829 (and (setq tramp-file-exists-command "/bin/test -e %s") 4875 (and (setq tramp-file-exists-command "/bin/test -e %s")
4830 (tramp-handle-file-exists-p existing) 4876 (file-exists-p existing)
4831 (not (tramp-handle-file-exists-p nonexisting))) 4877 (not (file-exists-p nonexisting)))
4832 (and (setq tramp-file-exists-command "/usr/bin/test -e %s") 4878 (and (setq tramp-file-exists-command "/usr/bin/test -e %s")
4833 (tramp-handle-file-exists-p existing) 4879 (file-exists-p existing)
4834 (not (tramp-handle-file-exists-p nonexisting))) 4880 (not (file-exists-p nonexisting)))
4835 (and (setq tramp-file-exists-command "ls -d %s") 4881 (and (setq tramp-file-exists-command "ls -d %s")
4836 (tramp-handle-file-exists-p existing) 4882 (file-exists-p existing)
4837 (not (tramp-handle-file-exists-p nonexisting)))) 4883 (not (file-exists-p nonexisting))))
4838 (error "Couldn't find command to check if file exists.")))) 4884 (error "Couldn't find command to check if file exists."))))
4839 4885
4840 4886
@@ -4896,9 +4942,8 @@ file exists and nonzero exit status otherwise."
4896METHOD, USER and HOST specify the connection, CMD (the absolute file name of) 4942METHOD, USER and HOST specify the connection, CMD (the absolute file name of)
4897the `ls' executable. Returns t if CMD supports the `-n' option, nil 4943the `ls' executable. Returns t if CMD supports the `-n' option, nil
4898otherwise." 4944otherwise."
4899 (tramp-message 9 "Checking remote `%s' command for `-n' option" 4945 (tramp-message 9 "Checking remote `%s' command for `-n' option" cmd)
4900 cmd) 4946 (when (file-executable-p
4901 (when (tramp-handle-file-executable-p
4902 (tramp-make-tramp-file-name multi-method method user host cmd)) 4947 (tramp-make-tramp-file-name multi-method method user host cmd))
4903 (let ((result nil)) 4948 (let ((result nil))
4904 (tramp-message 7 "Testing remote command `%s' for -n..." cmd) 4949 (tramp-message 7 "Testing remote command `%s' for -n..." cmd)
@@ -4956,7 +5001,7 @@ Returns nil if none was found, else the command is returned."
4956 "Query the user for a password." 5001 "Query the user for a password."
4957 (let ((pw-prompt (match-string 0))) 5002 (let ((pw-prompt (match-string 0)))
4958 (tramp-message 9 "Sending password") 5003 (tramp-message 9 "Sending password")
4959 (tramp-enter-password p pw-prompt))) 5004 (tramp-enter-password p pw-prompt user host)))
4960 5005
4961(defun tramp-action-succeed (p multi-method method user host) 5006(defun tramp-action-succeed (p multi-method method user host)
4962 "Signal success in finding shell prompt." 5007 "Signal success in finding shell prompt."
@@ -5034,7 +5079,7 @@ The terminal type can be configured with `tramp-terminal-type'."
5034(defun tramp-multi-action-password (p method user host) 5079(defun tramp-multi-action-password (p method user host)
5035 "Query the user for a password." 5080 "Query the user for a password."
5036 (tramp-message 9 "Sending password") 5081 (tramp-message 9 "Sending password")
5037 (tramp-enter-password p (match-string 0))) 5082 (tramp-enter-password p (match-string 0) user host))
5038 5083
5039(defun tramp-multi-action-succeed (p method user host) 5084(defun tramp-multi-action-succeed (p method user host)
5040 "Signal success in finding shell prompt." 5085 "Signal success in finding shell prompt."
@@ -5049,6 +5094,11 @@ The terminal type can be configured with `tramp-terminal-type'."
5049 (erase-buffer) 5094 (erase-buffer)
5050 (throw 'tramp-action 'permission-denied)) 5095 (throw 'tramp-action 'permission-denied))
5051 5096
5097(defun tramp-multi-action-process-alive (p method user host)
5098 "Check whether a process has finished."
5099 (unless (memq (process-status p) '(run open))
5100 (throw 'tramp-action 'process-died)))
5101
5052;; Functions for processing the actions. 5102;; Functions for processing the actions.
5053 5103
5054(defun tramp-process-one-action (p multi-method method user host actions) 5104(defun tramp-process-one-action (p multi-method method user host actions)
@@ -5246,12 +5296,13 @@ arguments, and xx will be used as the host name to connect to.
5246 (login-args (tramp-get-method-parameter 5296 (login-args (tramp-get-method-parameter
5247 multi-method 5297 multi-method
5248 (tramp-find-method multi-method method user host) 5298 (tramp-find-method multi-method method user host)
5249 user host 'tramp-login-args))) 5299 user host 'tramp-login-args))
5300 (real-host host))
5250 ;; The following should be changed. We need a more general 5301 ;; The following should be changed. We need a more general
5251 ;; mechanism to parse extra host args. 5302 ;; mechanism to parse extra host args.
5252 (when (string-match "\\([^#]*\\)#\\(.*\\)" host) 5303 (when (string-match "\\([^#]*\\)#\\(.*\\)" host)
5253 (setq login-args (cons "-p" (cons (match-string 2 host) login-args))) 5304 (setq login-args (cons "-p" (cons (match-string 2 host) login-args)))
5254 (setq host (match-string 1 host))) 5305 (setq real-host (match-string 1 host)))
5255 (setenv "TERM" tramp-terminal-type) 5306 (setenv "TERM" tramp-terminal-type)
5256 (let* ((default-directory (tramp-temporary-file-directory)) 5307 (let* ((default-directory (tramp-temporary-file-directory))
5257 ;; If we omit the conditional, we would use 5308 ;; If we omit the conditional, we would use
@@ -5262,9 +5313,9 @@ arguments, and xx will be used as the host name to connect to.
5262 tramp-dos-coding-system)) 5313 tramp-dos-coding-system))
5263 (p (if (and user (not (string= user ""))) 5314 (p (if (and user (not (string= user "")))
5264 (apply #'start-process bufnam buf login-program 5315 (apply #'start-process bufnam buf login-program
5265 host "-l" user login-args) 5316 real-host "-l" user login-args)
5266 (apply #'start-process bufnam buf login-program 5317 (apply #'start-process bufnam buf login-program
5267 host login-args))) 5318 real-host login-args)))
5268 (found nil)) 5319 (found nil))
5269 (tramp-set-process-query-on-exit-flag p nil) 5320 (tramp-set-process-query-on-exit-flag p nil)
5270 5321
@@ -5547,10 +5598,10 @@ seconds. If not, it produces an error message with the given ERROR-ARGS."
5547 (pop-to-buffer (buffer-name)) 5598 (pop-to-buffer (buffer-name))
5548 (apply 'error error-args))) 5599 (apply 'error error-args)))
5549 5600
5550(defun tramp-enter-password (p prompt) 5601(defun tramp-enter-password (p prompt user host)
5551 "Prompt for a password and send it to the remote end. 5602 "Prompt for a password and send it to the remote end.
5552Uses PROMPT as a prompt and sends the password to process P." 5603Uses PROMPT as a prompt and sends the password to process P."
5553 (let ((pw (tramp-read-passwd prompt))) 5604 (let ((pw (tramp-read-passwd user host prompt)))
5554 (erase-buffer) 5605 (erase-buffer)
5555 (process-send-string 5606 (process-send-string
5556 p (concat pw 5607 p (concat pw
@@ -6717,16 +6768,11 @@ this is the function `temp-directory'."
6717 "`temp-directory' is defined -- using /tmp.")) 6768 "`temp-directory' is defined -- using /tmp."))
6718 (file-name-as-directory "/tmp")))) 6769 (file-name-as-directory "/tmp"))))
6719 6770
6720(defun tramp-read-passwd (prompt) 6771(defun tramp-read-passwd (user host prompt)
6721 "Read a password from user (compat function). 6772 "Read a password from user (compat function).
6722Invokes `password-read' if available, `read-passwd' else." 6773Invokes `password-read' if available, `read-passwd' else."
6723 (if (functionp 'password-read) 6774 (if (functionp 'password-read)
6724 (let* ((user (or tramp-current-user (user-login-name))) 6775 (let* ((key (concat (or user (user-login-name)) "@" host))
6725 (host (or tramp-current-host (system-name)))
6726 (key (if (and (stringp user) (stringp host))
6727 (concat user "@" host)
6728 (concat "[" (mapconcat 'identity user "/") "]@["
6729 (mapconcat 'identity host "/") "]")))
6730 (password (apply #'password-read (list prompt key)))) 6776 (password (apply #'password-read (list prompt key))))
6731 (apply #'password-cache-add (list key password)) 6777 (apply #'password-cache-add (list key password))
6732 password) 6778 password)
diff --git a/lisp/printing.el b/lisp/printing.el
index ae6e194d731..22a3f762ab6 100644
--- a/lisp/printing.el
+++ b/lisp/printing.el
@@ -5,7 +5,7 @@
5 5
6;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> 6;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
7;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> 7;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
8;; Time-stamp: <2004/07/12 21:10:35 vinicius> 8;; Time-stamp: <2004/07/20 21:44:43 vinicius>
9;; Keywords: wp, print, PostScript 9;; Keywords: wp, print, PostScript
10;; Version: 6.8 10;; Version: 6.8
11;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/ 11;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
@@ -40,37 +40,22 @@ Please send all bug fixes and enhancements to
40;; Introduction 40;; Introduction
41;; ------------ 41;; ------------
42;; 42;;
43;; This package provides an user interface to some printing utilities that 43;; With `printing' you can preview or print a PostScript file. You can also
44;; includes previewing/printing a PostScript file, printing a text file and 44;; print a text file using PostScript, and preview or print buffers that use
45;; previewing/printing some major modes (like mh-folder-mode, 45;; certain special modes like mh-folder-mode, rmail-summary-mode,
46;; rmail-summary-mode, gnus-summary-mode, etc). It also includes a 46;; gnus-summary-mode, etc. This package also includes a PostScript/text
47;; PostScript/text printer database. 47;; printer database.
48;; 48;;
49;; Indeed, there are two user interfaces: 49;; There are two user interfaces:
50;; 50;;
51;; * Menu interface: 51;; * Menu interface:
52;; When `printing' is loaded, the menubar is modified to use `printing' 52;; The `printing' menu replaces the usual print options in the menu bar.
53;; menu instead of the print options in menubar.
54;; This is the default user interface. 53;; This is the default user interface.
55;; 54;;
56;; * Buffer interface: 55;; * Buffer interface:
57;; It is an option of `printing' menu, but it can be binded into another 56;; You can use a buffer interface instead of menus. It looks like a
58;; key, so user can activate the buffer interface directly without using 57;; customization buffer. Basically, it has the same options found in the
59;; a menu. See `pr-interface' command. 58;; menu and some extra options, all this on a buffer.
60;;
61;; `printing' was inspired on:
62;;
63;; print-nt.el Frederic Corne <frederic.corne@erli.fr>
64;; Special printing functions for Windows NT
65;;
66;; mh-e-init.el Tom Vogels <tov@ece.cmu.edu>
67;; PS-print for mail messages
68;;
69;; win32-ps-print.el Matthew O. Persico <mpersico@erols.com>
70;; PostScript printing with ghostscript
71;;
72;; ps-print-interface.el Volker Franz <volker.franz@tuebingen.mpg.de>
73;; Graphical front end for ps-print and previewing
74;; 59;;
75;; `printing' is prepared to run on GNU, Unix and NT systems. 60;; `printing' is prepared to run on GNU, Unix and NT systems.
76;; On GNU or Unix system, `printing' depends on gs and gv utilities. 61;; On GNU or Unix system, `printing' depends on gs and gv utilities.
@@ -86,6 +71,20 @@ Please send all bug fixes and enhancements to
86;; `http://www.cpqd.com.br/~vinicius/emacs/ps-print.tar.gz'. 71;; `http://www.cpqd.com.br/~vinicius/emacs/ps-print.tar.gz'.
87;; Please, see README file for ps-print installation instructions. 72;; Please, see README file for ps-print installation instructions.
88;; 73;;
74;; `printing' was inspired on:
75;;
76;; print-nt.el Frederic Corne <frederic.corne@erli.fr>
77;; Special printing functions for Windows NT
78;;
79;; mh-e-init.el Tom Vogels <tov@ece.cmu.edu>
80;; PS-print for mail messages
81;;
82;; win32-ps-print.el Matthew O. Persico <mpersico@erols.com>
83;; PostScript printing with ghostscript
84;;
85;; ps-print-interface.el Volker Franz <volker.franz@tuebingen.mpg.de>
86;; Graphical front end for ps-print and previewing
87;;
89;; 88;;
90;; Log Messages 89;; Log Messages
91;; ------------ 90;; ------------
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index 5130ca9bfef..c887b144965 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -8,11 +8,6 @@
8;; Adapted-By: ESR 8;; Adapted-By: ESR
9;; Keywords: unix, tools 9;; Keywords: unix, tools
10 10
11;; RMS:
12;; This needs work.
13;; Also, the doc strings need fixing: the first line doesn't stand alone,
14;; and other usage is not high quality. Symbol names don't have `...'.
15
16;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
17 12
18;; GNU Emacs is free software; you can redistribute it and/or modify 13;; GNU Emacs is free software; you can redistribute it and/or modify
@@ -63,6 +58,7 @@
63;; 58;;
64;; To Do: 59;; To Do:
65;; 60;;
61;; * Add missing doc strings, improve terse doc strings.
66;; * Eliminate electric stuff entirely. 62;; * Eliminate electric stuff entirely.
67;; * It might be nice to highlight targets differently depending on 63;; * It might be nice to highlight targets differently depending on
68;; whether they are up-to-date or not. Not sure how this would 64;; whether they are up-to-date or not. Not sure how this would
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el
index fef159d850f..87df0769314 100644
--- a/lisp/progmodes/which-func.el
+++ b/lisp/progmodes/which-func.el
@@ -99,7 +99,33 @@ Zero means compute the Imenu menu regardless of size."
99 :group 'which-func 99 :group 'which-func
100 :type 'integer) 100 :type 'integer)
101 101
102(defcustom which-func-format '("[" which-func-current "]") 102(defvar which-func-keymap
103 (let ((map (make-sparse-keymap)))
104 (define-key map [mode-line mouse-1] 'beginning-of-defun)
105 (define-key map [mode-line mouse-2]
106 (lambda ()
107 (interactive)
108 (if (eq (point-min) 1)
109 (narrow-to-defun)
110 (widen))))
111 (define-key map [mode-line mouse-3] 'end-of-defun)
112 map)
113 "Keymap to display on mode line which-func.")
114
115(defface which-func-face
116 '((t (:inherit font-lock-function-name-face)))
117 "Face used to highlight mode line function names.
118Defaults to `font-lock-function-name-face' if font-lock is loaded."
119 :group 'which-func)
120
121(defcustom which-func-format
122 `("["
123 (:propertize which-func-current
124 local-map ,which-func-keymap
125 face which-func-face
126 ;;mouse-face highlight ; currently not evaluated :-(
127 help-echo "mouse-1: go to beginning, mouse-2: toggle rest visibility, mouse-3: go to end")
128 "]")
103 "Format for displaying the function in the mode line." 129 "Format for displaying the function in the mode line."
104 :group 'which-func 130 :group 'which-func
105 :type 'sexp) 131 :type 'sexp)
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index 5c019b4f347..eff1b25fe42 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -10,12 +10,12 @@
10;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters) 10;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
11;; Vinicius Jose Latorre <viniciusjl@ig.com.br> 11;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
12;; Keywords: wp, print, PostScript 12;; Keywords: wp, print, PostScript
13;; Time-stamp: <2004/03/10 18:57:00 vinicius> 13;; Time-stamp: <2004/07/21 23:12:05 vinicius>
14;; Version: 6.6.4 14;; Version: 6.6.5
15;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/ 15;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
16 16
17(defconst ps-print-version "6.6.4" 17(defconst ps-print-version "6.6.5"
18 "ps-print.el, v 6.6.4 <2004/03/10 vinicius> 18 "ps-print.el, v 6.6.5 <2004/07/21 vinicius>
19 19
20Vinicius's last change version -- this file may have been edited as part of 20Vinicius's last change version -- this file may have been edited as part of
21Emacs without changes to the version number. When reporting bugs, please also 21Emacs without changes to the version number. When reporting bugs, please also
@@ -1353,6 +1353,9 @@ Please send all bug fixes and enhancements to
1353;; Acknowledgments 1353;; Acknowledgments
1354;; --------------- 1354;; ---------------
1355;; 1355;;
1356;; Thanks to Michael Piotrowski <mxp@dynalabs.de> for improving the DSC
1357;; compliance of the generated PostScript.
1358;;
1356;; Thanks to Adam Doppelt <adoppelt@avogadro.com> for face mapping suggestion 1359;; Thanks to Adam Doppelt <adoppelt@avogadro.com> for face mapping suggestion
1357;; for black/white PostScript printers. 1360;; for black/white PostScript printers.
1358;; 1361;;
@@ -1424,7 +1427,7 @@ Please send all bug fixes and enhancements to
1424;; initial port to Emacs 19. His code is no longer part of ps-print, but his 1427;; initial port to Emacs 19. His code is no longer part of ps-print, but his
1425;; work is still appreciated. 1428;; work is still appreciated.
1426;; 1429;;
1427;; Thanks to Remi Houdaille and Michel Train, michel@metasoft.fdn.org, for 1430;; Thanks to Remi Houdaille and Michel Train <michel@metasoft.fdn.org> for
1428;; adding underline support. Their code also is no longer part of ps-print, 1431;; adding underline support. Their code also is no longer part of ps-print,
1429;; but their efforts are not forgotten. 1432;; but their efforts are not forgotten.
1430;; 1433;;
@@ -4162,6 +4165,7 @@ If EXTENSION is any other symbol, it is ignored."
4162 4165
4163(defun ps-message-log-max () 4166(defun ps-message-log-max ()
4164 (and (not (string= (buffer-name) "*Messages*")) 4167 (and (not (string= (buffer-name) "*Messages*"))
4168 (boundp 'message-log-max)
4165 message-log-max)) 4169 message-log-max))
4166 4170
4167 4171
@@ -4210,7 +4214,7 @@ If EXTENSION is any other symbol, it is ignored."
4210 4214
4211 4215
4212(defvar ps-printing-region nil 4216(defvar ps-printing-region nil
4213 "Variable used to indicate if the region that ps-print is printing. 4217 "Variable used to indicate the region that ps-print is printing.
4214It is a cons, the car of which is the line number where the region begins, and 4218It is a cons, the car of which is the line number where the region begins, and
4215its cdr is the total number of lines in the buffer. Formatting functions can 4219its cdr is the total number of lines in the buffer. Formatting functions can
4216use this information to print the original line number (and not the number of 4220use this information to print the original line number (and not the number of
@@ -5396,9 +5400,9 @@ XSTART YSTART are the relative position for the first page in a sheet.")
5396 ps-adobe-tag 5400 ps-adobe-tag
5397 "%%Title: " (buffer-name) ; Take job name from name of 5401 "%%Title: " (buffer-name) ; Take job name from name of
5398 ; first buffer printed 5402 ; first buffer printed
5399 "\n%%Creator: " (user-full-name) 5403 "\n%%Creator: ps-print v" ps-print-version
5400 " (using ps-print v" ps-print-version 5404 "\n%%For: " (user-full-name)
5401 ")\n%%CreationDate: " (format-time-string "%T %b %d %Y") 5405 "\n%%CreationDate: " (format-time-string "%T %b %d %Y")
5402 "\n%%Orientation: " 5406 "\n%%Orientation: "
5403 (if ps-landscape-mode "Landscape" "Portrait") 5407 (if ps-landscape-mode "Landscape" "Portrait")
5404 "\n%%DocumentNeededResources: font Times-Roman Times-Italic\n%%+ font " 5408 "\n%%DocumentNeededResources: font Times-Roman Times-Italic\n%%+ font "
@@ -5406,8 +5410,11 @@ XSTART YSTART are the relative position for the first page in a sheet.")
5406 (ps-remove-duplicates 5410 (ps-remove-duplicates
5407 (append (ps-fonts 'ps-font-for-text) 5411 (append (ps-fonts 'ps-font-for-text)
5408 (list (ps-font 'ps-font-for-header 'normal) 5412 (list (ps-font 'ps-font-for-header 'normal)
5409 (ps-font 'ps-font-for-header 'bold)))) 5413 (ps-font 'ps-font-for-header 'bold)
5414 (ps-font 'ps-font-for-footer 'normal)
5415 (ps-font 'ps-font-for-footer 'bold))))
5410 "\n%%+ font ") 5416 "\n%%+ font ")
5417 "\n%%DocumentSuppliedResources: procset PSPrintUserDefinedPrologue-" (user-login-name) " 0 0"
5411 "\n%%DocumentMedia: " (ps-page-dimensions-get-media dimensions) 5418 "\n%%DocumentMedia: " (ps-page-dimensions-get-media dimensions)
5412 (format " %d" (round (ps-page-dimensions-get-width dimensions))) 5419 (format " %d" (round (ps-page-dimensions-get-width dimensions)))
5413 (format " %d" (round (ps-page-dimensions-get-height dimensions))) 5420 (format " %d" (round (ps-page-dimensions-get-height dimensions)))
@@ -5427,11 +5434,11 @@ XSTART YSTART are the relative position for the first page in a sheet.")
5427 ps-error-handler-alist)) 5434 ps-error-handler-alist))
5428 1)) ; send to paper 5435 1)) ; send to paper
5429 ps-print-prologue-0 5436 ps-print-prologue-0
5430 "\n%%BeginProcSet: UserDefinedPrologue\n\n") 5437 "\n%%BeginResource: procset PSPrintUserDefinedPrologue-" (user-login-name) " 0 0\n\n")
5431 5438
5432 (ps-insert-string ps-user-defined-prologue) 5439 (ps-insert-string ps-user-defined-prologue)
5433 5440
5434 (ps-output "\n%%EndProcSet\n\n") 5441 (ps-output "\n%%EndResource\n\n")
5435 5442
5436 (ps-output-boolean "LandscapeMode " 5443 (ps-output-boolean "LandscapeMode "
5437 (or ps-landscape-mode 5444 (or ps-landscape-mode
@@ -5543,6 +5550,21 @@ XSTART YSTART are the relative position for the first page in a sheet.")
5543 (mapcar 'ps-output ps-background-all-pages) 5550 (mapcar 'ps-output ps-background-all-pages)
5544 (ps-output "}def\n/printLocalBackground{\n}def\n") 5551 (ps-output "}def\n/printLocalBackground{\n}def\n")
5545 5552
5553 (ps-output "\n%%EndProlog\n\n%%BeginSetup\n")
5554
5555 (ps-output
5556 "\n%%IncludeResource: font Times-Roman"
5557 "\n%%IncludeResource: font Times-Italic\n%%IncludeResource: font "
5558 (mapconcat 'identity
5559 (ps-remove-duplicates
5560 (append (ps-fonts 'ps-font-for-text)
5561 (list (ps-font 'ps-font-for-header 'normal)
5562 (ps-font 'ps-font-for-header 'bold)
5563 (ps-font 'ps-font-for-footer 'normal)
5564 (ps-font 'ps-font-for-footer 'bold))))
5565 "\n%%IncludeResource: font ")
5566 "\n")
5567
5546 ;; Header/line number fonts 5568 ;; Header/line number fonts
5547 (ps-output (format "/h0 %s(%s)cvn DefFont\n" ; /h0 14/Helvetica-Bold DefFont 5569 (ps-output (format "/h0 %s(%s)cvn DefFont\n" ; /h0 14/Helvetica-Bold DefFont
5548 ps-header-title-font-size-internal 5570 ps-header-title-font-size-internal
@@ -5586,7 +5608,6 @@ XSTART YSTART are the relative position for the first page in a sheet.")
5586 (ps-output (format "/SpaceWidthRatio %f def\n" 5608 (ps-output (format "/SpaceWidthRatio %f def\n"
5587 (/ (ps-lookup 'space-width) (ps-lookup 'size))))) 5609 (/ (ps-lookup 'space-width) (ps-lookup 'size)))))
5588 5610
5589 (ps-output "\n%%EndProlog\n\n%%BeginSetup\n")
5590 (unless (eq ps-spool-config 'lpr-switches) 5611 (unless (eq ps-spool-config 'lpr-switches)
5591 (ps-output "\n%%BeginFeature: *Duplex " 5612 (ps-output "\n%%BeginFeature: *Duplex "
5592 (ps-boolean-capitalized ps-spool-duplex) 5613 (ps-boolean-capitalized ps-spool-duplex)
diff --git a/lisp/replace.el b/lisp/replace.el
index 60c28d6c48a..f81c6f53914 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -786,7 +786,8 @@ If the value is nil, don't highlight the buffer names specially."
786 nil 786 nil
787 nil 787 nil
788 nil 788 nil
789 'regexp-history))) 789 'regexp-history
790 default)))
790 (if (equal input "") 791 (if (equal input "")
791 default 792 default
792 input)) 793 input))
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
index a888003402d..dfd471a87c4 100644
--- a/lisp/textmodes/fill.el
+++ b/lisp/textmodes/fill.el
@@ -353,7 +353,12 @@ and `fill-nobreak-invisible'."
353 ;; Don't split a line if the rest would look like a new paragraph. 353 ;; Don't split a line if the rest would look like a new paragraph.
354 (unless use-hard-newlines 354 (unless use-hard-newlines
355 (save-excursion 355 (save-excursion
356 (skip-chars-forward " \t") (looking-at paragraph-start))) 356 (skip-chars-forward " \t")
357 ;; If this break point is at the end of the line,
358 ;; which can occur for auto-fill, don't consider the newline
359 ;; which follows as a reason to return t.
360 (and (not (eolp))
361 (looking-at paragraph-start))))
357 (run-hook-with-args-until-success 'fill-nobreak-predicate))))) 362 (run-hook-with-args-until-success 'fill-nobreak-predicate)))))
358 363
359;; Put `fill-find-break-point-function' property to charsets which 364;; Put `fill-find-break-point-function' property to charsets which