summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
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 @@
+2004-07-22 Vinicius Jose Latorre <viniciusjl@ig.com.br>
+
+ * ps-print.el: Doc fix. Improve the DSC compliance of the generated
+ PostScript. Suggested by Michael Piotrowski <mxp@dynalabs.de>.
+ (ps-print-version): New version 6.6.5.
+ (ps-printing-region): Doc fix.
+ (ps-generate-string-list): Comment fix.
+ (ps-message-log-max, ps-begin-file): Code fix.
+
+2004-07-22 Kim F. Storm <storm@cua.dk>
+
+ * progmodes/make-mode.el: Fix comments.
+
+2004-07-21 Vinicius Jose Latorre <viniciusjl@ig.com.br>
+
+ * printing.el: Doc fix.
+
+2004-07-20 Luc Teirlinck <teirllm@auburn.edu>
+
+ * frame.el (modify-all-frames-parameters): Minor doc fix.
+
+2004-07-20 Richard M. Stallman <rms@gnu.org>
+
+ * textmodes/fill.el (fill-comment-paragraph): Handle indent-tabs-mode.
+ (fill-delete-newlines): Call sentence-end as function.
+ (fill-nobreak-p, canonically-space-region): Likewise.
+ (fill-nobreak-p): If this break point is at the end of the line,
+ don't consider the newline which follows as a reason to return t.
+
+2004-07-19 John Paul Wallington <jpw@gnu.org>
+
+ * dired-aux.el (dired-file-set-difference): Don't use `caddr'.
+
+2004-07-18 Luc Teirlinck <teirllm@auburn.edu>
+
+ * dired-aux.el (dired-do-kill-lines): Expand docstring.
+ Delete irrelevant code.
+
+2004-07-17 Kai Grossjohann <kai.grossjohann@gmx.net>
+
+ * net/tramp.el (tramp-handle-verify-visited-file-modtime): New
+ docstring. From Luc Teirlinck.
+
+2004-07-17 Luc Teirlinck <teirllm@auburn.edu>
+
+ * autorevert.el: Describe `Auto Revert Tail Mode' in `Commentary'
+ section.
+ (auto-revert-handler): Do not check `auto-revert-tail-mode' for
+ non-file buffers. We know it is nil.
+
+2004-07-17 Kai Grossjohann <kai.grossjohann@gmx.net>
+
+ Sync with Tramp 2.0.43.
+
+ * net/tramp.el (tramp-handle-verify-visited-file-modtime): Remove
+ outdated comment.
+ (tramp-locked, tramp-locker): New variables for implementing a
+ global lock.
+ (tramp-sh-file-name-handler): Use them to implement the global
+ lock.
+
+2004-07-13 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (all): Code cleanup. Change all `tramp-handle-xxx'
+ calls to respective `xxx` calls.
+ (tramp-process-alive-regexp): Precise doc string.
+ (tramp-multi-action-process-alive): New defun.
+ (tramp-multi-actions): Use it.
+ (tramp-handle-find-backup-file-name): `copy-tree' is available
+ since Emacs 21.4 only (XEmacs has it). Implementation rewritten
+ in order to avoid this function.
+ (tramp-handle-write-region): Set current buffer. If connection
+ wasn't open, `file-modes' has changed it accidently. Reported by
+ David Kastrup <dak@gnu.org>.
+ (tramp-enter-password, tramp-read-passwd): New arguments USER and
+ HOST.
+ (tramp-action-password, tramp-multi-action-password): Apply it.
+ (tramp-open-connection-rsh): If a port is given, the Tramp buffer
+ name must still contain the port number. Otherwise, we have two
+ Tramp buffers, with all the confusion. Reported by Myron Selby
+ <myron@xytech.com> and Rolf Dubitzky
+ <Dubitzky@physi.uni-heidelberg.de>.
+
+ * net/tramp-smb.el (tramp-smb-open-connection): Apply USER and
+ HOST to `tramp-enter-passwd'.
+
+ * net/tramp-vc.el (all): Code cleanup. Change all
+ `tramp-handle-xxx' calls to respective `xxx` calls.
+
+2004-07-17 Jonathan Yavner <jyavner@member.fsf.org>
+
+ * emacs-lisp/testcover.el: New category "potentially-1valued" for
+ functions that are not erroneous if either 1-valued or
+ multi-valued. Detect functions in this class.
+ (testcover-1value-functions, testcover-compose-functions,
+ testcover-progn-functions) Added some additional functions to lists.
+ (testcover-mark): Bugfix when marking up the definition for an
+ empty function.
+
+2004-07-17 Richard M. Stallman <rms@gnu.org>
+
+ * replace.el (occur-read-primary-args): Pass default to read-from-minibuffer.
+
+ * mail/footnote.el (footnote-section-tag): Use defcustom.
+
+ * font-lock.el (font-lock-add-keywords, font-lock-remove-keywords):
+ Compile font-lock-keywords, not KEYWORDS.
+ (lisp-font-lock-keywords-2): Add multiple-value-prog1, go.
+ Add warn, check-type. Handle cerror like error.
+
+2004-07-14 Daniel Pfeiffer <occitan@esperanto.org>
+
+ * progmodes/which-func.el (which-func-keymap): New var.
+ (which-func-face): New face.
+ (which-func-format): Use them.
+
2004-07-16 Stephan Stahl <stahl@eos.franken.de> (tiny change)
* 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 @@
;;
;; This package contains two minor modes: Global Auto-Revert Mode and
;; Auto-Revert Mode. Both modes automatically revert buffers
-;; whenever the corresponding files have been changed on disk.
+;; whenever the corresponding files have been changed on disk and the
+;; buffer contains no unsaved changes.
;;
;; Auto-Revert Mode can be activated for individual buffers. Global
;; Auto-Revert Mode applies to all file buffers. (If the user option
@@ -59,6 +60,13 @@
;; Just put point at the end of the buffer and it will stay there.
;; These rules apply to file buffers. For non-file buffers, the
;; behavior may be mode dependent.
+;;
+;; While you can use Auto Revert Mode to tail a file, this package
+;; contains a third minor mode, Auto Revert Tail Mode, which does so
+;; more efficiently, as long as you are sure that the file will only
+;; change by growing at the end. It only appends the new output,
+;; instead of reverting the entire buffer. It does so even if the
+;; buffer contains unsaved changes. (Because they will not be lost.)
;; Usage:
;;
@@ -389,7 +397,7 @@ This is an internal function used by Auto-Revert Mode."
(not (file-remote-p buffer-file-name))
(file-readable-p buffer-file-name)
(not (verify-visited-file-modtime buffer)))
- (and (or auto-revert-mode auto-revert-tail-mode
+ (and (or auto-revert-mode
global-auto-revert-non-file-buffers)
revert-buffer-function
(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
(unless (let ((list list2))
(while (and list
(not (let* ((file2 (car list))
- (fa1 (caddr file1))
- (fa2 (caddr file2))
+ (fa1 (car (cddr file1)))
+ (fa2 (car (cddr file2)))
(size1 (nth 7 fa1))
(size2 (nth 7 fa2))
(mtime1 (float-time (nth 5 fa1)))
@@ -627,9 +627,14 @@ the list of file names explicitly with the FILE-LIST argument."
(defun dired-do-kill-lines (&optional arg fmt)
"Kill all marked lines (not the files).
With a prefix argument, kill that many lines starting with the current line.
-\(A negative argument kills lines before the current line.)
-To kill an entire subdirectory, go to its directory header line
-and use this command with a prefix argument (the value does not matter)."
+\(A negative argument kills backward.)
+If you use this command with a prefix argument to kill the line
+for a file that is a directory, which you have inserted in the
+Dired buffer as a subdirectory, then it deletes that subdirectory
+from the buffer as well.
+To kill an entire subdirectory \(without killing its line in the
+parent directory), go to its directory header line and use this
+command with a prefix argument (the value does not matter)."
;; Returns count of killed lines. FMT="" suppresses message.
(interactive "P")
(if arg
@@ -638,23 +643,14 @@ and use this command with a prefix argument (the value does not matter)."
(dired-kill-line arg))
(save-excursion
(goto-char (point-min))
- (let (buffer-read-only (count 0))
- (if (not arg) ; kill marked lines
- (let ((regexp (dired-marker-regexp)))
- (while (and (not (eobp))
- (re-search-forward regexp nil t))
- (setq count (1+ count))
- (delete-region (progn (beginning-of-line) (point))
- (progn (forward-line 1) (point)))))
- ;; else kill unmarked lines
- (while (not (eobp))
- (if (or (dired-between-files)
- (not (looking-at "^ ")))
- (forward-line 1)
- (setq count (1+ count))
- (delete-region (point) (save-excursion
- (forward-line 1)
- (point))))))
+ (let (buffer-read-only
+ (count 0)
+ (regexp (dired-marker-regexp)))
+ (while (and (not (eobp))
+ (re-search-forward regexp nil t))
+ (setq count (1+ count))
+ (delete-region (progn (beginning-of-line) (point))
+ (progn (forward-line 1) (point))))
(or (equal "" fmt)
(message (or fmt "Killed %d line%s.") count (dired-plural-s count)))
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 @@
;; instrumentation callbacks, then replace edebug's callbacks with ours.
;; * To show good coverage, we want to see two values for every form, except
;; functions that always return the same value and `defconst' variables
-;; need show only value for good coverage. To avoid the brown splotch, the
-;; definitions for constants and 1-valued functions must precede the
-;; references.
+;; need show only one value for good coverage. To avoid the brown
+;; splotch, the definitions for constants and 1-valued functions must
+;; precede the references.
;; * Use the macro `1value' in your Lisp code to mark spots where the local
;; code environment causes a function or variable to always have the same
;; value, but the function or variable is not intrinsically 1-valued.
@@ -55,12 +55,14 @@
;; call has the same value! Also, equal thinks two strings are the same
;; if they differ only in properties.
;; * Because we have only a "1value" class and no "always nil" class, we have
-;; to treat as 1-valued any `and' whose last term is 1-valued, in case the
-;; last term is always nil. Example:
+;; to treat as potentially 1-valued any `and' whose last term is 1-valued,
+;; in case the last term is always nil. Example:
;; (and (< (point) 1000) (forward-char 10))
-;; This form always returns nil. Similarly, `if' and `cond' are
-;; treated as 1-valued if all clauses are, in case those values are
-;; always nil.
+;; This form always returns nil. Similarly, `or', `if', and `cond' are
+;; treated as potentially 1-valued if all clauses are, in case those
+;; values are always nil. Unlike truly 1-valued functions, it is not an
+;; error if these "potentially" 1-valued forms actually return differing
+;; values.
(require 'edebug)
(provide 'testcover)
@@ -86,12 +88,14 @@ these. This list is quite incomplete!"
(defcustom testcover-1value-functions
'(backward-char barf-if-buffer-read-only beginning-of-line
- buffer-disable-undo buffer-enable-undo current-global-map deactivate-mark
- delete-char delete-region ding error forward-char function* insert
- insert-and-inherit kill-all-local-variables lambda mapc narrow-to-region
- noreturn push-mark put-text-property run-hooks set-text-properties signal
- substitute-key-definition suppress-keymap throw undo use-local-map while
- widen yank)
+ buffer-disable-undo buffer-enable-undo current-global-map
+ deactivate-mark delete-backward-char delete-char delete-region ding
+ forward-char function* insert insert-and-inherit kill-all-local-variables
+ kill-line kill-paragraph kill-region kill-sexp lambda
+ minibuffer-complete-and-exit narrow-to-region next-line push-mark
+ put-text-property run-hooks set-match-data signal
+ substitute-key-definition suppress-keymap undo use-local-map while widen
+ yank)
"Functions that always return the same value. No brown splotch is shown
for these. This list is quite incomplete! Notes: Nobody ever changes the
current global map. The macro `lambda' is self-evaluating, hence always
@@ -108,9 +112,9 @@ them as having returned nil just before calling them."
:type 'hook)
(defcustom testcover-compose-functions
- '(+ - * / length list make-keymap make-sparse-keymap message propertize
- replace-regexp-in-string run-with-idle-timer
- set-buffer-modified-p)
+ '(+ - * / = append length list make-keymap make-sparse-keymap
+ mapcar message propertize replace-regexp-in-string
+ run-with-idle-timer set-buffer-modified-p)
"Functions that are 1-valued if all their args are either constants or
calls to one of the `testcover-1value-functions', so if that's true then no
brown splotch is shown for these. This list is quite incomplete! Most
@@ -119,16 +123,16 @@ side-effect-free functions should be here."
:type 'hook)
(defcustom testcover-progn-functions
- '(define-key fset function goto-char or overlay-put progn save-current-buffer
- save-excursion save-match-data save-restriction save-selected-window
- save-window-excursion set set-default setq setq-default
- with-output-to-temp-buffer with-syntax-table with-temp-buffer
- with-temp-file with-temp-message with-timeout)
+ '(define-key fset function goto-char mapc overlay-put progn
+ save-current-buffer save-excursion save-match-data
+ save-restriction save-selected-window save-window-excursion
+ set set-default set-marker-insertion-type setq setq-default
+ with-current-buffer with-output-to-temp-buffer with-syntax-table
+ with-temp-buffer with-temp-file with-temp-message with-timeout)
"Functions whose return value is the same as their last argument. No
brown splotch is shown for these if the last argument is a constant or a
call to one of the `testcover-1value-functions'. This list is probably
-incomplete! Note: `or' is here in case the last argument is a function that
-always returns nil."
+incomplete!"
:group 'testcover
:type 'hook)
@@ -140,6 +144,11 @@ call to one of the `testcover-1value-functions'."
:group 'testcover
:type 'hook)
+(defcustom testcover-potentially-1value-functions
+ '(add-hook and beep or remove-hook unless when)
+ "Functions that are potentially 1-valued. No brown splotch if actually
+1-valued, no error if actually multi-valued.")
+
(defface testcover-nohits-face
'((t (:background "DeepPink2")))
"Face for forms that had no hits during coverage test"
@@ -161,7 +170,11 @@ call to one of the `testcover-1value-functions'."
(defvar testcover-module-1value-functions nil
"Symbols declared with defun in the last file processed by
-`testcover-start', whose functions always return the same value.")
+`testcover-start', whose functions should always return the same value.")
+
+(defvar testcover-module-potentially-1value-functions nil
+ "Symbols declared with defun in the last file processed by
+`testcover-start', whose functions might always return the same value.")
(defvar testcover-vector nil
"Locally bound to coverage vector for function in progress.")
@@ -206,25 +219,32 @@ non-nil, byte-compiles each function after instrumenting."
x))
(defun testcover-reinstrument (form)
- "Reinstruments FORM to use testcover instead of edebug. This function
-modifies the list that FORM points to. Result is non-nil if FORM will
-always return the same value."
+ "Reinstruments FORM to use testcover instead of edebug. This
+function modifies the list that FORM points to. Result is nil if
+FORM should return multiple vlues, t if should always return same
+value, 'maybe if either is acceptable."
(let ((fun (car-safe form))
- id)
+ id val)
(cond
- ((not fun) ;Atom
- (or (not (symbolp form))
- (memq form testcover-constants)
- (memq form testcover-module-constants)))
- ((consp fun) ;Embedded list
+ ((not fun) ;Atom
+ (when (or (not (symbolp form))
+ (memq form testcover-constants)
+ (memq form testcover-module-constants))
+ t))
+ ((consp fun) ;Embedded list
(testcover-reinstrument fun)
(testcover-reinstrument-list (cdr form))
nil)
((or (memq fun testcover-1value-functions)
(memq fun testcover-module-1value-functions))
- ;;Always return same value
+ ;;Should always return same value
(testcover-reinstrument-list (cdr form))
t)
+ ((or (memq fun testcover-potentially-1value-functions)
+ (memq fun testcover-module-potentially-1value-functions))
+ ;;Might always return same value
+ (testcover-reinstrument-list (cdr form))
+ 'maybe)
((memq fun testcover-progn-functions)
;;1-valued if last argument is
(testcover-reinstrument-list (cdr form)))
@@ -233,11 +253,9 @@ always return the same value."
(testcover-reinstrument-list (cddr form))
(testcover-reinstrument (cadr form)))
((memq fun testcover-compose-functions)
- ;;1-valued if all arguments are
- (setq id t)
- (mapc #'(lambda (x) (setq id (or (testcover-reinstrument x) id)))
- (cdr form))
- id)
+ ;;1-valued if all arguments are. Potentially 1-valued if all
+ ;;arguments are either definitely or potentially.
+ (testcover-reinstrument-compose (cdr form) 'testcover-reinstrument))
((eq fun 'edebug-enter)
;;(edebug-enter 'SYM ARGS #'(lambda nil FORMS))
;; => (testcover-enter 'SYM #'(lambda nil FORMS))
@@ -252,33 +270,44 @@ always return the same value."
(aset testcover-vector (cadr (cadr form)) 'ok-coverage))
(setq id (nth 2 form))
(setcdr form (nthcdr 2 form))
+ (setq val (testcover-reinstrument (nth 2 form)))
+ (if (eq val t)
+ (setcar form 'testcover-1value)
+ (setcar form 'testcover-after))
+ (when val
+ ;;1-valued or potentially 1-valued
+ (aset testcover-vector id '1value))
(cond
((memq (car-safe (nth 2 form)) testcover-noreturn-functions)
;;This function won't return, so set the value in advance
;;(edebug-after (edebug-before XXX) YYY FORM)
;; => (progn (edebug-after YYY nil) FORM)
+ (setcar (cdr form) `(,(car form) ,id nil))
(setcar form 'progn)
- (setcar (cdr form) `(testcover-after ,id nil)))
+ (aset testcover-vector id '1value)
+ (setq val t))
((eq (car-safe (nth 2 form)) '1value)
;;This function is always supposed to return the same value
- (setcar form 'testcover-1value))
- (t
- (setcar form 'testcover-after)))
- (when (testcover-reinstrument (nth 2 form))
- (aset testcover-vector id '1value)))
+ (setq val t)
+ (aset testcover-vector id '1value)
+ (setcar form 'testcover-1value)))
+ val)
((eq fun 'defun)
- (if (testcover-reinstrument-list (nthcdr 3 form))
- (push (cadr form) testcover-module-1value-functions)))
- ((eq fun 'defconst)
+ (setq val (testcover-reinstrument-list (nthcdr 3 form)))
+ (when (eq val t)
+ (push (cadr form) testcover-module-1value-functions))
+ (when (eq val 'maybe)
+ (push (cadr form) testcover-module-potentially-1value-functions)))
+ ((memq fun '(defconst defcustom))
;;Define this symbol as 1-valued
(push (cadr form) testcover-module-constants)
(testcover-reinstrument-list (cddr form)))
((memq fun '(dotimes dolist))
;;Always returns third value from SPEC
(testcover-reinstrument-list (cddr form))
- (setq fun (testcover-reinstrument-list (cadr form)))
+ (setq val (testcover-reinstrument-list (cadr form)))
(if (nth 2 (cadr form))
- fun
+ val
;;No third value, always returns nil
t))
((memq fun '(let let*))
@@ -286,23 +315,23 @@ always return the same value."
(mapc 'testcover-reinstrument-list (cadr form))
(testcover-reinstrument-list (cddr form)))
((eq fun 'if)
- ;;1-valued if both THEN and ELSE clauses are
+ ;;Potentially 1-valued if both THEN and ELSE clauses are
(testcover-reinstrument (cadr form))
(let ((then (testcover-reinstrument (nth 2 form)))
(else (testcover-reinstrument-list (nthcdr 3 form))))
- (and then else)))
- ((memq fun '(when unless and))
- ;;1-valued if last clause of BODY is
- (testcover-reinstrument-list (cdr form)))
+ (and then else 'maybe)))
((eq fun 'cond)
- ;;1-valued if all clauses are
- (testcover-reinstrument-clauses (cdr form)))
+ ;;Potentially 1-valued if all clauses are
+ (when (testcover-reinstrument-compose (cdr form)
+ 'testcover-reinstrument-list)
+ 'maybe))
((eq fun 'condition-case)
- ;;1-valued if BODYFORM is and all HANDLERS are
+ ;;Potentially 1-valued if BODYFORM is and all HANDLERS are
(let ((body (testcover-reinstrument (nth 2 form)))
- (errs (testcover-reinstrument-clauses (mapcar #'cdr
- (nthcdr 3 form)))))
- (and body errs)))
+ (errs (testcover-reinstrument-compose
+ (mapcar #'cdr (nthcdr 3 form))
+ 'testcover-reinstrument-list)))
+ (and body errs 'maybe)))
((eq fun 'quote)
;;Don't reinstrument what's inside!
;;This doesn't apply within a backquote
@@ -317,16 +346,55 @@ always return the same value."
(let ((testcover-1value-functions
(remq 'quote testcover-1value-functions)))
(testcover-reinstrument (cadr form))))
- ((memq fun '(1value noreturn))
+ ((eq fun '1value)
;;Hack - pretend the arg is 1-valued here
- (if (symbolp (cadr form)) ;A pseudoconstant variable
- t
+ (cond
+ ((symbolp (cadr form))
+ ;;A pseudoconstant variable
+ t)
+ ((and (eq (car (cadr form)) 'edebug-after)
+ (symbolp (nth 3 (cadr form))))
+ ;;Reference to pseudoconstant
+ (aset testcover-vector (nth 2 (cadr form)) '1value)
+ (setcar (cdr form) `(testcover-1value ,(nth 2 (cadr form))
+ ,(nth 3 (cadr form))))
+ t)
+ (t
(if (eq (car (cadr form)) 'edebug-after)
(setq id (car (nth 3 (cadr form))))
(setq id (car (cadr form))))
(let ((testcover-1value-functions
(cons id testcover-1value-functions)))
- (testcover-reinstrument (cadr form)))))
+ (testcover-reinstrument (cadr form))))))
+ ((eq fun 'noreturn)
+ ;;Hack - pretend the arg has no return
+ (cond
+ ((symbolp (cadr form))
+ ;;A pseudoconstant variable
+ 'maybe)
+ ((and (eq (car (cadr form)) 'edebug-after)
+ (symbolp (nth 3 (cadr form))))
+ ;;Reference to pseudoconstant
+ (aset testcover-vector (nth 2 (cadr form)) '1value)
+ (setcar (cdr form) `(progn (testcover-after ,(nth 2 (cadr form)) nil)
+ ,(nth 3 (cadr form))))
+ 'maybe)
+ (t
+ (if (eq (car (cadr form)) 'edebug-after)
+ (setq id (car (nth 3 (cadr form))))
+ (setq id (car (cadr form))))
+ (let ((testcover-noreturn-functions
+ (cons id testcover-noreturn-functions)))
+ (testcover-reinstrument (cadr form))))))
+ ((and (eq fun 'apply)
+ (eq (car-safe (cadr form)) 'quote)
+ (symbolp (cadr (cadr form))))
+ ;;Apply of a constant symbol. Process as 1value or noreturn
+ ;;depending on symbol.
+ (setq fun (cons (cadr (cadr form)) (cddr form))
+ val (testcover-reinstrument fun))
+ (setcdr (cdr form) (cdr fun))
+ val)
(t ;Some other function or weird thing
(testcover-reinstrument-list (cdr form))
nil))))
@@ -341,13 +409,22 @@ always be nil, so we return t for 1-valued."
(setq result (testcover-reinstrument (pop list))))
result))
-(defun testcover-reinstrument-clauses (clauselist)
- "Reinstrument each list in CLAUSELIST.
-Result is t if every clause is 1-valued."
+(defun testcover-reinstrument-compose (list fun)
+ "For a compositional function, the result is 1-valued if all
+arguments are, potentially 1-valued if all arguments are either
+definitely or potentially 1-valued, and multi-valued otherwise.
+FUN should be `testcover-reinstrument' for compositional functions,
+ `testcover-reinstrument-list' for clauses in a `cond'."
(let ((result t))
(mapc #'(lambda (x)
- (setq result (and (testcover-reinstrument-list x) result)))
- clauselist)
+ (setq x (funcall fun x))
+ (cond
+ ((eq result t)
+ (setq result x))
+ ((eq result 'maybe)
+ (when (not x)
+ (setq result nil)))))
+ list)
result))
(defun testcover-end (buffer)
@@ -387,7 +464,7 @@ same value during coverage testing."
(aset testcover-vector idx (cons '1value val)))
((not (and (eq (car-safe (aref testcover-vector idx)) '1value)
(equal (cdr (aref testcover-vector idx)) val)))
- (error "Value of form marked with `1value' does vary.")))
+ (error "Value of form marked with `1value' does vary: %s" val)))
val)
@@ -415,7 +492,7 @@ eliminated by adding more test cases."
ov j item)
(or (and def-mark points coverage)
(error "Missing edebug data for function %s" def))
- (when len
+ (when (> len 0)
(set-buffer (marker-buffer def-mark))
(mapc 'delete-overlay
(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',
;; If the keywords were compiled before, compile them again.
(if was-compiled
(set (make-local-variable 'font-lock-keywords)
- (font-lock-compile-keywords keywords t)))))))
+ (font-lock-compile-keywords font-lock-keywords t)))))))
(defun font-lock-update-removed-keyword-alist (mode keywords append)
;; Update `font-lock-removed-keywords-alist' when adding new
@@ -801,7 +801,7 @@ subtle problems due to details of the implementation."
;; If the keywords were compiled before, compile them again.
(if was-compiled
(set (make-local-variable 'font-lock-keywords)
- (font-lock-compile-keywords keywords t)))))))
+ (font-lock-compile-keywords font-lock-keywords t)))))))
;;; Font Lock Support mode.
@@ -1945,12 +1945,12 @@ This function could be MATCHER in a MATCH-ANCHORED `font-lock-keywords' item."
'("when" "unless" "case" "ecase" "typecase" "etypecase"
"ccase" "ctypecase" "handler-case" "handler-bind"
"restart-bind" "restart-case" "in-package"
- "cerror" "break" "ignore-errors"
+ "break" "ignore-errors"
"loop" "do" "do*" "dotimes" "dolist" "the" "locally"
"proclaim" "declaim" "declare" "symbol-macrolet"
"lexical-let" "lexical-let*" "flet" "labels" "compiler-let"
- "destructuring-bind" "macrolet" "tagbody" "block"
- "multiple-value-bind"
+ "destructuring-bind" "macrolet" "tagbody" "block" "go"
+ "multiple-value-bind" "multiple-value-prog1"
"return" "return-from"
"with-accessors" "with-compilation-unit"
"with-condition-restarts" "with-hash-table-iterator"
@@ -1968,7 +1968,7 @@ This function could be MATCHER in a MATCH-ANCHORED `font-lock-keywords' item."
'(2 font-lock-constant-face nil t))
;;
;; Erroneous structures.
- '("(\\(abort\\|assert\\|error\\|signal\\)\\>" 1 font-lock-warning-face)
+ '("(\\(abort\\|assert\\|warn\\|check-type\\|cerror\\|error\\|signal\\)\\>" 1 font-lock-warning-face)
;;
;; Words inside \\[] tend to be for `substitute-command-keys'.
'("\\\\\\\\\\[\\(\\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."
;;;; Creation of additional frames, and other frame miscellanea
(defun modify-all-frames-parameters (alist)
- "modify all current and future frames parameters according to ALIST.
+ "Modify all current and future frames parameters according to ALIST.
This changes `default-frame-alist' and possibly `initial-frame-alist'.
See help of `modify-frame-parameters' for more information."
(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."
;;; Interface variables that probably shouldn't be changed
-(defconst footnote-section-tag "Footnotes: "
- "*Tag inserted at beginning of footnote section.")
+(defcustom footnote-section-tag "Footnotes: "
+ "*Tag inserted at beginning of footnote section."
+ :version "21.4"
+ :type 'string
+ :group 'footnote)
(defcustom footnote-section-tag-regexp "Footnotes\\(\\[.\\]\\)?: "
"*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."
(when real-user
(let ((pw-prompt "Password:"))
(tramp-message 9 "Sending password")
- (tramp-enter-password p pw-prompt)))
+ (tramp-enter-password p pw-prompt user host)))
(unless (tramp-smb-wait-for-output user host)
(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 @@
"Like `vc-do-command' but invoked for tramp files.
See `vc-do-command' for more information."
(save-match-data
- (and file (setq file (tramp-handle-expand-file-name file)))
+ (and file (setq file (expand-file-name file)))
(if (not buffer) (setq buffer "*vc*"))
(if vc-command-messages
(message "Running `%s' on `%s'..." command file))
@@ -85,7 +85,7 @@ See `vc-do-command' for more information."
(squeezed nil)
(olddir default-directory)
vc-file status)
- (let* ((v (tramp-dissect-file-name (tramp-handle-expand-file-name file)))
+ (let* ((v (tramp-dissect-file-name (expand-file-name file)))
(multi-method (tramp-file-name-multi-method v))
(method (tramp-file-name-method v))
(user (tramp-file-name-user v))
@@ -130,7 +130,7 @@ See `vc-do-command' for more information."
(save-excursion
(save-window-excursion
;; Actually execute remote command
- (tramp-handle-shell-command
+ (shell-command
(mapconcat 'tramp-shell-quote-argument
(cons command squeezed) " ") t)
;;(tramp-wait-for-output)
@@ -190,7 +190,7 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either."
(let ((w32-quote-process-args t))
(when (eq okstatus 'async)
(message "Tramp doesn't do async commands, running synchronously."))
- (setq status (tramp-handle-shell-command
+ (setq status (shell-command
(mapconcat 'tramp-shell-quote-argument
(cons command squeezed) " ") t))
(when (or (not (integerp status))
@@ -257,7 +257,7 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either."
;; Don't switch to the *vc-info* buffer before running the
;; command, because that would change its default directory
(save-match-data
- (let* ((v (tramp-dissect-file-name (tramp-handle-expand-file-name file)))
+ (let* ((v (tramp-dissect-file-name (expand-file-name file)))
(multi-method (tramp-file-name-multi-method v))
(method (tramp-file-name-method v))
(user (tramp-file-name-user v))
@@ -284,7 +284,7 @@ Since TRAMP doesn't do async commands yet, this function doesn't, either."
(save-excursion
(save-window-excursion
;; Actually execute remote command
- (tramp-handle-shell-command
+ (shell-command
(mapconcat 'tramp-shell-quote-argument
(append (list command) args (list localname)) " ")
(get-buffer-create"*vc-info*"))
@@ -414,7 +414,7 @@ filename we are thinking about..."
(nth 2 (file-attributes file)))))
(if (and uid (/= uid remote-uid))
(error "tramp-handle-vc-user-login-name cannot map a uid to a name")
- (let* ((v (tramp-dissect-file-name (tramp-handle-expand-file-name file)))
+ (let* ((v (tramp-dissect-file-name (expand-file-name file)))
(u (tramp-file-name-user v)))
(cond ((stringp u) u)
((vectorp u) (elt u (1- (length u))))
@@ -445,8 +445,8 @@ filename we are thinking about..."
(defun tramp-file-owner (filename)
"Return who owns FILE (user name, as a string)."
(let ((v (tramp-dissect-file-name
- (tramp-handle-expand-file-name filename))))
- (if (not (tramp-handle-file-exists-p filename))
+ (expand-file-name filename))))
+ (if (not (file-exists-p filename))
nil ; file cannot be opened
;; file exists, find out stuff
(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."
"Regular expression indicating a process has finished.
In fact this expression is empty by intention, it will be used only to
check regularly the status of the associated process.
-The answer will be provided by `tramp-action-process-alive' and
-`tramp-action-out-of-band', which see."
+The answer will be provided by `tramp-action-process-alive',
+`tramp-multi-action-process-alive' and`tramp-action-out-of-band', which see."
:group 'tramp
:type 'regexp)
@@ -1321,7 +1321,7 @@ See `tramp-actions-before-shell' for more info."
(shell-prompt-pattern tramp-multi-action-succeed)
(tramp-shell-prompt-pattern tramp-multi-action-succeed)
(tramp-wrong-passwd-regexp tramp-multi-action-permission-denied)
- (tramp-process-alive-regexp tramp-action-process-alive))
+ (tramp-process-alive-regexp tramp-multi-action-process-alive))
"List of pattern/action pairs.
This list is used for each hop in multi-hop connections.
See `tramp-actions-before-shell' for more info."
@@ -2165,7 +2165,7 @@ target of the symlink differ."
(let ((nonnumeric (and id-format (equal id-format 'string)))
result)
(with-parsed-tramp-file-name filename nil
- (when (tramp-handle-file-exists-p filename)
+ (when (file-exists-p filename)
;; file exists, find out stuff
(save-excursion
(if (tramp-get-remote-perl multi-method method user host)
@@ -2331,7 +2331,12 @@ If it doesn't exist, generate a new one."
;; This function makes the same assumption as
;; `tramp-handle-set-visited-file-modtime'.
(defun tramp-handle-verify-visited-file-modtime (buf)
- "Like `verify-visited-file-modtime' for tramp files."
+ "Like `verify-visited-file-modtime' for tramp files.
+At the time `verify-visited-file-modtime' calls this function, we
+already know that the buffer is visiting a file and that
+`visited-file-modtime' does not return 0. Do not call this
+function directly, unless those two cases are already taken care
+of."
(with-current-buffer buf
(let ((f (buffer-file-name)))
(with-parsed-tramp-file-name f nil
@@ -2509,19 +2514,19 @@ if the remote host can't provide the modtime."
(defun tramp-handle-file-writable-p (filename)
"Like `file-writable-p' for tramp files."
(with-parsed-tramp-file-name filename nil
- (if (tramp-handle-file-exists-p filename)
+ (if (file-exists-p filename)
;; Existing files must be writable.
(zerop (tramp-run-test "-w" filename))
;; If file doesn't exist, check if directory is writable.
(and (zerop (tramp-run-test
- "-d" (tramp-handle-file-name-directory filename)))
+ "-d" (file-name-directory filename)))
(zerop (tramp-run-test
- "-w" (tramp-handle-file-name-directory filename)))))))
+ "-w" (file-name-directory filename)))))))
(defun tramp-handle-file-ownership-preserved-p (filename)
"Like `file-ownership-preserved-p' for tramp files."
(with-parsed-tramp-file-name filename nil
- (or (not (tramp-handle-file-exists-p filename))
+ (or (not (file-exists-p filename))
;; Existing files must be writable.
(zerop (tramp-run-test "-O" filename)))))
@@ -3064,7 +3069,7 @@ This is like `dired-recursive-delete-directory' for tramp files."
(with-parsed-tramp-file-name filename nil
;; run a shell command 'rm -r <localname>'
;; Code shamelessly stolen for the dired implementation and, um, hacked :)
- (or (tramp-handle-file-exists-p filename)
+ (or (file-exists-p filename)
(signal
'file-error
(list "Removing old file name" "no such directory" filename)))
@@ -3075,7 +3080,7 @@ This is like `dired-recursive-delete-directory' for tramp files."
;; This might take a while, allow it plenty of time.
(tramp-wait-for-output 120)
;; Make sure that it worked...
- (and (tramp-handle-file-exists-p filename)
+ (and (file-exists-p filename)
(error "Failed to recusively delete %s" filename))))
(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
(defun tramp-handle-find-backup-file-name (filename)
"Like `find-backup-file-name' for tramp files."
+ (with-parsed-tramp-file-name filename nil
+ ;; We set both variables. It doesn't matter whether it is
+ ;; Emacs or XEmacs
+ (let ((backup-directory-alist
+ ;; Emacs case
+ (when (boundp 'backup-directory-alist)
+ (if (boundp 'tramp-backup-directory-alist)
+ (mapcar
+ '(lambda (x)
+ (cons
+ (car x)
+ (if (and (stringp (cdr x))
+ (file-name-absolute-p (cdr x))
+ (not (tramp-file-name-p (cdr x))))
+ (tramp-make-tramp-file-name
+ multi-method method user host (cdr x))
+ (cdr x))))
+ (symbol-value 'tramp-backup-directory-alist))
+ (symbol-value 'backup-directory-alist))))
+
+ (bkup-backup-directory-info
+ ;; XEmacs case
+ (when (boundp 'bkup-backup-directory-info)
+ (if (boundp 'tramp-bkup-backup-directory-info)
+ (mapcar
+ '(lambda (x)
+ (nconc
+ (list (car x))
+ (list
+ (if (and (stringp (car (cdr x)))
+ (file-name-absolute-p (car (cdr x)))
+ (not (tramp-file-name-p (car (cdr x)))))
+ (tramp-make-tramp-file-name
+ multi-method method user host (car (cdr x)))
+ (car (cdr x))))
+ (cdr (cdr x))))
+ (symbol-value 'tramp-bkup-backup-directory-info))
+ (symbol-value 'bkup-backup-directory-info)))))
+
+ (tramp-run-real-handler 'find-backup-file-name (list filename)))))
- (if (or (and (not (featurep 'xemacs))
- (not (boundp 'tramp-backup-directory-alist)))
- (and (featurep 'xemacs)
- (not (boundp 'tramp-bkup-backup-directory-info))))
-
- ;; No tramp backup directory alist defined, or nil
- (tramp-run-real-handler 'find-backup-file-name (list filename))
-
- (with-parsed-tramp-file-name filename nil
- (let* ((backup-var
- (copy-tree
- (if (featurep 'xemacs)
- ;; XEmacs case
- (symbol-value 'tramp-bkup-backup-directory-info)
- ;; Emacs case
- (symbol-value 'tramp-backup-directory-alist))))
-
- ;; We set both variables. It doesn't matter whether it is
- ;; Emacs or XEmacs
- (backup-directory-alist backup-var)
- (bkup-backup-directory-info backup-var))
-
- (mapcar
- '(lambda (x)
- (let ((dir (if (consp (cdr x)) (car (cdr x)) (cdr x))))
- (when (and (stringp dir)
- (file-name-absolute-p dir)
- (not (tramp-file-name-p dir)))
- ;; Prepend absolute directory names with tramp prefix
- (if (consp (cdr x))
- (setcar (cdr x)
- (tramp-make-tramp-file-name
- multi-method method user host dir))
- (setcdr x (tramp-make-tramp-file-name
- multi-method method user host dir))))))
- backup-var)
-
- (tramp-run-real-handler 'find-backup-file-name (list filename))))))
;; CCC grok APPEND, LOCKNAME, CONFIRM
(defun tramp-handle-write-region
@@ -3689,6 +3696,9 @@ This will break if COMMAND prints a newline, followed by the value of
;; use an encoding function, but currently we use it always
;; because this makes the logic simpler.
(setq tmpfil (tramp-make-temp-file))
+ ;; Set current buffer. If connection wasn't open, `file-modes' has
+ ;; changed it accidently.
+ (set-buffer curbuf)
;; We say `no-message' here because we don't want the visited file
;; modtime data to be clobbered from the temp file. We call
;; `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."
(foreign (apply foreign operation args))
(t (tramp-run-real-handler operation args))))))
+
+;; In Emacs, there is some concurrency due to timers. If a timer
+;; interrupts Tramp and wishes to use the same connection buffer as
+;; the "main" Emacs, then garbage might occur in the connection
+;; buffer. Therefore, we need to make sure that a timer does not use
+;; the same connection buffer as the "main" Emacs. We implement a
+;; cheap global lock, instead of locking each connection buffer
+;; separately. The global lock is based on two variables,
+;; `tramp-locked' and `tramp-locker'. `tramp-locked' is set to true
+;; (with setq) to indicate a lock. But Tramp also calls itself during
+;; processing of a single file operation, so we need to allow
+;; recursive calls. That's where the `tramp-locker' variable comes in
+;; -- it is let-bound to t during the execution of the current
+;; handler. So if `tramp-locked' is t and `tramp-locker' is also t,
+;; then we should just proceed because we have been called
+;; recursively. But if `tramp-locker' is nil, then we are a timer
+;; interrupting the "main" Emacs, and then we signal an error.
+
+(defvar tramp-locked nil
+ "If non-nil, then Tramp is currently busy.
+Together with `tramp-locker', this implements a locking mechanism
+preventing reentrant calls of Tramp.")
+
+(defvar tramp-locker nil
+ "If non-nil, then a caller has locked Tramp.
+Together with `tramp-locked', this implements a locking mechanism
+preventing reentrant calls of Tramp.")
+
(defun tramp-sh-file-name-handler (operation &rest args)
"Invoke remote-shell Tramp file name handler.
Fall back to normal file name handler if no Tramp handler exists."
- (save-match-data
- (let ((fn (assoc operation tramp-file-name-handler-alist)))
- (if fn
- (apply (cdr fn) args)
- (tramp-run-real-handler operation args)))))
+ (when (and tramp-locked (not tramp-locker))
+ (signal 'file-error "Forbidden reentrant call of Tramp"))
+ (let ((tl tramp-locked))
+ (unwind-protect
+ (progn
+ (setq tramp-locked t)
+ (let ((tramp-locker t))
+ (save-match-data
+ (let ((fn (assoc operation tramp-file-name-handler-alist)))
+ (if fn
+ (apply (cdr fn) args)
+ (tramp-run-real-handler operation args))))))
+ (setq tramp-locked tl))))
;;;###autoload
(defun tramp-completion-file-name-handler (operation &rest args)
@@ -4062,7 +4108,7 @@ necessary anymore."
(tramp-make-tramp-file-name multi-method method
user host x)))
(read (current-buffer))))))
- (list (tramp-handle-expand-file-name name))))))
+ (list (expand-file-name name))))))
;; Check for complete.el and override PC-expand-many-files if appropriate.
(eval-and-compile
@@ -4073,7 +4119,7 @@ necessary anymore."
(symbol-function 'PC-expand-many-files))
(defun PC-expand-many-files (name)
(if (tramp-tramp-file-p name)
- (tramp-handle-expand-many-files name)
+ (expand-many-files name)
(tramp-save-PC-expand-many-files name))))
;; Why isn't eval-after-load sufficient?
@@ -4824,17 +4870,17 @@ file exists and nonzero exit status otherwise."
;; `/usr/bin/test -e' In case `/bin/test' does not exist.
(unless (or
(and (setq tramp-file-exists-command "test -e %s")
- (tramp-handle-file-exists-p existing)
- (not (tramp-handle-file-exists-p nonexisting)))
+ (file-exists-p existing)
+ (not (file-exists-p nonexisting)))
(and (setq tramp-file-exists-command "/bin/test -e %s")
- (tramp-handle-file-exists-p existing)
- (not (tramp-handle-file-exists-p nonexisting)))
+ (file-exists-p existing)
+ (not (file-exists-p nonexisting)))
(and (setq tramp-file-exists-command "/usr/bin/test -e %s")
- (tramp-handle-file-exists-p existing)
- (not (tramp-handle-file-exists-p nonexisting)))
+ (file-exists-p existing)
+ (not (file-exists-p nonexisting)))
(and (setq tramp-file-exists-command "ls -d %s")
- (tramp-handle-file-exists-p existing)
- (not (tramp-handle-file-exists-p nonexisting))))
+ (file-exists-p existing)
+ (not (file-exists-p nonexisting))))
(error "Couldn't find command to check if file exists."))))
@@ -4896,9 +4942,8 @@ file exists and nonzero exit status otherwise."
METHOD, USER and HOST specify the connection, CMD (the absolute file name of)
the `ls' executable. Returns t if CMD supports the `-n' option, nil
otherwise."
- (tramp-message 9 "Checking remote `%s' command for `-n' option"
- cmd)
- (when (tramp-handle-file-executable-p
+ (tramp-message 9 "Checking remote `%s' command for `-n' option" cmd)
+ (when (file-executable-p
(tramp-make-tramp-file-name multi-method method user host cmd))
(let ((result nil))
(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."
"Query the user for a password."
(let ((pw-prompt (match-string 0)))
(tramp-message 9 "Sending password")
- (tramp-enter-password p pw-prompt)))
+ (tramp-enter-password p pw-prompt user host)))
(defun tramp-action-succeed (p multi-method method user host)
"Signal success in finding shell prompt."
@@ -5034,7 +5079,7 @@ The terminal type can be configured with `tramp-terminal-type'."
(defun tramp-multi-action-password (p method user host)
"Query the user for a password."
(tramp-message 9 "Sending password")
- (tramp-enter-password p (match-string 0)))
+ (tramp-enter-password p (match-string 0) user host))
(defun tramp-multi-action-succeed (p method user host)
"Signal success in finding shell prompt."
@@ -5049,6 +5094,11 @@ The terminal type can be configured with `tramp-terminal-type'."
(erase-buffer)
(throw 'tramp-action 'permission-denied))
+(defun tramp-multi-action-process-alive (p method user host)
+ "Check whether a process has finished."
+ (unless (memq (process-status p) '(run open))
+ (throw 'tramp-action 'process-died)))
+
;; Functions for processing the actions.
(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.
(login-args (tramp-get-method-parameter
multi-method
(tramp-find-method multi-method method user host)
- user host 'tramp-login-args)))
+ user host 'tramp-login-args))
+ (real-host host))
;; The following should be changed. We need a more general
;; mechanism to parse extra host args.
(when (string-match "\\([^#]*\\)#\\(.*\\)" host)
(setq login-args (cons "-p" (cons (match-string 2 host) login-args)))
- (setq host (match-string 1 host)))
+ (setq real-host (match-string 1 host)))
(setenv "TERM" tramp-terminal-type)
(let* ((default-directory (tramp-temporary-file-directory))
;; 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.
tramp-dos-coding-system))
(p (if (and user (not (string= user "")))
(apply #'start-process bufnam buf login-program
- host "-l" user login-args)
+ real-host "-l" user login-args)
(apply #'start-process bufnam buf login-program
- host login-args)))
+ real-host login-args)))
(found nil))
(tramp-set-process-query-on-exit-flag p nil)
@@ -5547,10 +5598,10 @@ seconds. If not, it produces an error message with the given ERROR-ARGS."
(pop-to-buffer (buffer-name))
(apply 'error error-args)))
-(defun tramp-enter-password (p prompt)
+(defun tramp-enter-password (p prompt user host)
"Prompt for a password and send it to the remote end.
Uses PROMPT as a prompt and sends the password to process P."
- (let ((pw (tramp-read-passwd prompt)))
+ (let ((pw (tramp-read-passwd user host prompt)))
(erase-buffer)
(process-send-string
p (concat pw
@@ -6717,16 +6768,11 @@ this is the function `temp-directory'."
"`temp-directory' is defined -- using /tmp."))
(file-name-as-directory "/tmp"))))
-(defun tramp-read-passwd (prompt)
+(defun tramp-read-passwd (user host prompt)
"Read a password from user (compat function).
Invokes `password-read' if available, `read-passwd' else."
(if (functionp 'password-read)
- (let* ((user (or tramp-current-user (user-login-name)))
- (host (or tramp-current-host (system-name)))
- (key (if (and (stringp user) (stringp host))
- (concat user "@" host)
- (concat "[" (mapconcat 'identity user "/") "]@["
- (mapconcat 'identity host "/") "]")))
+ (let* ((key (concat (or user (user-login-name)) "@" host))
(password (apply #'password-read (list prompt key))))
(apply #'password-cache-add (list key password))
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 @@
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
-;; Time-stamp: <2004/07/12 21:10:35 vinicius>
+;; Time-stamp: <2004/07/20 21:44:43 vinicius>
;; Keywords: wp, print, PostScript
;; Version: 6.8
;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
@@ -40,37 +40,22 @@ Please send all bug fixes and enhancements to
;; Introduction
;; ------------
;;
-;; This package provides an user interface to some printing utilities that
-;; includes previewing/printing a PostScript file, printing a text file and
-;; previewing/printing some major modes (like mh-folder-mode,
-;; rmail-summary-mode, gnus-summary-mode, etc). It also includes a
-;; PostScript/text printer database.
+;; With `printing' you can preview or print a PostScript file. You can also
+;; print a text file using PostScript, and preview or print buffers that use
+;; certain special modes like mh-folder-mode, rmail-summary-mode,
+;; gnus-summary-mode, etc. This package also includes a PostScript/text
+;; printer database.
;;
-;; Indeed, there are two user interfaces:
+;; There are two user interfaces:
;;
;; * Menu interface:
-;; When `printing' is loaded, the menubar is modified to use `printing'
-;; menu instead of the print options in menubar.
+;; The `printing' menu replaces the usual print options in the menu bar.
;; This is the default user interface.
;;
;; * Buffer interface:
-;; It is an option of `printing' menu, but it can be binded into another
-;; key, so user can activate the buffer interface directly without using
-;; a menu. See `pr-interface' command.
-;;
-;; `printing' was inspired on:
-;;
-;; print-nt.el Frederic Corne <frederic.corne@erli.fr>
-;; Special printing functions for Windows NT
-;;
-;; mh-e-init.el Tom Vogels <tov@ece.cmu.edu>
-;; PS-print for mail messages
-;;
-;; win32-ps-print.el Matthew O. Persico <mpersico@erols.com>
-;; PostScript printing with ghostscript
-;;
-;; ps-print-interface.el Volker Franz <volker.franz@tuebingen.mpg.de>
-;; Graphical front end for ps-print and previewing
+;; You can use a buffer interface instead of menus. It looks like a
+;; customization buffer. Basically, it has the same options found in the
+;; menu and some extra options, all this on a buffer.
;;
;; `printing' is prepared to run on GNU, Unix and NT systems.
;; On GNU or Unix system, `printing' depends on gs and gv utilities.
@@ -86,6 +71,20 @@ Please send all bug fixes and enhancements to
;; `http://www.cpqd.com.br/~vinicius/emacs/ps-print.tar.gz'.
;; Please, see README file for ps-print installation instructions.
;;
+;; `printing' was inspired on:
+;;
+;; print-nt.el Frederic Corne <frederic.corne@erli.fr>
+;; Special printing functions for Windows NT
+;;
+;; mh-e-init.el Tom Vogels <tov@ece.cmu.edu>
+;; PS-print for mail messages
+;;
+;; win32-ps-print.el Matthew O. Persico <mpersico@erols.com>
+;; PostScript printing with ghostscript
+;;
+;; ps-print-interface.el Volker Franz <volker.franz@tuebingen.mpg.de>
+;; Graphical front end for ps-print and previewing
+;;
;;
;; Log Messages
;; ------------
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 @@
;; Adapted-By: ESR
;; Keywords: unix, tools
-;; RMS:
-;; This needs work.
-;; Also, the doc strings need fixing: the first line doesn't stand alone,
-;; and other usage is not high quality. Symbol names don't have `...'.
-
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
@@ -63,6 +58,7 @@
;;
;; To Do:
;;
+;; * Add missing doc strings, improve terse doc strings.
;; * Eliminate electric stuff entirely.
;; * It might be nice to highlight targets differently depending on
;; 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."
:group 'which-func
:type 'integer)
-(defcustom which-func-format '("[" which-func-current "]")
+(defvar which-func-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mode-line mouse-1] 'beginning-of-defun)
+ (define-key map [mode-line mouse-2]
+ (lambda ()
+ (interactive)
+ (if (eq (point-min) 1)
+ (narrow-to-defun)
+ (widen))))
+ (define-key map [mode-line mouse-3] 'end-of-defun)
+ map)
+ "Keymap to display on mode line which-func.")
+
+(defface which-func-face
+ '((t (:inherit font-lock-function-name-face)))
+ "Face used to highlight mode line function names.
+Defaults to `font-lock-function-name-face' if font-lock is loaded."
+ :group 'which-func)
+
+(defcustom which-func-format
+ `("["
+ (:propertize which-func-current
+ local-map ,which-func-keymap
+ face which-func-face
+ ;;mouse-face highlight ; currently not evaluated :-(
+ help-echo "mouse-1: go to beginning, mouse-2: toggle rest visibility, mouse-3: go to end")
+ "]")
"Format for displaying the function in the mode line."
:group 'which-func
: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 @@
;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Keywords: wp, print, PostScript
-;; Time-stamp: <2004/03/10 18:57:00 vinicius>
-;; Version: 6.6.4
+;; Time-stamp: <2004/07/21 23:12:05 vinicius>
+;; Version: 6.6.5
;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
-(defconst ps-print-version "6.6.4"
- "ps-print.el, v 6.6.4 <2004/03/10 vinicius>
+(defconst ps-print-version "6.6.5"
+ "ps-print.el, v 6.6.5 <2004/07/21 vinicius>
Vinicius's last change version -- this file may have been edited as part of
Emacs without changes to the version number. When reporting bugs, please also
@@ -1353,6 +1353,9 @@ Please send all bug fixes and enhancements to
;; Acknowledgments
;; ---------------
;;
+;; Thanks to Michael Piotrowski <mxp@dynalabs.de> for improving the DSC
+;; compliance of the generated PostScript.
+;;
;; Thanks to Adam Doppelt <adoppelt@avogadro.com> for face mapping suggestion
;; for black/white PostScript printers.
;;
@@ -1424,7 +1427,7 @@ Please send all bug fixes and enhancements to
;; initial port to Emacs 19. His code is no longer part of ps-print, but his
;; work is still appreciated.
;;
-;; Thanks to Remi Houdaille and Michel Train, michel@metasoft.fdn.org, for
+;; Thanks to Remi Houdaille and Michel Train <michel@metasoft.fdn.org> for
;; adding underline support. Their code also is no longer part of ps-print,
;; but their efforts are not forgotten.
;;
@@ -4162,6 +4165,7 @@ If EXTENSION is any other symbol, it is ignored."
(defun ps-message-log-max ()
(and (not (string= (buffer-name) "*Messages*"))
+ (boundp 'message-log-max)
message-log-max))
@@ -4210,7 +4214,7 @@ If EXTENSION is any other symbol, it is ignored."
(defvar ps-printing-region nil
- "Variable used to indicate if the region that ps-print is printing.
+ "Variable used to indicate the region that ps-print is printing.
It is a cons, the car of which is the line number where the region begins, and
its cdr is the total number of lines in the buffer. Formatting functions can
use 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.")
ps-adobe-tag
"%%Title: " (buffer-name) ; Take job name from name of
; first buffer printed
- "\n%%Creator: " (user-full-name)
- " (using ps-print v" ps-print-version
- ")\n%%CreationDate: " (format-time-string "%T %b %d %Y")
+ "\n%%Creator: ps-print v" ps-print-version
+ "\n%%For: " (user-full-name)
+ "\n%%CreationDate: " (format-time-string "%T %b %d %Y")
"\n%%Orientation: "
(if ps-landscape-mode "Landscape" "Portrait")
"\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.")
(ps-remove-duplicates
(append (ps-fonts 'ps-font-for-text)
(list (ps-font 'ps-font-for-header 'normal)
- (ps-font 'ps-font-for-header 'bold))))
+ (ps-font 'ps-font-for-header 'bold)
+ (ps-font 'ps-font-for-footer 'normal)
+ (ps-font 'ps-font-for-footer 'bold))))
"\n%%+ font ")
+ "\n%%DocumentSuppliedResources: procset PSPrintUserDefinedPrologue-" (user-login-name) " 0 0"
"\n%%DocumentMedia: " (ps-page-dimensions-get-media dimensions)
(format " %d" (round (ps-page-dimensions-get-width dimensions)))
(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.")
ps-error-handler-alist))
1)) ; send to paper
ps-print-prologue-0
- "\n%%BeginProcSet: UserDefinedPrologue\n\n")
+ "\n%%BeginResource: procset PSPrintUserDefinedPrologue-" (user-login-name) " 0 0\n\n")
(ps-insert-string ps-user-defined-prologue)
- (ps-output "\n%%EndProcSet\n\n")
+ (ps-output "\n%%EndResource\n\n")
(ps-output-boolean "LandscapeMode "
(or ps-landscape-mode
@@ -5543,6 +5550,21 @@ XSTART YSTART are the relative position for the first page in a sheet.")
(mapcar 'ps-output ps-background-all-pages)
(ps-output "}def\n/printLocalBackground{\n}def\n")
+ (ps-output "\n%%EndProlog\n\n%%BeginSetup\n")
+
+ (ps-output
+ "\n%%IncludeResource: font Times-Roman"
+ "\n%%IncludeResource: font Times-Italic\n%%IncludeResource: font "
+ (mapconcat 'identity
+ (ps-remove-duplicates
+ (append (ps-fonts 'ps-font-for-text)
+ (list (ps-font 'ps-font-for-header 'normal)
+ (ps-font 'ps-font-for-header 'bold)
+ (ps-font 'ps-font-for-footer 'normal)
+ (ps-font 'ps-font-for-footer 'bold))))
+ "\n%%IncludeResource: font ")
+ "\n")
+
;; Header/line number fonts
(ps-output (format "/h0 %s(%s)cvn DefFont\n" ; /h0 14/Helvetica-Bold DefFont
ps-header-title-font-size-internal
@@ -5586,7 +5608,6 @@ XSTART YSTART are the relative position for the first page in a sheet.")
(ps-output (format "/SpaceWidthRatio %f def\n"
(/ (ps-lookup 'space-width) (ps-lookup 'size)))))
- (ps-output "\n%%EndProlog\n\n%%BeginSetup\n")
(unless (eq ps-spool-config 'lpr-switches)
(ps-output "\n%%BeginFeature: *Duplex "
(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."
nil
nil
nil
- 'regexp-history)))
+ 'regexp-history
+ default)))
(if (equal input "")
default
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'."
;; Don't split a line if the rest would look like a new paragraph.
(unless use-hard-newlines
(save-excursion
- (skip-chars-forward " \t") (looking-at paragraph-start)))
+ (skip-chars-forward " \t")
+ ;; If this break point is at the end of the line,
+ ;; which can occur for auto-fill, don't consider the newline
+ ;; which follows as a reason to return t.
+ (and (not (eolp))
+ (looking-at paragraph-start))))
(run-hook-with-args-until-success 'fill-nobreak-predicate)))))
;; Put `fill-find-break-point-function' property to charsets which
generated by cgit v1.2.3 (git 2.39.1) at 2025-07-03 11:44:00 +0000