diff options
| author | Miles Bader | 2004-07-23 04:30:44 +0000 |
|---|---|---|
| committer | Miles Bader | 2004-07-23 04:30:44 +0000 |
| commit | 6bb4a8bf9aaa63141ad7c12ab6b6ba9939050178 (patch) | |
| tree | ffe1b6fc55a6ef858938f3e80a9fd79ae096ad10 /lisp | |
| parent | cd9fc52e16bd2c780919c927bbf734039dd9a7dc (diff) | |
| parent | 9586e1d3a4255c58bf827400ab7c038a3ee988a3 (diff) | |
| download | emacs-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/ChangeLog | 116 | ||||
| -rw-r--r-- | lisp/autorevert.el | 12 | ||||
| -rw-r--r-- | lisp/dired-aux.el | 40 | ||||
| -rw-r--r-- | lisp/emacs-lisp/testcover.el | 223 | ||||
| -rw-r--r-- | lisp/font-lock.el | 12 | ||||
| -rw-r--r-- | lisp/frame.el | 2 | ||||
| -rw-r--r-- | lisp/mail/footnote.el | 7 | ||||
| -rw-r--r-- | lisp/net/tramp-smb.el | 2 | ||||
| -rw-r--r-- | lisp/net/tramp-vc.el | 18 | ||||
| -rw-r--r-- | lisp/net/tramp.el | 210 | ||||
| -rw-r--r-- | lisp/printing.el | 51 | ||||
| -rw-r--r-- | lisp/progmodes/make-mode.el | 6 | ||||
| -rw-r--r-- | lisp/progmodes/which-func.el | 28 | ||||
| -rw-r--r-- | lisp/ps-print.el | 47 | ||||
| -rw-r--r-- | lisp/replace.el | 3 | ||||
| -rw-r--r-- | lisp/textmodes/fill.el | 7 |
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 @@ | |||
| 1 | 2004-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 | |||
| 10 | 2004-07-22 Kim F. Storm <storm@cua.dk> | ||
| 11 | |||
| 12 | * progmodes/make-mode.el: Fix comments. | ||
| 13 | |||
| 14 | 2004-07-21 Vinicius Jose Latorre <viniciusjl@ig.com.br> | ||
| 15 | |||
| 16 | * printing.el: Doc fix. | ||
| 17 | |||
| 18 | 2004-07-20 Luc Teirlinck <teirllm@auburn.edu> | ||
| 19 | |||
| 20 | * frame.el (modify-all-frames-parameters): Minor doc fix. | ||
| 21 | |||
| 22 | 2004-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 | |||
| 30 | 2004-07-19 John Paul Wallington <jpw@gnu.org> | ||
| 31 | |||
| 32 | * dired-aux.el (dired-file-set-difference): Don't use `caddr'. | ||
| 33 | |||
| 34 | 2004-07-18 Luc Teirlinck <teirllm@auburn.edu> | ||
| 35 | |||
| 36 | * dired-aux.el (dired-do-kill-lines): Expand docstring. | ||
| 37 | Delete irrelevant code. | ||
| 38 | |||
| 39 | 2004-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 | |||
| 44 | 2004-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 | |||
| 51 | 2004-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 | |||
| 62 | 2004-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 | |||
| 90 | 2004-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 | |||
| 100 | 2004-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 | |||
| 111 | 2004-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 | |||
| 1 | 2004-07-16 Stephan Stahl <stahl@eos.franken.de> (tiny change) | 117 | 2004-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). |
| 629 | With a prefix argument, kill that many lines starting with the current line. | 629 | With 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.) |
| 631 | To kill an entire subdirectory, go to its directory header line | 631 | If you use this command with a prefix argument to kill the line |
| 632 | and use this command with a prefix argument (the value does not matter)." | 632 | for a file that is a directory, which you have inserted in the |
| 633 | Dired buffer as a subdirectory, then it deletes that subdirectory | ||
| 634 | from the buffer as well. | ||
| 635 | To kill an entire subdirectory \(without killing its line in the | ||
| 636 | parent directory), go to its directory header line and use this | ||
| 637 | command 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 |
| 96 | for these. This list is quite incomplete! Notes: Nobody ever changes the | 100 | for these. This list is quite incomplete! Notes: Nobody ever changes the |
| 97 | current global map. The macro `lambda' is self-evaluating, hence always | 101 | current 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 |
| 115 | calls to one of the `testcover-1value-functions', so if that's true then no | 119 | calls to one of the `testcover-1value-functions', so if that's true then no |
| 116 | brown splotch is shown for these. This list is quite incomplete! Most | 120 | brown 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 |
| 128 | brown splotch is shown for these if the last argument is a constant or a | 133 | brown splotch is shown for these if the last argument is a constant or a |
| 129 | call to one of the `testcover-1value-functions'. This list is probably | 134 | call to one of the `testcover-1value-functions'. This list is probably |
| 130 | incomplete! Note: `or' is here in case the last argument is a function that | 135 | incomplete!" |
| 131 | always 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 | ||
| 150 | 1-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 |
| 210 | modifies the list that FORM points to. Result is non-nil if FORM will | 223 | function modifies the list that FORM points to. Result is nil if |
| 211 | always return the same value." | 224 | FORM should return multiple vlues, t if should always return same |
| 225 | value, '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 |
| 346 | Result is t if every clause is 1-valued." | 414 | arguments are, potentially 1-valued if all arguments are either |
| 415 | definitely or potentially 1-valued, and multi-valued otherwise. | ||
| 416 | FUN 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. |
| 524 | This changes `default-frame-alist' and possibly `initial-frame-alist'. | 524 | This changes `default-frame-alist' and possibly `initial-frame-alist'. |
| 525 | See help of `modify-frame-parameters' for more information." | 525 | See 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. |
| 78 | See `vc-do-command' for more information." | 78 | See `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. |
| 917 | In fact this expression is empty by intention, it will be used only to | 917 | In fact this expression is empty by intention, it will be used only to |
| 918 | check regularly the status of the associated process. | 918 | check regularly the status of the associated process. |
| 919 | The answer will be provided by `tramp-action-process-alive' and | 919 | The 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. |
| 1326 | This list is used for each hop in multi-hop connections. | 1326 | This list is used for each hop in multi-hop connections. |
| 1327 | See `tramp-actions-before-shell' for more info." | 1327 | See `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. |
| 2335 | At the time `verify-visited-file-modtime' calls this function, we | ||
| 2336 | already know that the buffer is visiting a file and that | ||
| 2337 | `visited-file-modtime' does not return 0. Do not call this | ||
| 2338 | function directly, unless those two cases are already taken care | ||
| 2339 | of." | ||
| 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. | ||
| 4005 | Together with `tramp-locker', this implements a locking mechanism | ||
| 4006 | preventing reentrant calls of Tramp.") | ||
| 4007 | |||
| 4008 | (defvar tramp-locker nil | ||
| 4009 | "If non-nil, then a caller has locked Tramp. | ||
| 4010 | Together with `tramp-locked', this implements a locking mechanism | ||
| 4011 | preventing 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. |
| 3977 | Fall back to normal file name handler if no Tramp handler exists." | 4015 | Fall 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." | |||
| 4896 | METHOD, USER and HOST specify the connection, CMD (the absolute file name of) | 4942 | METHOD, USER and HOST specify the connection, CMD (the absolute file name of) |
| 4897 | the `ls' executable. Returns t if CMD supports the `-n' option, nil | 4943 | the `ls' executable. Returns t if CMD supports the `-n' option, nil |
| 4898 | otherwise." | 4944 | otherwise." |
| 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. |
| 5552 | Uses PROMPT as a prompt and sends the password to process P." | 5603 | Uses 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). |
| 6722 | Invokes `password-read' if available, `read-passwd' else." | 6773 | Invokes `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. | ||
| 118 | Defaults 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 | ||
| 20 | Vinicius's last change version -- this file may have been edited as part of | 20 | Vinicius's last change version -- this file may have been edited as part of |
| 21 | Emacs without changes to the version number. When reporting bugs, please also | 21 | Emacs 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. |
| 4214 | It is a cons, the car of which is the line number where the region begins, and | 4218 | It is a cons, the car of which is the line number where the region begins, and |
| 4215 | its cdr is the total number of lines in the buffer. Formatting functions can | 4219 | its cdr is the total number of lines in the buffer. Formatting functions can |
| 4216 | use this information to print the original line number (and not the number of | 4220 | 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.") | |||
| 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 |