diff options
| author | Karoly Lorentey | 2004-05-30 21:11:48 +0000 |
|---|---|---|
| committer | Karoly Lorentey | 2004-05-30 21:11:48 +0000 |
| commit | a596810c6c3c3c2fd450717f5083a5ff5207d243 (patch) | |
| tree | e84b4a480f6b5bdfb232a384c4c77472950be2a8 | |
| parent | 3de8a2533978f2e296b418a1ab0ae41deb00fa40 (diff) | |
| parent | 9dd5e8d7c1e0cb26cc75f8cdf91eeaa170b48a6a (diff) | |
| download | emacs-a596810c6c3c3c2fd450717f5083a5ff5207d243.tar.gz emacs-a596810c6c3c3c2fd450717f5083a5ff5207d243.zip | |
Merged in changes from CVS trunk.
Patches applied:
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-344
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-345
Tweak source regexps so that building in place won't cause problems
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-346
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-347
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-348
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-349
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-350
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-351
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-352
Update from CVS: lisp/flymake.el: New file.
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-182
38 files changed, 3282 insertions, 337 deletions
diff --git a/.arch-inventory b/.arch-inventory new file mode 100644 index 00000000000..3733b7ed6e3 --- /dev/null +++ b/.arch-inventory | |||
| @@ -0,0 +1,3 @@ | |||
| 1 | precious ^(config\.status)$ | ||
| 2 | |||
| 3 | # arch-tag: 6eeeaa4e-cc7e-4b22-b3d7-1089e155da14 | ||
diff --git a/Makefile.in b/Makefile.in index 97d9a2a1079..7bfed3fd5ea 100644 --- a/Makefile.in +++ b/Makefile.in | |||
| @@ -445,11 +445,9 @@ install-arch-indep: mkdir info | |||
| 445 | if [ `(cd ./etc; /bin/pwd)` != `(cd ${docdir}; /bin/pwd)` ]; \ | 445 | if [ `(cd ./etc; /bin/pwd)` != `(cd ${docdir}; /bin/pwd)` ]; \ |
| 446 | then \ | 446 | then \ |
| 447 | echo "Copying etc/DOC-* to ${docdir} ..." ; \ | 447 | echo "Copying etc/DOC-* to ${docdir} ..." ; \ |
| 448 | (cd ./etc; tar -chf - DOC* compilation.txt) \ | 448 | (cd ./etc; tar -chf - DOC*) \ |
| 449 | |(cd ${docdir}; umask 022; tar -xvf - && cat > /dev/null) || exit 1; \ | 449 | |(cd ${docdir}; umask 022; tar -xvf - && cat > /dev/null) || exit 1; \ |
| 450 | (cd $(docdir); \ | 450 | (cd $(docdir); chown $${LOGNAME:-$$USERNAME} DOC*; chmod a+r DOC*; \ |
| 451 | chown $${LOGNAME:-$$USERNAME} DOC* compilation.txt; \ | ||
| 452 | chmod a+r DOC* compilation.txt; \ | ||
| 453 | if test "`echo DOC-*`" != "DOC-*"; then rm DOC; fi); \ | 451 | if test "`echo DOC-*`" != "DOC-*"; then rm DOC; fi); \ |
| 454 | else true; fi | 452 | else true; fi |
| 455 | -unset CDPATH; \ | 453 | -unset CDPATH; \ |
diff --git a/etc/.arch-inventory b/etc/.arch-inventory new file mode 100644 index 00000000000..2637a2d3d8e --- /dev/null +++ b/etc/.arch-inventory | |||
| @@ -0,0 +1,4 @@ | |||
| 1 | # Unlike most emacs dirs, etc has a simple non-autoconf-generated makefile | ||
| 2 | source ^(Makefile)$ | ||
| 3 | |||
| 4 | # arch-tag: 5a1d62e0-593a-48cd-8743-8d45dc58dfae | ||
| @@ -90,6 +90,9 @@ types any more. Add -DUSE_LISP_UNION_TYPE if you want union types. | |||
| 90 | 90 | ||
| 91 | * Changes in Emacs 21.4 | 91 | * Changes in Emacs 21.4 |
| 92 | 92 | ||
| 93 | ** A New package flymake.el does on-the-fly syntax checking of program | ||
| 94 | source files. See the Flymake's Info manual for more details. | ||
| 95 | |||
| 93 | ** New input method chinese-sisheng for inputting Chinese Pinyin | 96 | ** New input method chinese-sisheng for inputting Chinese Pinyin |
| 94 | characters. | 97 | characters. |
| 95 | 98 | ||
| @@ -1045,6 +1048,12 @@ counter to the specified source line (the one where point is). | |||
| 1045 | 1048 | ||
| 1046 | Minor Improvements | 1049 | Minor Improvements |
| 1047 | 1050 | ||
| 1051 | *** The STARTTLS elisp wrapper (starttls.el) can now use GNUTLS | ||
| 1052 | instead of the OpenSSL based "starttls" tool. For backwards | ||
| 1053 | compatibility, it will prefer "starttls", but you can toggle | ||
| 1054 | `starttls-use-gnutls' to switch to GNUTLS (or simply remove the | ||
| 1055 | "starttls" tool). | ||
| 1056 | |||
| 1048 | *** Do not allow debugger output history variable to grow without bounds. | 1057 | *** Do not allow debugger output history variable to grow without bounds. |
| 1049 | 1058 | ||
| 1050 | +++ | 1059 | +++ |
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 9e5aad11082..28f6d394230 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,115 @@ | |||
| 1 | 2004-05-29 Pavel Kobiakov <pk_at_work@yahoo.com> | ||
| 2 | |||
| 3 | * flymake.el: New file. | ||
| 4 | |||
| 5 | 2004-05-28 Luc Teirlinck <teirllm@auburn.edu> | ||
| 6 | |||
| 7 | * files.el (find-file-noselect-1): Do not bind | ||
| 8 | `inhibit-read-only' to t during execution of | ||
| 9 | `find-file-not-found-functions'. | ||
| 10 | |||
| 11 | 2004-05-28 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 12 | |||
| 13 | * vc-mcvs.el (vc-mcvs-print-log, vc-mcvs-diff): | ||
| 14 | * vc-arch.el (vc-arch-diff): Add optional `buffer' arg. | ||
| 15 | |||
| 16 | 2004-05-28 Juri Linkov <juri@jurta.org> | ||
| 17 | |||
| 18 | * simple.el (eval-expression-print-format): New fun. | ||
| 19 | |||
| 20 | * simple.el (eval-expression): | ||
| 21 | * emacs-lisp/lisp-mode.el (eval-last-sexp-print-value): | ||
| 22 | * emacs-lisp/edebug.el (edebug-compute-previous-result) | ||
| 23 | (edebug-eval-expression): Print additionally the value returned by | ||
| 24 | `eval-expression-print-format'. | ||
| 25 | |||
| 26 | * emacs-lisp/lisp.el (insert-pair-alist): New var. | ||
| 27 | (insert-pair): Make arguments optional. Find character pair | ||
| 28 | from `insert-pair-alist' according to the last input event. | ||
| 29 | (insert-parentheses): Make arguments optional. | ||
| 30 | (raise-sexp, delete-pair): New funs. | ||
| 31 | |||
| 32 | * emacs-lisp/lisp-mode.el (indent-pp-sexp): New fun. | ||
| 33 | (emacs-lisp-mode-map, lisp-interaction-mode-map): | ||
| 34 | Bind C-M-q to `indent-pp-sexp'. | ||
| 35 | |||
| 36 | * emacs-lisp/pp.el (pp-buffer): New fun created from the code in | ||
| 37 | `pp-to-string' modified to be able to format text with newlines. | ||
| 38 | (pp-to-string): Move the buffer-formatting part of the code to | ||
| 39 | `pp-buffer'. Call `pp-buffer'. | ||
| 40 | |||
| 41 | * info.el (Info-desktop-buffer-misc-data): Don't save information | ||
| 42 | about virtual files. | ||
| 43 | (Info-restore-desktop-buffer): Restore Info buffers in prepared | ||
| 44 | buffers with names obtained from the desktop file instead of the | ||
| 45 | default *info* buffer. | ||
| 46 | |||
| 47 | 2004-05-28 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 48 | |||
| 49 | * subr.el (with-selected-window): Only save/restore the selected window. | ||
| 50 | |||
| 51 | * progmodes/compile.el (compilation-error-regexp-alist): | ||
| 52 | Use expand-file-name and data-directory. | ||
| 53 | |||
| 54 | * progmodes/grep.el (grep-tree): Rework previous fix. | ||
| 55 | |||
| 56 | * mouse.el (mouse-set-region-1): Use temporary transient-mark-mode | ||
| 57 | after the user marked text with the mouse. | ||
| 58 | |||
| 59 | * startup.el (command-line): Keep the first regexp of | ||
| 60 | auto-save-file-name-transforms intact. | ||
| 61 | |||
| 62 | 2004-05-28 Juanma Barranquero <lektu@terra.es> | ||
| 63 | |||
| 64 | * cus-edit.el (customize-face, customize-face-other-window) | ||
| 65 | (custom-face-edit-delete): Make arguments match their use in docstring. | ||
| 66 | (custom-unloaded-symbol-p, custom-unloaded-widget-p): Docstring typo. | ||
| 67 | |||
| 68 | * cvs-status.el (cvs-tree-merge, cvs-tags->tree): Use `butlast', | ||
| 69 | not `cvs-butlast'. | ||
| 70 | |||
| 71 | * pcvs-util.el (cvs-butlast, cvs-nbutlast): Remove (`butlast' and | ||
| 72 | `nbutlast' are in subr.el). | ||
| 73 | |||
| 74 | * w32-fns.el (w32-using-nt, w32-shell-dos-semantics) | ||
| 75 | (set-w32-system-coding-system): Doc fixes. | ||
| 76 | |||
| 77 | * textmodes/artist.el (artist-last, artist-remove-nulls): Simplify. | ||
| 78 | (artist-draw-ellipse-general, artist-draw-ellipse-with-0-height): | ||
| 79 | Make arguments match their use in docstring. | ||
| 80 | (artist-draw-region-trim-line-endings) | ||
| 81 | (artist-mouse-choose-operation): Fix typo in docstring. | ||
| 82 | (artist-key-set-point-common): Doc fix. | ||
| 83 | |||
| 84 | 2004-05-28 Simon Josefsson <jas@extundo.com> | ||
| 85 | |||
| 86 | * mail/smtpmail.el (smtpmail-open-stream): | ||
| 87 | Bind starttls-extra-arguments too, if starttls.el uses GNUTLS. | ||
| 88 | |||
| 89 | 2004-05-26 Simon Josefsson <jas@extundo.com> | ||
| 90 | |||
| 91 | * starttls.el: Merge with my GNUTLS based starttls.el. | ||
| 92 | (starttls-gnutls-program, starttls-use-gnutls) | ||
| 93 | (starttls-extra-arguments, starttls-process-connection-type) | ||
| 94 | (starttls-connect, starttls-failure, starttls-success): New variables. | ||
| 95 | (starttls-program, starttls-extra-args): Doc fix. | ||
| 96 | (starttls-negotiate-gnutls, starttls-open-stream-gnutls): New funs. | ||
| 97 | (starttls-negotiate, starttls-open-stream): Check `starttls-use-gnutls' | ||
| 98 | and pass on to corresponding *-gnutls function if it is set. | ||
| 99 | |||
| 100 | 2004-05-27 Luc Teirlinck <teirllm@auburn.edu> | ||
| 101 | |||
| 102 | * autorevert.el (auto-revert-handler): Disable auto-reverting of | ||
| 103 | remote files. | ||
| 104 | |||
| 105 | 2004-05-27 Michael Albinus <michael.albinus@gmx.de> | ||
| 106 | |||
| 107 | * files.el (file-name-non-special): There are more operations | ||
| 108 | which need handling: `find-backup-file-name', | ||
| 109 | `insert-file-contents', `verify-visited-file-modtime', | ||
| 110 | `write-region'. Rename t value of method to `add'. Add new | ||
| 111 | methods `quote' and `unquote-then-quote' to file-arg-indices. | ||
| 112 | |||
| 1 | 2004-05-25 Juri Linkov <juri@jurta.org> | 113 | 2004-05-25 Juri Linkov <juri@jurta.org> |
| 2 | 114 | ||
| 3 | * info.el (Info-toc): Call Info-mode on intermediate buffer. | 115 | * info.el (Info-toc): Call Info-mode on intermediate buffer. |
| @@ -83,8 +195,7 @@ | |||
| 83 | * descr-text.el (describe-property-list): Add [show] button for | 195 | * descr-text.el (describe-property-list): Add [show] button for |
| 84 | `syntax-table' property with action to pp to a separate buffer. | 196 | `syntax-table' property with action to pp to a separate buffer. |
| 85 | (describe-char): Replace search-forward by re-search-forward with | 197 | (describe-char): Replace search-forward by re-search-forward with |
| 86 | whitespace regexp after "character:" to not fail in too narrow | 198 | whitespace regexp after "character:" to not fail in too narrow windows. |
| 87 | windows. | ||
| 88 | 199 | ||
| 89 | * simple.el (next-error-find-buffer): Add a rule to return | 200 | * simple.el (next-error-find-buffer): Add a rule to return |
| 90 | next-error capable buffer if one window on the selected frame | 201 | next-error capable buffer if one window on the selected frame |
| @@ -96,11 +207,11 @@ | |||
| 96 | (gud-watch, gdb-send-item, gdb-breakpoints-mode, gdb-frames-mode) | 207 | (gud-watch, gdb-send-item, gdb-breakpoints-mode, gdb-frames-mode) |
| 97 | (gdb-locals-mode, gdb-send-item, gdb-toggle-breakpoint) | 208 | (gdb-locals-mode, gdb-send-item, gdb-toggle-breakpoint) |
| 98 | (gdb-delete-breakpoint, gdb-frames-select, gdb-threads-buffer) | 209 | (gdb-delete-breakpoint, gdb-frames-select, gdb-threads-buffer) |
| 99 | (gdb-registers-buffer, gdb-reset, gdb-assembler-buffer): Handle | 210 | (gdb-registers-buffer, gdb-reset, gdb-assembler-buffer): |
| 100 | new value for gud-minor-mode (gdbmi). | 211 | Handle new value for gud-minor-mode (gdbmi). |
| 101 | (gdb-buffer-type, gdb-input-queue, gdb-prompting) | 212 | (gdb-buffer-type, gdb-input-queue, gdb-prompting) |
| 102 | (gdb-output-sink, gdb-current-item, gdb-pending-triggers): Change | 213 | (gdb-output-sink, gdb-current-item, gdb-pending-triggers): |
| 103 | from local to global gdb variable set. | 214 | Change from local to global gdb variable set. |
| 104 | (gdb-ann3): Initialise above gdb variable set. | 215 | (gdb-ann3): Initialise above gdb variable set. |
| 105 | (gdb-var-update, gdb-var-update-handler, gdb-enqueue-input) | 216 | (gdb-var-update, gdb-var-update-handler, gdb-enqueue-input) |
| 106 | (gdb-dequeue-input, gdb-source, gdb-pre-prompt, gdb-prompt) | 217 | (gdb-dequeue-input, gdb-source, gdb-pre-prompt, gdb-prompt) |
| @@ -185,8 +296,7 @@ | |||
| 185 | 296 | ||
| 186 | 2004-05-21 Masatake YAMATO <jet@gyve.org> | 297 | 2004-05-21 Masatake YAMATO <jet@gyve.org> |
| 187 | 298 | ||
| 188 | * progmodes/etags.el (tags-apropos, list-tags): Require | 299 | * progmodes/etags.el (tags-apropos, list-tags): Require apropos. |
| 189 | apropos. | ||
| 190 | (etags-tags-completion-table): Show parsing progress. | 300 | (etags-tags-completion-table): Show parsing progress. |
| 191 | 301 | ||
| 192 | 2004-05-20 Luc Teirlinck <teirllm@auburn.edu> | 302 | 2004-05-20 Luc Teirlinck <teirllm@auburn.edu> |
diff --git a/lisp/autorevert.el b/lisp/autorevert.el index 58bb6d29705..1ba48a54236 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el | |||
| @@ -311,6 +311,7 @@ This is an internal function used by Auto-Revert Mode." | |||
| 311 | (unless (buffer-modified-p) | 311 | (unless (buffer-modified-p) |
| 312 | (let ((buffer (current-buffer)) revert eob eoblist) | 312 | (let ((buffer (current-buffer)) revert eob eoblist) |
| 313 | (or (and buffer-file-name | 313 | (or (and buffer-file-name |
| 314 | (not (file-remote-p buffer-file-name)) | ||
| 314 | (file-readable-p buffer-file-name) | 315 | (file-readable-p buffer-file-name) |
| 315 | (not (verify-visited-file-modtime buffer)) | 316 | (not (verify-visited-file-modtime buffer)) |
| 316 | (setq revert t)) | 317 | (setq revert t)) |
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 11b91242cc2..d4b7aa6f518 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el | |||
| @@ -1012,11 +1012,11 @@ version." | |||
| 1012 | 1012 | ||
| 1013 | ;;;###autoload | 1013 | ;;;###autoload |
| 1014 | (defun customize-face (&optional face) | 1014 | (defun customize-face (&optional face) |
| 1015 | "Customize SYMBOL, which should be a face name or nil. | 1015 | "Customize FACE, which should be a face name or nil. |
| 1016 | If SYMBOL is nil, customize all faces. | 1016 | If FACE is nil, customize all faces. |
| 1017 | 1017 | ||
| 1018 | Interactively, when point is on text which has a face specified, | 1018 | Interactively, when point is on text which has a face specified, |
| 1019 | suggest to customized that face, if it's customizable." | 1019 | suggest to customize that face, if it's customizable." |
| 1020 | (interactive | 1020 | (interactive |
| 1021 | (list (read-face-name "Customize face" "all faces" t))) | 1021 | (list (read-face-name "Customize face" "all faces" t))) |
| 1022 | (if (member face '(nil "")) | 1022 | (if (member face '(nil "")) |
| @@ -1038,10 +1038,10 @@ suggest to customized that face, if it's customizable." | |||
| 1038 | 1038 | ||
| 1039 | ;;;###autoload | 1039 | ;;;###autoload |
| 1040 | (defun customize-face-other-window (&optional face) | 1040 | (defun customize-face-other-window (&optional face) |
| 1041 | "Show customization buffer for face SYMBOL in other window. | 1041 | "Show customization buffer for face FACE in other window. |
| 1042 | 1042 | ||
| 1043 | Interactively, when point is on text which has a face specified, | 1043 | Interactively, when point is on text which has a face specified, |
| 1044 | suggest to customized that face, if it's customizable." | 1044 | suggest to customize that face, if it's customizable." |
| 1045 | (interactive | 1045 | (interactive |
| 1046 | (list (read-face-name "Customize face" "all faces" t))) | 1046 | (list (read-face-name "Customize face" "all faces" t))) |
| 1047 | (if (member face '(nil "")) | 1047 | (if (member face '(nil "")) |
| @@ -1093,7 +1093,7 @@ suggest to customized that face, if it's customizable." | |||
| 1093 | (get symbol 'standard-value)))) | 1093 | (get symbol 'standard-value)))) |
| 1094 | (when (and cval ;Declared with defcustom. | 1094 | (when (and cval ;Declared with defcustom. |
| 1095 | (default-boundp symbol) ;Has a value. | 1095 | (default-boundp symbol) ;Has a value. |
| 1096 | (not (equal (eval (car cval)) | 1096 | (not (equal (eval (car cval)) |
| 1097 | ;; Which does not match customize. | 1097 | ;; Which does not match customize. |
| 1098 | (default-value symbol)))) | 1098 | (default-value symbol)))) |
| 1099 | (push (list symbol 'custom-variable) found))))) | 1099 | (push (list symbol 'custom-variable) found))))) |
| @@ -1876,7 +1876,7 @@ and `face'." | |||
| 1876 | (custom-load-symbol (widget-value widget))) | 1876 | (custom-load-symbol (widget-value widget))) |
| 1877 | 1877 | ||
| 1878 | (defun custom-unloaded-symbol-p (symbol) | 1878 | (defun custom-unloaded-symbol-p (symbol) |
| 1879 | "Return non-nil if the dependencies of SYMBOL has not yet been loaded." | 1879 | "Return non-nil if the dependencies of SYMBOL have not yet been loaded." |
| 1880 | (let ((found nil) | 1880 | (let ((found nil) |
| 1881 | (loads (get symbol 'custom-loads)) | 1881 | (loads (get symbol 'custom-loads)) |
| 1882 | load) | 1882 | load) |
| @@ -1894,7 +1894,7 @@ and `face'." | |||
| 1894 | found)) | 1894 | found)) |
| 1895 | 1895 | ||
| 1896 | (defun custom-unloaded-widget-p (widget) | 1896 | (defun custom-unloaded-widget-p (widget) |
| 1897 | "Return non-nil if the dependencies of WIDGET has not yet been loaded." | 1897 | "Return non-nil if the dependencies of WIDGET have not yet been loaded." |
| 1898 | (custom-unloaded-symbol-p (widget-value widget))) | 1898 | (custom-unloaded-symbol-p (widget-value widget))) |
| 1899 | 1899 | ||
| 1900 | (defun custom-toggle-hide (widget) | 1900 | (defun custom-toggle-hide (widget) |
| @@ -2646,7 +2646,7 @@ Also change :reverse-video to :inverse-video." | |||
| 2646 | (widget-setup))))) | 2646 | (widget-setup))))) |
| 2647 | 2647 | ||
| 2648 | (defun custom-face-edit-delete (widget) | 2648 | (defun custom-face-edit-delete (widget) |
| 2649 | "Remove widget from the buffer." | 2649 | "Remove WIDGET from the buffer." |
| 2650 | (let ((inactive (widget-get widget :inactive)) | 2650 | (let ((inactive (widget-get widget :inactive)) |
| 2651 | (inhibit-read-only t) | 2651 | (inhibit-read-only t) |
| 2652 | (inhibit-modification-hooks t)) | 2652 | (inhibit-modification-hooks t)) |
diff --git a/lisp/cvs-status.el b/lisp/cvs-status.el index 96b1f1eb066..b03182d87e4 100644 --- a/lisp/cvs-status.el +++ b/lisp/cvs-status.el | |||
| @@ -277,10 +277,10 @@ BEWARE: because of stability issues, this is not a symetric operation." | |||
| 277 | (cvs-tree-merge (cdr tree1) (cdr tree2)))))) | 277 | (cvs-tree-merge (cdr tree1) (cdr tree2)))))) |
| 278 | ((> l1 l2) | 278 | ((> l1 l2) |
| 279 | (cvs-tree-merge | 279 | (cvs-tree-merge |
| 280 | (list (cons (cvs-tag-make (cvs-butlast vl1)) tree1)) tree2)) | 280 | (list (cons (cvs-tag-make (butlast vl1)) tree1)) tree2)) |
| 281 | ((< l1 l2) | 281 | ((< l1 l2) |
| 282 | (cvs-tree-merge | 282 | (cvs-tree-merge |
| 283 | tree1 (list (cons (cvs-tag-make (cvs-butlast vl2)) tree2))))))))) | 283 | tree1 (list (cons (cvs-tag-make (butlast vl2)) tree2))))))))) |
| 284 | 284 | ||
| 285 | (defun cvs-tag-make-tag (tag) | 285 | (defun cvs-tag-make-tag (tag) |
| 286 | (let ((vl (mapcar 'string-to-number (split-string (nth 2 tag) "\\.")))) | 286 | (let ((vl (mapcar 'string-to-number (split-string (nth 2 tag) "\\.")))) |
| @@ -293,7 +293,7 @@ BEWARE: because of stability issues, this is not a symetric operation." | |||
| 293 | (lambda (tag) | 293 | (lambda (tag) |
| 294 | (let ((tag (cvs-tag-make-tag tag))) | 294 | (let ((tag (cvs-tag-make-tag tag))) |
| 295 | (list (if (not (eq (cvs-tag->type tag) 'branch)) tag | 295 | (list (if (not (eq (cvs-tag->type tag) 'branch)) tag |
| 296 | (list (cvs-tag-make (cvs-butlast (cvs-tag->vlist tag))) | 296 | (list (cvs-tag-make (butlast (cvs-tag->vlist tag))) |
| 297 | tag))))) | 297 | tag))))) |
| 298 | tags))) | 298 | tags))) |
| 299 | (while (cdr tags) | 299 | (while (cdr tags) |
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 8a924d045f7..3cebfd2435b 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el | |||
| @@ -3692,8 +3692,7 @@ Return the result of the last expression." | |||
| 3692 | (setq edebug-previous-result | 3692 | (setq edebug-previous-result |
| 3693 | (concat "Result: " | 3693 | (concat "Result: " |
| 3694 | (edebug-safe-prin1-to-string edebug-previous-value) | 3694 | (edebug-safe-prin1-to-string edebug-previous-value) |
| 3695 | (let ((name (prin1-char edebug-previous-value))) | 3695 | (eval-expression-print-format edebug-previous-value)))) |
| 3696 | (if name (concat " = " name)))))) | ||
| 3697 | 3696 | ||
| 3698 | (defun edebug-previous-result () | 3697 | (defun edebug-previous-result () |
| 3699 | "Print the previous result." | 3698 | "Print the previous result." |
| @@ -3712,7 +3711,8 @@ Print result in minibuffer." | |||
| 3712 | (princ | 3711 | (princ |
| 3713 | (edebug-outside-excursion | 3712 | (edebug-outside-excursion |
| 3714 | (setq values (cons (edebug-eval edebug-expr) values)) | 3713 | (setq values (cons (edebug-eval edebug-expr) values)) |
| 3715 | (edebug-safe-prin1-to-string (car values))))) | 3714 | (concat (edebug-safe-prin1-to-string (car values)) |
| 3715 | (eval-expression-print-format (car values)))))) | ||
| 3716 | 3716 | ||
| 3717 | (defun edebug-eval-last-sexp () | 3717 | (defun edebug-eval-last-sexp () |
| 3718 | "Evaluate sexp before point in the outside environment; value in minibuffer." | 3718 | "Evaluate sexp before point in the outside environment; value in minibuffer." |
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index fcc6517b747..1f53d9e630f 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el | |||
| @@ -239,6 +239,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map.") | |||
| 239 | (set-keymap-parent emacs-lisp-mode-map lisp-mode-shared-map) | 239 | (set-keymap-parent emacs-lisp-mode-map lisp-mode-shared-map) |
| 240 | (define-key emacs-lisp-mode-map "\e\t" 'lisp-complete-symbol) | 240 | (define-key emacs-lisp-mode-map "\e\t" 'lisp-complete-symbol) |
| 241 | (define-key emacs-lisp-mode-map "\e\C-x" 'eval-defun) | 241 | (define-key emacs-lisp-mode-map "\e\C-x" 'eval-defun) |
| 242 | (define-key emacs-lisp-mode-map "\e\C-q" 'indent-pp-sexp) | ||
| 242 | (define-key emacs-lisp-mode-map [menu-bar] (make-sparse-keymap)) | 243 | (define-key emacs-lisp-mode-map [menu-bar] (make-sparse-keymap)) |
| 243 | (define-key emacs-lisp-mode-map [menu-bar emacs-lisp] | 244 | (define-key emacs-lisp-mode-map [menu-bar emacs-lisp] |
| 244 | (cons "Emacs-Lisp" map)) | 245 | (cons "Emacs-Lisp" map)) |
| @@ -377,6 +378,7 @@ if that value is non-nil." | |||
| 377 | (let ((map (make-sparse-keymap))) | 378 | (let ((map (make-sparse-keymap))) |
| 378 | (set-keymap-parent map lisp-mode-shared-map) | 379 | (set-keymap-parent map lisp-mode-shared-map) |
| 379 | (define-key map "\e\C-x" 'eval-defun) | 380 | (define-key map "\e\C-x" 'eval-defun) |
| 381 | (define-key map "\e\C-q" 'indent-pp-sexp) | ||
| 380 | (define-key map "\e\t" 'lisp-complete-symbol) | 382 | (define-key map "\e\t" 'lisp-complete-symbol) |
| 381 | (define-key map "\n" 'eval-print-last-sexp) | 383 | (define-key map "\n" 'eval-print-last-sexp) |
| 382 | map) | 384 | map) |
| @@ -532,13 +534,13 @@ With argument, print output into current buffer." | |||
| 532 | (prin1-to-string value))) | 534 | (prin1-to-string value))) |
| 533 | (print-length eval-expression-print-length) | 535 | (print-length eval-expression-print-length) |
| 534 | (print-level eval-expression-print-level) | 536 | (print-level eval-expression-print-level) |
| 535 | (char-string (prin1-char value)) | ||
| 536 | (beg (point)) | 537 | (beg (point)) |
| 537 | end) | 538 | end) |
| 538 | (prog1 | 539 | (prog1 |
| 539 | (prin1 value) | 540 | (prin1 value) |
| 540 | (if (and (eq standard-output t) char-string) | 541 | (if (eq standard-output t) |
| 541 | (princ (concat " = " char-string))) | 542 | (let ((str (eval-expression-print-format value))) |
| 543 | (if str (princ str)))) | ||
| 542 | (setq end (point)) | 544 | (setq end (point)) |
| 543 | (when (and (bufferp standard-output) | 545 | (when (and (bufferp standard-output) |
| 544 | (or (not (null print-length)) | 546 | (or (not (null print-length)) |
| @@ -1092,6 +1094,19 @@ ENDPOS is encountered." | |||
| 1092 | (indent-sexp endmark) | 1094 | (indent-sexp endmark) |
| 1093 | (set-marker endmark nil)))) | 1095 | (set-marker endmark nil)))) |
| 1094 | 1096 | ||
| 1097 | (defun indent-pp-sexp (&optional arg) | ||
| 1098 | "Indent each line of the list or, with prefix ARG, pretty-printify the list." | ||
| 1099 | (interactive "P") | ||
| 1100 | (if arg | ||
| 1101 | (save-excursion | ||
| 1102 | (save-restriction | ||
| 1103 | (narrow-to-region (point) (progn (forward-sexp 1) (point))) | ||
| 1104 | (pp-buffer) | ||
| 1105 | (goto-char (point-max)) | ||
| 1106 | (if (eq (char-before) ?\n) | ||
| 1107 | (delete-char -1))))) | ||
| 1108 | (indent-sexp)) | ||
| 1109 | |||
| 1095 | ;;;; Lisp paragraph filling commands. | 1110 | ;;;; Lisp paragraph filling commands. |
| 1096 | 1111 | ||
| 1097 | (defcustom emacs-lisp-docstring-fill-column 65 | 1112 | (defcustom emacs-lisp-docstring-fill-column 65 |
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 53b9e7507ef..25fde86cd96 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el | |||
| @@ -337,7 +337,15 @@ Optional ARG is ignored." | |||
| 337 | (re-search-backward "^\n" (- (point) 1) t) | 337 | (re-search-backward "^\n" (- (point) 1) t) |
| 338 | (narrow-to-region beg end)))) | 338 | (narrow-to-region beg end)))) |
| 339 | 339 | ||
| 340 | (defun insert-pair (arg &optional open close) | 340 | (defvar insert-pair-alist |
| 341 | '((?\( ?\)) (?\[ ?\]) (?\{ ?\}) (?\< ?\>) (?\" ?\") (?\' ?\') (?\` ?\')) | ||
| 342 | "Alist of paired characters inserted by `insert-pair'. | ||
| 343 | Each element looks like (OPEN-CHAR CLOSE-CHAR) or (COMMAND-CHAR | ||
| 344 | OPEN-CHAR CLOSE-CHAR). The characters OPEN-CHAR and CLOSE-CHAR | ||
| 345 | of the pair whose key is equal to the last input character with | ||
| 346 | or without modifiers, are inserted by `insert-pair'.") | ||
| 347 | |||
| 348 | (defun insert-pair (&optional arg open close) | ||
| 341 | "Enclose following ARG sexps in a pair of OPEN and CLOSE characters. | 349 | "Enclose following ARG sexps in a pair of OPEN and CLOSE characters. |
| 342 | Leave point after the first character. | 350 | Leave point after the first character. |
| 343 | A negative ARG encloses the preceding ARG sexps instead. | 351 | A negative ARG encloses the preceding ARG sexps instead. |
| @@ -345,32 +353,47 @@ No argument is equivalent to zero: just insert characters | |||
| 345 | and leave point between. | 353 | and leave point between. |
| 346 | If `parens-require-spaces' is non-nil, this command also inserts a space | 354 | If `parens-require-spaces' is non-nil, this command also inserts a space |
| 347 | before and after, depending on the surrounding characters. | 355 | before and after, depending on the surrounding characters. |
| 348 | If region is active, insert enclosing characters at region boundaries." | 356 | If region is active, insert enclosing characters at region boundaries. |
| 357 | |||
| 358 | If arguments OPEN and CLOSE are nil, the character pair is found | ||
| 359 | from the variable `insert-pair-alist' according to the last input | ||
| 360 | character with or without modifiers. If no character pair is | ||
| 361 | found in the variable `insert-pair-alist', then the last input | ||
| 362 | character is inserted ARG times." | ||
| 349 | (interactive "P") | 363 | (interactive "P") |
| 350 | (if arg (setq arg (prefix-numeric-value arg)) | 364 | (if (not (and open close)) |
| 351 | (setq arg 0)) | 365 | (let ((pair (or (assq last-command-char insert-pair-alist) |
| 352 | (or open (setq open ?\()) | 366 | (assq (event-basic-type last-command-event) |
| 353 | (or close (setq close ?\))) | 367 | insert-pair-alist)))) |
| 354 | (if (and transient-mark-mode mark-active) | 368 | (if pair |
| 355 | (progn | 369 | (if (nth 2 pair) |
| 356 | (save-excursion (goto-char (region-end)) (insert close)) | 370 | (setq open (nth 1 pair) close (nth 2 pair)) |
| 357 | (save-excursion (goto-char (region-beginning)) (insert open))) | 371 | (setq open (nth 0 pair) close (nth 1 pair)))))) |
| 358 | (cond ((> arg 0) (skip-chars-forward " \t")) | 372 | (if (and open close) |
| 359 | ((< arg 0) (forward-sexp arg) (setq arg (- arg)))) | 373 | (if (and transient-mark-mode mark-active) |
| 360 | (and parens-require-spaces | 374 | (progn |
| 361 | (not (bobp)) | 375 | (save-excursion (goto-char (region-end)) (insert close)) |
| 362 | (memq (char-syntax (preceding-char)) (list ?w ?_ (char-syntax close))) | 376 | (save-excursion (goto-char (region-beginning)) (insert open))) |
| 363 | (insert " ")) | 377 | (if arg (setq arg (prefix-numeric-value arg)) |
| 364 | (insert open) | 378 | (setq arg 0)) |
| 365 | (save-excursion | 379 | (cond ((> arg 0) (skip-chars-forward " \t")) |
| 366 | (or (eq arg 0) (forward-sexp arg)) | 380 | ((< arg 0) (forward-sexp arg) (setq arg (- arg)))) |
| 367 | (insert close) | 381 | (and parens-require-spaces |
| 368 | (and parens-require-spaces | 382 | (not (bobp)) |
| 369 | (not (eobp)) | 383 | (memq (char-syntax (preceding-char)) (list ?w ?_ (char-syntax close))) |
| 370 | (memq (char-syntax (following-char)) (list ?w ?_ (char-syntax open))) | 384 | (insert " ")) |
| 371 | (insert " "))))) | 385 | (insert open) |
| 372 | 386 | (save-excursion | |
| 373 | (defun insert-parentheses (arg) | 387 | (or (eq arg 0) (forward-sexp arg)) |
| 388 | (insert close) | ||
| 389 | (and parens-require-spaces | ||
| 390 | (not (eobp)) | ||
| 391 | (memq (char-syntax (following-char)) (list ?w ?_ (char-syntax open))) | ||
| 392 | (insert " ")))) | ||
| 393 | (insert-char (event-basic-type last-command-event) | ||
| 394 | (prefix-numeric-value arg)))) | ||
| 395 | |||
| 396 | (defun insert-parentheses (&optional arg) | ||
| 374 | "Enclose following ARG sexps in parentheses. Leave point after open-paren. | 397 | "Enclose following ARG sexps in parentheses. Leave point after open-paren. |
| 375 | A negative ARG encloses the preceding ARG sexps instead. | 398 | A negative ARG encloses the preceding ARG sexps instead. |
| 376 | No argument is equivalent to zero: just insert `()' and leave point between. | 399 | No argument is equivalent to zero: just insert `()' and leave point between. |
| @@ -380,6 +403,24 @@ If region is active, insert enclosing characters at region boundaries." | |||
| 380 | (interactive "P") | 403 | (interactive "P") |
| 381 | (insert-pair arg ?\( ?\))) | 404 | (insert-pair arg ?\( ?\))) |
| 382 | 405 | ||
| 406 | (defun delete-pair () | ||
| 407 | "Delete a pair of characters enclosing the sexp that follows point." | ||
| 408 | (interactive) | ||
| 409 | (save-excursion (forward-sexp 1) (delete-char -1)) | ||
| 410 | (delete-char 1)) | ||
| 411 | |||
| 412 | (defun raise-sexp (&optional arg) | ||
| 413 | "Raise ARG sexps higher up the tree." | ||
| 414 | (interactive "p") | ||
| 415 | (let ((s (if (and transient-mark-mode mark-active) | ||
| 416 | (buffer-substring (region-beginning) (region-end)) | ||
| 417 | (buffer-substring | ||
| 418 | (point) | ||
| 419 | (save-excursion (forward-sexp arg) (point)))))) | ||
| 420 | (backward-up-list 1) | ||
| 421 | (delete-region (point) (save-excursion (forward-sexp 1) (point))) | ||
| 422 | (save-excursion (insert s)))) | ||
| 423 | |||
| 383 | (defun move-past-close-and-reindent () | 424 | (defun move-past-close-and-reindent () |
| 384 | "Move past next `)', delete indentation before it, then indent after it." | 425 | "Move past next `)', delete indentation before it, then indent after it." |
| 385 | (interactive) | 426 | (interactive) |
diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index c93868859f0..61d31921e57 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el | |||
| @@ -50,34 +50,40 @@ to make output that `read' can handle, whenever this is possible." | |||
| 50 | (let ((print-escape-newlines pp-escape-newlines) | 50 | (let ((print-escape-newlines pp-escape-newlines) |
| 51 | (print-quoted t)) | 51 | (print-quoted t)) |
| 52 | (prin1 object (current-buffer))) | 52 | (prin1 object (current-buffer))) |
| 53 | (goto-char (point-min)) | 53 | (pp-buffer) |
| 54 | (while (not (eobp)) | ||
| 55 | ;; (message "%06d" (- (point-max) (point))) | ||
| 56 | (cond | ||
| 57 | ((condition-case err-var | ||
| 58 | (prog1 t (down-list 1)) | ||
| 59 | (error nil)) | ||
| 60 | (save-excursion | ||
| 61 | (backward-char 1) | ||
| 62 | (skip-chars-backward "'`#^") | ||
| 63 | (when (and (not (bobp)) (= ?\ (char-before))) | ||
| 64 | (delete-char -1) | ||
| 65 | (insert "\n")))) | ||
| 66 | ((condition-case err-var | ||
| 67 | (prog1 t (up-list 1)) | ||
| 68 | (error nil)) | ||
| 69 | (while (looking-at "\\s)") | ||
| 70 | (forward-char 1)) | ||
| 71 | (delete-region | ||
| 72 | (point) | ||
| 73 | (progn (skip-chars-forward " \t") (point))) | ||
| 74 | (insert ?\n)) | ||
| 75 | (t (goto-char (point-max))))) | ||
| 76 | (goto-char (point-min)) | ||
| 77 | (indent-sexp) | ||
| 78 | (buffer-string)) | 54 | (buffer-string)) |
| 79 | (kill-buffer (current-buffer))))) | 55 | (kill-buffer (current-buffer))))) |
| 80 | 56 | ||
| 57 | (defun pp-buffer () | ||
| 58 | "Prettify the current buffer with printed representation of a Lisp object." | ||
| 59 | (goto-char (point-min)) | ||
| 60 | (while (not (eobp)) | ||
| 61 | ;; (message "%06d" (- (point-max) (point))) | ||
| 62 | (cond | ||
| 63 | ((condition-case err-var | ||
| 64 | (prog1 t (down-list 1)) | ||
| 65 | (error nil)) | ||
| 66 | (save-excursion | ||
| 67 | (backward-char 1) | ||
| 68 | (skip-chars-backward "'`#^") | ||
| 69 | (when (and (not (bobp)) (memq (char-before) '(?\ ?\t ?\n))) | ||
| 70 | (delete-region | ||
| 71 | (point) | ||
| 72 | (progn (skip-chars-backward " \t\n") (point))) | ||
| 73 | (insert "\n")))) | ||
| 74 | ((condition-case err-var | ||
| 75 | (prog1 t (up-list 1)) | ||
| 76 | (error nil)) | ||
| 77 | (while (looking-at "\\s)") | ||
| 78 | (forward-char 1)) | ||
| 79 | (delete-region | ||
| 80 | (point) | ||
| 81 | (progn (skip-chars-forward " \t\n") (point))) | ||
| 82 | (insert ?\n)) | ||
| 83 | (t (goto-char (point-max))))) | ||
| 84 | (goto-char (point-min)) | ||
| 85 | (indent-sexp)) | ||
| 86 | |||
| 81 | ;;;###autoload | 87 | ;;;###autoload |
| 82 | (defun pp (object &optional stream) | 88 | (defun pp (object &optional stream) |
| 83 | "Output the pretty-printed representation of OBJECT, any Lisp object. | 89 | "Output the pretty-printed representation of OBJECT, any Lisp object. |
diff --git a/lisp/files.el b/lisp/files.el index 06792a0d04e..27e0ded28e2 100644 --- a/lisp/files.el +++ b/lisp/files.el | |||
| @@ -1365,33 +1365,35 @@ that are visiting the various files." | |||
| 1365 | (kill-local-variable 'buffer-file-coding-system) | 1365 | (kill-local-variable 'buffer-file-coding-system) |
| 1366 | (kill-local-variable 'cursor-type) | 1366 | (kill-local-variable 'cursor-type) |
| 1367 | (let ((inhibit-read-only t)) | 1367 | (let ((inhibit-read-only t)) |
| 1368 | (erase-buffer) | 1368 | (erase-buffer)) |
| 1369 | (and (default-value 'enable-multibyte-characters) | 1369 | (and (default-value 'enable-multibyte-characters) |
| 1370 | (not rawfile) | 1370 | (not rawfile) |
| 1371 | (set-buffer-multibyte t)) | 1371 | (set-buffer-multibyte t)) |
| 1372 | (if rawfile | 1372 | (if rawfile |
| 1373 | (condition-case () | ||
| 1374 | (insert-file-contents-literally filename t) | ||
| 1375 | (file-error | ||
| 1376 | (when (and (file-exists-p filename) | ||
| 1377 | (not (file-readable-p filename))) | ||
| 1378 | (kill-buffer buf) | ||
| 1379 | (signal 'file-error (list "File is not readable" | ||
| 1380 | filename))) | ||
| 1381 | ;; Unconditionally set error | ||
| 1382 | (setq error t))) | ||
| 1383 | (condition-case () | 1373 | (condition-case () |
| 1384 | (insert-file-contents filename t) | 1374 | (let ((inhibit-read-only t)) |
| 1375 | (insert-file-contents-literally filename t)) | ||
| 1385 | (file-error | 1376 | (file-error |
| 1386 | (when (and (file-exists-p filename) | 1377 | (when (and (file-exists-p filename) |
| 1387 | (not (file-readable-p filename))) | 1378 | (not (file-readable-p filename))) |
| 1388 | (kill-buffer buf) | 1379 | (kill-buffer buf) |
| 1389 | (signal 'file-error (list "File is not readable" | 1380 | (signal 'file-error (list "File is not readable" |
| 1390 | filename))) | 1381 | filename))) |
| 1391 | ;; Run find-file-not-found-hooks until one returns non-nil. | 1382 | ;; Unconditionally set error |
| 1392 | (or (run-hook-with-args-until-success 'find-file-not-found-functions) | 1383 | (setq error t))) |
| 1393 | ;; If they fail too, set error. | 1384 | (condition-case () |
| 1394 | (setq error t)))))) | 1385 | (let ((inhibit-read-only t)) |
| 1386 | (insert-file-contents filename t)) | ||
| 1387 | (file-error | ||
| 1388 | (when (and (file-exists-p filename) | ||
| 1389 | (not (file-readable-p filename))) | ||
| 1390 | (kill-buffer buf) | ||
| 1391 | (signal 'file-error (list "File is not readable" | ||
| 1392 | filename))) | ||
| 1393 | ;; Run find-file-not-found-hooks until one returns non-nil. | ||
| 1394 | (or (run-hook-with-args-until-success 'find-file-not-found-functions) | ||
| 1395 | ;; If they fail too, set error. | ||
| 1396 | (setq error t))))) | ||
| 1395 | ;; Record the file's truename, and maybe use that as visited name. | 1397 | ;; Record the file's truename, and maybe use that as visited name. |
| 1396 | (if (equal filename buffer-file-name) | 1398 | (if (equal filename buffer-file-name) |
| 1397 | (setq buffer-file-truename truename) | 1399 | (setq buffer-file-truename truename) |
| @@ -4481,7 +4483,7 @@ With prefix arg, silently save all file-visiting buffers, then kill." | |||
| 4481 | ;; Get a list of the indices of the args which are file names. | 4483 | ;; Get a list of the indices of the args which are file names. |
| 4482 | (file-arg-indices | 4484 | (file-arg-indices |
| 4483 | (cdr (or (assq operation | 4485 | (cdr (or (assq operation |
| 4484 | ;; The first five are special because they | 4486 | ;; The first six are special because they |
| 4485 | ;; return a file name. We want to include the /: | 4487 | ;; return a file name. We want to include the /: |
| 4486 | ;; in the return value. | 4488 | ;; in the return value. |
| 4487 | ;; So just avoid stripping it in the first place. | 4489 | ;; So just avoid stripping it in the first place. |
| @@ -4490,13 +4492,21 @@ With prefix arg, silently save all file-visiting buffers, then kill." | |||
| 4490 | (file-name-as-directory . nil) | 4492 | (file-name-as-directory . nil) |
| 4491 | (directory-file-name . nil) | 4493 | (directory-file-name . nil) |
| 4492 | (file-name-sans-versions . nil) | 4494 | (file-name-sans-versions . nil) |
| 4495 | (find-backup-file-name . nil) | ||
| 4493 | ;; `identity' means just return the first arg | 4496 | ;; `identity' means just return the first arg |
| 4494 | ;; not stripped of its quoting. | 4497 | ;; not stripped of its quoting. |
| 4495 | (substitute-in-file-name identity) | 4498 | (substitute-in-file-name identity) |
| 4499 | ;; `add' means add "/:" to the result. | ||
| 4500 | (file-truename add 0) | ||
| 4501 | ;; `quote' means add "/:" to buffer-file-name. | ||
| 4502 | (insert-file-contents quote 0) | ||
| 4503 | ;; `unquote-then-quote' means set buffer-file-name | ||
| 4504 | ;; temporarily to unquoted filename. | ||
| 4505 | (verify-visited-file-modtime unquote-then-quote) | ||
| 4506 | ;; List the arguments which are filenames. | ||
| 4496 | (file-name-completion 1) | 4507 | (file-name-completion 1) |
| 4497 | (file-name-all-completions 1) | 4508 | (file-name-all-completions 1) |
| 4498 | ;; t means add "/:" to the result. | 4509 | (write-region 2 5) |
| 4499 | (file-truename t 0) | ||
| 4500 | (rename-file 0 1) | 4510 | (rename-file 0 1) |
| 4501 | (copy-file 0 1) | 4511 | (copy-file 0 1) |
| 4502 | (make-symbolic-link 0 1) | 4512 | (make-symbolic-link 0 1) |
| @@ -4522,8 +4532,17 @@ With prefix arg, silently save all file-visiting buffers, then kill." | |||
| 4522 | (setq file-arg-indices (cdr file-arg-indices)))) | 4532 | (setq file-arg-indices (cdr file-arg-indices)))) |
| 4523 | (cond ((eq method 'identity) | 4533 | (cond ((eq method 'identity) |
| 4524 | (car arguments)) | 4534 | (car arguments)) |
| 4525 | (method | 4535 | ((eq method 'add) |
| 4526 | (concat "/:" (apply operation arguments))) | 4536 | (concat "/:" (apply operation arguments))) |
| 4537 | ((eq method 'quote) | ||
| 4538 | (prog1 (apply operation arguments) | ||
| 4539 | (setq buffer-file-name (concat "/:" buffer-file-name)))) | ||
| 4540 | ((eq method 'unquote-then-quote) | ||
| 4541 | (let (res) | ||
| 4542 | (setq buffer-file-name (substring buffer-file-name 2)) | ||
| 4543 | (setq res (apply operation arguments)) | ||
| 4544 | (setq buffer-file-name (concat "/:" buffer-file-name)) | ||
| 4545 | res)) | ||
| 4527 | (t | 4546 | (t |
| 4528 | (apply operation arguments))))) | 4547 | (apply operation arguments))))) |
| 4529 | 4548 | ||
diff --git a/lisp/gnus/starttls.el b/lisp/gnus/starttls.el index 0fd14cead55..c172e88c515 100644 --- a/lisp/gnus/starttls.el +++ b/lisp/gnus/starttls.el | |||
| @@ -1,10 +1,11 @@ | |||
| 1 | ;;; starttls.el --- STARTTLS functions | 1 | ;;; starttls.el --- STARTTLS functions |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1999, 2000, 2003, 2004 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Daiki Ueno <ueno@unixuser.org> | 5 | ;; Author: Daiki Ueno <ueno@unixuser.org> |
| 6 | ;; Author: Simon Josefsson <simon@josefsson.org> | ||
| 6 | ;; Created: 1999/11/20 | 7 | ;; Created: 1999/11/20 |
| 7 | ;; Keywords: TLS, SSL, OpenSSL, mail, news | 8 | ;; Keywords: TLS, SSL, OpenSSL, GNUTLS, mail, news |
| 8 | 9 | ||
| 9 | ;; This file is part of GNU Emacs. | 10 | ;; This file is part of GNU Emacs. |
| 10 | 11 | ||
| @@ -30,6 +31,90 @@ | |||
| 30 | ;; [RFC 2595] "Using TLS with IMAP, POP3 and ACAP" | 31 | ;; [RFC 2595] "Using TLS with IMAP, POP3 and ACAP" |
| 31 | ;; by Chris Newman <chris.newman@innosoft.com> (1999/06) | 32 | ;; by Chris Newman <chris.newman@innosoft.com> (1999/06) |
| 32 | 33 | ||
| 34 | ;; This file now contain a combination of the two previous | ||
| 35 | ;; implementations both called "starttls.el". The first one is Daiki | ||
| 36 | ;; Ueno's starttls.el which uses his own "starttls" command line tool, | ||
| 37 | ;; and the second one is Simon Josefsson's starttls.el which uses | ||
| 38 | ;; "gnutls-cli" from GNUTLS. | ||
| 39 | ;; | ||
| 40 | ;; If "starttls" is available, it is prefered by the code over | ||
| 41 | ;; "gnutls-cli", for backwards compatibility. Use | ||
| 42 | ;; `starttls-use-gnutls' to toggle between implementations if you have | ||
| 43 | ;; both tools installed. It is recommended to use GNUTLS, though, as | ||
| 44 | ;; it performs more verification of the certificates. | ||
| 45 | |||
| 46 | ;; The GNUTLS support require GNUTLS 0.9.90 (released 2003-10-08) or | ||
| 47 | ;; later, from <http://www.gnu.org/software/gnutls/>, or "starttls" | ||
| 48 | ;; from <ftp://ftp.opaopa.org/pub/elisp/>. | ||
| 49 | |||
| 50 | ;; Usage is similar to `open-network-stream'. For example: | ||
| 51 | ;; | ||
| 52 | ;; (when (setq tmp (starttls-open-stream | ||
| 53 | ;; "test" (current-buffer) "yxa.extundo.com" 25)) | ||
| 54 | ;; (accept-process-output tmp 15) | ||
| 55 | ;; (process-send-string tmp "STARTTLS\n") | ||
| 56 | ;; (accept-process-output tmp 15) | ||
| 57 | ;; (message "STARTTLS output:\n%s" (starttls-negotiate tmp)) | ||
| 58 | ;; (process-send-string tmp "EHLO foo\n")) | ||
| 59 | |||
| 60 | ;; An example run yield the following output: | ||
| 61 | ;; | ||
| 62 | ;; 220 yxa.extundo.com ESMTP Sendmail 8.12.11/8.12.11/Debian-3; Wed, 26 May 2004 19:12:29 +0200; (No UCE/UBE) logging access from: c494102a.s-bi.bostream.se(OK)-c494102a.s-bi.bostream.se [217.215.27.65] | ||
| 63 | ;; 220 2.0.0 Ready to start TLS | ||
| 64 | ;; 250-yxa.extundo.com Hello c494102a.s-bi.bostream.se [217.215.27.65], pleased to meet you | ||
| 65 | ;; 250-ENHANCEDSTATUSCODES | ||
| 66 | ;; 250-PIPELINING | ||
| 67 | ;; 250-EXPN | ||
| 68 | ;; 250-VERB | ||
| 69 | ;; 250-8BITMIME | ||
| 70 | ;; 250-SIZE | ||
| 71 | ;; 250-DSN | ||
| 72 | ;; 250-ETRN | ||
| 73 | ;; 250-AUTH DIGEST-MD5 CRAM-MD5 PLAIN LOGIN | ||
| 74 | ;; 250-DELIVERBY | ||
| 75 | ;; 250 HELP | ||
| 76 | ;; nil | ||
| 77 | ;; | ||
| 78 | ;; With the message buffer containing: | ||
| 79 | ;; | ||
| 80 | ;; STARTTLS output: | ||
| 81 | ;; *** Starting TLS handshake | ||
| 82 | ;; - Server's trusted authorities: | ||
| 83 | ;; [0]: C=SE,ST=Stockholm,L=Stockholm,O=YXA,OU=CA,CN=yxa.extundo.com,EMAIL=staff@yxa.extundo.com | ||
| 84 | ;; - Certificate type: X.509 | ||
| 85 | ;; - Got a certificate list of 2 certificates. | ||
| 86 | ;; | ||
| 87 | ;; - Certificate[0] info: | ||
| 88 | ;; # The hostname in the certificate matches 'yxa.extundo.com'. | ||
| 89 | ;; # valid since: Wed May 26 12:16:00 CEST 2004 | ||
| 90 | ;; # expires at: Wed Jul 26 12:16:00 CEST 2023 | ||
| 91 | ;; # serial number: 04 | ||
| 92 | ;; # fingerprint: 7c 04 4b c1 fa 26 9b 5d 90 22 52 3c 65 3d 85 3a | ||
| 93 | ;; # version: #1 | ||
| 94 | ;; # public key algorithm: RSA | ||
| 95 | ;; # Modulus: 1024 bits | ||
| 96 | ;; # Subject's DN: C=SE,ST=Stockholm,L=Stockholm,O=YXA,OU=Mail server,CN=yxa.extundo.com,EMAIL=staff@yxa.extundo.com | ||
| 97 | ;; # Issuer's DN: C=SE,ST=Stockholm,L=Stockholm,O=YXA,OU=CA,CN=yxa.extundo.com,EMAIL=staff@yxa.extundo.com | ||
| 98 | ;; | ||
| 99 | ;; - Certificate[1] info: | ||
| 100 | ;; # valid since: Sun May 23 11:35:00 CEST 2004 | ||
| 101 | ;; # expires at: Sun Jul 23 11:35:00 CEST 2023 | ||
| 102 | ;; # serial number: 00 | ||
| 103 | ;; # fingerprint: fc 76 d8 63 1a c9 0b 3b fa 40 fe ed 47 7a 58 ae | ||
| 104 | ;; # version: #3 | ||
| 105 | ;; # public key algorithm: RSA | ||
| 106 | ;; # Modulus: 1024 bits | ||
| 107 | ;; # Subject's DN: C=SE,ST=Stockholm,L=Stockholm,O=YXA,OU=CA,CN=yxa.extundo.com,EMAIL=staff@yxa.extundo.com | ||
| 108 | ;; # Issuer's DN: C=SE,ST=Stockholm,L=Stockholm,O=YXA,OU=CA,CN=yxa.extundo.com,EMAIL=staff@yxa.extundo.com | ||
| 109 | ;; | ||
| 110 | ;; - Peer's certificate issuer is unknown | ||
| 111 | ;; - Peer's certificate is NOT trusted | ||
| 112 | ;; - Version: TLS 1.0 | ||
| 113 | ;; - Key Exchange: RSA | ||
| 114 | ;; - Cipher: ARCFOUR 128 | ||
| 115 | ;; - MAC: SHA | ||
| 116 | ;; - Compression: NULL | ||
| 117 | |||
| 33 | ;;; Code: | 118 | ;;; Code: |
| 34 | 119 | ||
| 35 | (defgroup starttls nil | 120 | (defgroup starttls nil |
| @@ -37,18 +122,141 @@ | |||
| 37 | :version "21.1" | 122 | :version "21.1" |
| 38 | :group 'mail) | 123 | :group 'mail) |
| 39 | 124 | ||
| 125 | (defcustom starttls-gnutls-program "gnutls-cli" | ||
| 126 | "Name of GNUTLS command line tool. | ||
| 127 | This program is used when GNUTLS is used, i.e. when | ||
| 128 | `starttls-use-gnutls' is non-nil." | ||
| 129 | :type 'string | ||
| 130 | :group 'starttls) | ||
| 131 | |||
| 40 | (defcustom starttls-program "starttls" | 132 | (defcustom starttls-program "starttls" |
| 41 | "The program to run in a subprocess to open an TLSv1 connection." | 133 | "The program to run in a subprocess to open an TLSv1 connection. |
| 134 | This program is used when the `starttls' command is used, | ||
| 135 | i.e. when `starttls-use-gnutls' is nil." | ||
| 42 | :type 'string | 136 | :type 'string |
| 43 | :group 'starttls) | 137 | :group 'starttls) |
| 44 | 138 | ||
| 139 | (defcustom starttls-use-gnutls (not (executable-find starttls-program)) | ||
| 140 | "*Whether to use GNUTLS instead of the `starttls' command." | ||
| 141 | :type 'boolean | ||
| 142 | :group 'starttls) | ||
| 143 | |||
| 45 | (defcustom starttls-extra-args nil | 144 | (defcustom starttls-extra-args nil |
| 46 | "Extra arguments to `starttls-program'." | 145 | "Extra arguments to `starttls-program'. |
| 146 | This program is used when the `starttls' command is used, | ||
| 147 | i.e. when `starttls-use-gnutls' is nil." | ||
| 47 | :type '(repeat string) | 148 | :type '(repeat string) |
| 48 | :group 'starttls) | 149 | :group 'starttls) |
| 49 | 150 | ||
| 151 | (defcustom starttls-extra-arguments nil | ||
| 152 | "Extra arguments to `starttls-program'. | ||
| 153 | This program is used when GNUTLS is used, i.e. when | ||
| 154 | `starttls-use-gnutls' is non-nil. | ||
| 155 | |||
| 156 | For example, non-TLS compliant servers may require | ||
| 157 | '(\"--protocols\" \"ssl3\"). Invoke \"gnutls-cli --help\" to | ||
| 158 | find out which parameters are available." | ||
| 159 | :type '(repeat string) | ||
| 160 | :group 'starttls) | ||
| 161 | |||
| 162 | (defcustom starttls-process-connection-type nil | ||
| 163 | "*Value for `process-connection-type' to use when starting STARTTLS process." | ||
| 164 | :type 'boolean | ||
| 165 | :group 'starttls) | ||
| 166 | |||
| 167 | (defcustom starttls-connect "- Simple Client Mode:\n\n" | ||
| 168 | "*Regular expression indicating successful connection. | ||
| 169 | The default is what GNUTLS's \"gnutls-cli\" outputs." | ||
| 170 | ;; GNUTLS cli.c:main() print this string when it is starting to run | ||
| 171 | ;; in the application read/write phase. If the logic, or the string | ||
| 172 | ;; itself, is modified, this must be updated. | ||
| 173 | :type 'regexp | ||
| 174 | :group 'starttls) | ||
| 175 | |||
| 176 | (defcustom starttls-failure "\\*\\*\\* Handshake has failed" | ||
| 177 | "*Regular expression indicating failed TLS handshake. | ||
| 178 | The default is what GNUTLS's \"gnutls-cli\" outputs." | ||
| 179 | ;; GNUTLS cli.c:do_handshake() print this string on failure. If the | ||
| 180 | ;; logic, or the string itself, is modified, this must be updated. | ||
| 181 | :type 'regexp | ||
| 182 | :group 'starttls) | ||
| 183 | |||
| 184 | (defcustom starttls-success "- Compression: " | ||
| 185 | "*Regular expression indicating completed TLS handshakes. | ||
| 186 | The default is what GNUTLS's \"gnutls-cli\" outputs." | ||
| 187 | ;; GNUTLS cli.c:do_handshake() calls, on success, | ||
| 188 | ;; common.c:print_info(), that unconditionally print this string | ||
| 189 | ;; last. If that logic, or the string itself, is modified, this | ||
| 190 | ;; must be updated. | ||
| 191 | :type 'regexp | ||
| 192 | :group 'starttls) | ||
| 193 | |||
| 194 | (defun starttls-negotiate-gnutls (process) | ||
| 195 | "Negotiate TLS on process opened by `open-starttls-stream'. | ||
| 196 | This should typically only be done once. It typically return a | ||
| 197 | multi-line informational message with information about the | ||
| 198 | handshake, or NIL on failure." | ||
| 199 | (let (buffer info old-max done-ok done-bad) | ||
| 200 | (if (null (setq buffer (process-buffer process))) | ||
| 201 | ;; XXX How to remove/extract the TLS negotiation junk? | ||
| 202 | (signal-process (process-id process) 'SIGALRM) | ||
| 203 | (with-current-buffer buffer | ||
| 204 | (save-excursion | ||
| 205 | (setq old-max (goto-char (point-max))) | ||
| 206 | (signal-process (process-id process) 'SIGALRM) | ||
| 207 | (while (and (processp process) | ||
| 208 | (eq (process-status process) 'run) | ||
| 209 | (save-excursion | ||
| 210 | (goto-char old-max) | ||
| 211 | (not (or (setq done-ok (re-search-forward | ||
| 212 | starttls-success nil t)) | ||
| 213 | (setq done-bad (re-search-forward | ||
| 214 | starttls-failure nil t)))))) | ||
| 215 | (accept-process-output process 1 100) | ||
| 216 | (sit-for 0.1)) | ||
| 217 | (setq info (buffer-substring-no-properties old-max (point-max))) | ||
| 218 | (delete-region old-max (point-max)) | ||
| 219 | (if (or (and done-ok (not done-bad)) | ||
| 220 | ;; Prevent mitm that fake success msg after failure msg. | ||
| 221 | (and done-ok done-bad (< done-ok done-bad))) | ||
| 222 | info | ||
| 223 | (message "STARTTLS negotiation failed: %s" info) | ||
| 224 | nil)))))) | ||
| 225 | |||
| 50 | (defun starttls-negotiate (process) | 226 | (defun starttls-negotiate (process) |
| 51 | (signal-process (process-id process) 'SIGALRM)) | 227 | (if starttls-use-gnutls |
| 228 | (starttls-negotiate-gnutls process) | ||
| 229 | (signal-process (process-id process) 'SIGALRM))) | ||
| 230 | |||
| 231 | (defun starttls-open-stream-gnutls (name buffer host service) | ||
| 232 | (message "Opening STARTTLS connection to `%s'..." host) | ||
| 233 | (let* (done | ||
| 234 | (old-max (with-current-buffer buffer (point-max))) | ||
| 235 | (process-connection-type starttls-process-connection-type) | ||
| 236 | (process (apply #'start-process name buffer | ||
| 237 | starttls-gnutls-program "-s" host | ||
| 238 | "-p" (if (integerp service) | ||
| 239 | (int-to-string service) | ||
| 240 | service) | ||
| 241 | starttls-extra-arguments))) | ||
| 242 | (process-kill-without-query process) | ||
| 243 | (while (and (processp process) | ||
| 244 | (eq (process-status process) 'run) | ||
| 245 | (save-excursion | ||
| 246 | (set-buffer buffer) | ||
| 247 | (goto-char old-max) | ||
| 248 | (not (setq done (re-search-forward | ||
| 249 | starttls-connect nil t))))) | ||
| 250 | (accept-process-output process 0 100) | ||
| 251 | (sit-for 0.1)) | ||
| 252 | (if done | ||
| 253 | (with-current-buffer buffer | ||
| 254 | (delete-region old-max done)) | ||
| 255 | (delete-process process) | ||
| 256 | (setq process nil)) | ||
| 257 | (message "Opening STARTTLS connection to `%s'...%s" | ||
| 258 | host (if done "done" "failed")) | ||
| 259 | process)) | ||
| 52 | 260 | ||
| 53 | (defun starttls-open-stream (name buffer host service) | 261 | (defun starttls-open-stream (name buffer host service) |
| 54 | "Open a TLS connection for a service to a host. | 262 | "Open a TLS connection for a service to a host. |
| @@ -64,13 +272,15 @@ BUFFER is the buffer (or `buffer-name') to associate with the process. | |||
| 64 | Third arg is name of the host to connect to, or its IP address. | 272 | Third arg is name of the host to connect to, or its IP address. |
| 65 | Fourth arg SERVICE is name of the service desired, or an integer | 273 | Fourth arg SERVICE is name of the service desired, or an integer |
| 66 | specifying a port number to connect to." | 274 | specifying a port number to connect to." |
| 67 | (let* ((process-connection-type nil) | 275 | (if starttls-use-gnutls |
| 68 | (process (apply #'start-process | 276 | (starttls-open-stream-gnutls name buffer host service) |
| 69 | name buffer starttls-program | 277 | (let* ((process-connection-type starttls-process-connection-type) |
| 70 | host (format "%s" service) | 278 | (process (apply #'start-process |
| 71 | starttls-extra-args))) | 279 | name buffer starttls-program |
| 72 | (process-kill-without-query process) | 280 | host (format "%s" service) |
| 73 | process)) | 281 | starttls-extra-args))) |
| 282 | (process-kill-without-query process) | ||
| 283 | process))) | ||
| 74 | 284 | ||
| 75 | (provide 'starttls) | 285 | (provide 'starttls) |
| 76 | 286 | ||
diff --git a/lisp/info.el b/lisp/info.el index 84ee6ac5e79..14183383743 100644 --- a/lisp/info.el +++ b/lisp/info.el | |||
| @@ -3871,7 +3871,8 @@ BUFFER is the buffer speedbar is requesting buttons for." | |||
| 3871 | 3871 | ||
| 3872 | (defun Info-desktop-buffer-misc-data (desktop-dirname) | 3872 | (defun Info-desktop-buffer-misc-data (desktop-dirname) |
| 3873 | "Auxiliary information to be saved in desktop file." | 3873 | "Auxiliary information to be saved in desktop file." |
| 3874 | (list Info-current-file Info-current-node)) | 3874 | (if (not (member Info-current-file '("apropos" "history" "toc"))) |
| 3875 | (list Info-current-file Info-current-node))) | ||
| 3875 | 3876 | ||
| 3876 | ;;;###autoload | 3877 | ;;;###autoload |
| 3877 | (defun Info-restore-desktop-buffer (desktop-buffer-file-name | 3878 | (defun Info-restore-desktop-buffer (desktop-buffer-file-name |
| @@ -3881,6 +3882,9 @@ BUFFER is the buffer speedbar is requesting buttons for." | |||
| 3881 | (let ((first (nth 0 desktop-buffer-misc)) | 3882 | (let ((first (nth 0 desktop-buffer-misc)) |
| 3882 | (second (nth 1 desktop-buffer-misc))) | 3883 | (second (nth 1 desktop-buffer-misc))) |
| 3883 | (when (and first second) | 3884 | (when (and first second) |
| 3885 | (when desktop-buffer-name | ||
| 3886 | (set-buffer (get-buffer-create desktop-buffer-name)) | ||
| 3887 | (Info-mode)) | ||
| 3884 | (Info-find-node first second) | 3888 | (Info-find-node first second) |
| 3885 | (current-buffer)))) | 3889 | (current-buffer)))) |
| 3886 | 3890 | ||
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index 60831b259d8..84a61350145 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el | |||
| @@ -483,7 +483,14 @@ This is relative to `smtpmail-queue-dir'.") | |||
| 483 | (setq cred-key (expand-file-name cred-key))) | 483 | (setq cred-key (expand-file-name cred-key))) |
| 484 | (file-regular-p | 484 | (file-regular-p |
| 485 | (setq cred-cert (expand-file-name cred-cert)))) | 485 | (setq cred-cert (expand-file-name cred-cert)))) |
| 486 | (list "--key-file" cred-key "--cert-file" cred-cert)))) | 486 | (list "--key-file" cred-key "--cert-file" cred-cert))) |
| 487 | (starttls-extra-arguments | ||
| 488 | (when (and (stringp cred-key) (stringp cred-cert) | ||
| 489 | (file-regular-p | ||
| 490 | (setq cred-key (expand-file-name cred-key))) | ||
| 491 | (file-regular-p | ||
| 492 | (setq cred-cert (expand-file-name cred-cert)))) | ||
| 493 | (list "--x509keyfile" cred-key "--x509certfile" cred-cert)))) | ||
| 487 | (starttls-open-stream "SMTP" process-buffer host port))))) | 494 | (starttls-open-stream "SMTP" process-buffer host port))))) |
| 488 | 495 | ||
| 489 | (defun smtpmail-try-auth-methods (process supported-extensions host port) | 496 | (defun smtpmail-try-auth-methods (process supported-extensions host port) |
diff --git a/lisp/mouse.el b/lisp/mouse.el index 76098f45f1a..621b517e2fe 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el | |||
| @@ -624,6 +624,8 @@ This should be bound to a mouse drag event." | |||
| 624 | (mouse-set-region-1))) | 624 | (mouse-set-region-1))) |
| 625 | 625 | ||
| 626 | (defun mouse-set-region-1 () | 626 | (defun mouse-set-region-1 () |
| 627 | ;; Set transient-mark-mode for a little while. | ||
| 628 | (setq transient-mark-mode (or transient-mark-mode 'lambda)) | ||
| 627 | (setq mouse-last-region-beg (region-beginning)) | 629 | (setq mouse-last-region-beg (region-beginning)) |
| 628 | (setq mouse-last-region-end (region-end)) | 630 | (setq mouse-last-region-end (region-end)) |
| 629 | (setq mouse-last-region-tick (buffer-modified-tick))) | 631 | (setq mouse-last-region-tick (buffer-modified-tick))) |
diff --git a/lisp/pcvs-util.el b/lisp/pcvs-util.el index 86fafea37ea..3380077c74a 100644 --- a/lisp/pcvs-util.el +++ b/lisp/pcvs-util.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; pcvs-util.el --- utility functions for PCL-CVS -*- byte-compile-dynamic: t -*- | 1 | ;;; pcvs-util.el --- utility functions for PCL-CVS -*- byte-compile-dynamic: t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1991,92,93,94,95,96,97,98,99,2000, 2001 | 3 | ;; Copyright (C) 1991,92,93,94,95,96,97,98,99, 2000,01,04 |
| 4 | ;; Free Software Foundation, Inc. | 4 | ;; Free Software Foundation, Inc. |
| 5 | 5 | ||
| 6 | ;; Author: Stefan Monnier <monnier@cs.yale.edu> | 6 | ;; Author: Stefan Monnier <monnier@cs.yale.edu> |
| @@ -50,7 +50,6 @@ | |||
| 50 | (dolist (x xs zs) | 50 | (dolist (x xs zs) |
| 51 | (unless (member x ys) (push x zs))))) | 51 | (unless (member x ys) (push x zs))))) |
| 52 | 52 | ||
| 53 | |||
| 54 | (defun cvs-map (-cvs-map-f &rest -cvs-map-ls) | 53 | (defun cvs-map (-cvs-map-f &rest -cvs-map-ls) |
| 55 | (unless (cvs-every 'null -cvs-map-ls) | 54 | (unless (cvs-every 'null -cvs-map-ls) |
| 56 | (cons (apply -cvs-map-f (mapcar 'car -cvs-map-ls)) | 55 | (cons (apply -cvs-map-f (mapcar 'car -cvs-map-ls)) |
| @@ -77,22 +76,6 @@ the other elements. The ordering among elements is maintained." | |||
| 77 | (if (funcall p x) (push x car) (push x cdr))) | 76 | (if (funcall p x) (push x car) (push x cdr))) |
| 78 | (cons (nreverse car) (nreverse cdr)))) | 77 | (cons (nreverse car) (nreverse cdr)))) |
| 79 | 78 | ||
| 80 | ;; Copied from CL ;-( | ||
| 81 | |||
| 82 | (defun cvs-butlast (x &optional n) | ||
| 83 | "Returns a copy of LIST with the last N elements removed." | ||
| 84 | (if (and n (<= n 0)) x | ||
| 85 | (cvs-nbutlast (copy-sequence x) n))) | ||
| 86 | |||
| 87 | (defun cvs-nbutlast (x &optional n) | ||
| 88 | "Modifies LIST to remove the last N elements." | ||
| 89 | (let ((m (length x))) | ||
| 90 | (or n (setq n 1)) | ||
| 91 | (and (< n m) | ||
| 92 | (progn | ||
| 93 | (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil)) | ||
| 94 | x)))) | ||
| 95 | |||
| 96 | ;;; | 79 | ;;; |
| 97 | ;;; frame, window, buffer handling | 80 | ;;; frame, window, buffer handling |
| 98 | ;;; | 81 | ;;; |
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index da43b7b7098..0a1ed9e7077 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el | |||
| @@ -329,7 +329,7 @@ be added." | |||
| 329 | (list 'const (car elt))) | 329 | (list 'const (car elt))) |
| 330 | compilation-error-regexp-alist-alist)) | 330 | compilation-error-regexp-alist-alist)) |
| 331 | :link `(file-link :tag "example file" | 331 | :link `(file-link :tag "example file" |
| 332 | ,(concat doc-directory "compilation.txt")) | 332 | ,(expand-file-name "compilation.txt" data-directory)) |
| 333 | :group 'compilation) | 333 | :group 'compilation) |
| 334 | 334 | ||
| 335 | (defvar compilation-directory nil | 335 | (defvar compilation-directory nil |
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el new file mode 100644 index 00000000000..2cd62eeecee --- /dev/null +++ b/lisp/progmodes/flymake.el | |||
| @@ -0,0 +1,2504 @@ | |||
| 1 | ;;; flymake.el -- a universal on-the-fly syntax checker | ||
| 2 | |||
| 3 | ;; Copyright (C) 2003 Free Software Foundation | ||
| 4 | |||
| 5 | ;; Author: Pavel Kobiakov <pk_at_work@yahoo.com> | ||
| 6 | ;; Maintainer: Pavel Kobiakov <pk_at_work@yahoo.com> | ||
| 7 | ;; Version: 0.3 | ||
| 8 | ;; Keywords: c languages tools | ||
| 9 | |||
| 10 | ;; This file is part of GNU Emacs. | ||
| 11 | |||
| 12 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 13 | ;; it under the terms of the GNU General Public License as published by | ||
| 14 | ;; the Free Software Foundation; either version 2, or (at your option) | ||
| 15 | ;; any later version. | ||
| 16 | |||
| 17 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 20 | ;; GNU General Public License for more details. | ||
| 21 | |||
| 22 | ;; You should have received a copy of the GNU General Public License | ||
| 23 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | ||
| 24 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | ||
| 25 | ;; Boston, MA 02111-1307, USA. | ||
| 26 | |||
| 27 | ;;; Commentary: | ||
| 28 | ;; | ||
| 29 | ;; Flymake is a minor Emacs mode performing on-the-fly syntax | ||
| 30 | ;; checks using the external syntax check tool (for C/C++ this | ||
| 31 | ;; is usually the compiler) | ||
| 32 | |||
| 33 | ;;; Code: | ||
| 34 | |||
| 35 | ;;;_* Provide | ||
| 36 | (provide 'flymake) | ||
| 37 | |||
| 38 | ;;;; [[ Overlay compatibility | ||
| 39 | (autoload 'make-overlay "overlay" "Overlay compatibility kit." t) | ||
| 40 | (autoload 'overlayp "overlay" "Overlay compatibility kit." t) | ||
| 41 | (autoload 'overlays-in "overlay" "Overlay compatibility kit." t) | ||
| 42 | (autoload 'delete-overlay "overlay" "Overlay compatibility kit." t) | ||
| 43 | (autoload 'overlay-put "overlay" "Overlay compatibility kit." t) | ||
| 44 | (autoload 'overlay-get "overlay" "Overlay compatibility kit." t) | ||
| 45 | ;;;; ]] | ||
| 46 | |||
| 47 | ;;;; [[ cross-emacs compatibility routines | ||
| 48 | (defvar flymake-emacs | ||
| 49 | (cond | ||
| 50 | ((string-match "XEmacs" emacs-version) 'xemacs) | ||
| 51 | (t 'emacs) | ||
| 52 | ) | ||
| 53 | "Currently used emacs flavor" | ||
| 54 | ) | ||
| 55 | |||
| 56 | (defun flymake-makehash(&optional test) | ||
| 57 | (cond | ||
| 58 | ((equal flymake-emacs 'xemacs) (if test (make-hash-table :test test) (make-hash-table))) | ||
| 59 | (t (makehash test)) | ||
| 60 | ) | ||
| 61 | ) | ||
| 62 | |||
| 63 | (defun flymake-time-to-float(&optional tm) | ||
| 64 | "Convert `current-time` to a float number of seconds." | ||
| 65 | (multiple-value-bind (s0 s1 s2) (or tm (current-time)) | ||
| 66 | (+ (* (float (ash 1 16)) s0) (float s1) (* 0.0000001 s2))) | ||
| 67 | ) | ||
| 68 | (defun flymake-float-time() | ||
| 69 | (cond | ||
| 70 | ((equal flymake-emacs 'xemacs) (flymake-time-to-float (current-time))) | ||
| 71 | (t (float-time)) | ||
| 72 | ) | ||
| 73 | ) | ||
| 74 | |||
| 75 | (defun flymake-replace-regexp-in-string(regexp rep str) | ||
| 76 | (cond | ||
| 77 | ((equal flymake-emacs 'xemacs) (replace-in-string str regexp rep)) | ||
| 78 | (t (replace-regexp-in-string regexp rep str)) | ||
| 79 | ) | ||
| 80 | ) | ||
| 81 | |||
| 82 | (defun flymake-split-string-remove-empty-edges(str pattern) | ||
| 83 | "split, then remove first and/or last in case it's empty" | ||
| 84 | (let* ((splitted (split-string str pattern))) | ||
| 85 | (if (and (> (length splitted) 0) (= 0 (length (elt splitted 0)))) | ||
| 86 | (setq splitted (cdr splitted)) | ||
| 87 | ) | ||
| 88 | (if (and (> (length splitted) 0) (= 0 (length (elt splitted (1- (length splitted)))))) | ||
| 89 | (setq splitted (reverse (cdr (reverse splitted)))) | ||
| 90 | ) | ||
| 91 | splitted | ||
| 92 | ) | ||
| 93 | ) | ||
| 94 | (defun flymake-split-string(str pattern) | ||
| 95 | (cond | ||
| 96 | ((equal flymake-emacs 'xemacs) (flymake-split-string-remove-empty-edges str pattern)) | ||
| 97 | (t (split-string str pattern)) | ||
| 98 | ) | ||
| 99 | ) | ||
| 100 | |||
| 101 | (defun flymake-get-temp-dir() | ||
| 102 | (cond | ||
| 103 | ((equal flymake-emacs 'xemacs) (temp-directory)) | ||
| 104 | (t temporary-file-directory) | ||
| 105 | ) | ||
| 106 | ) | ||
| 107 | |||
| 108 | (defun flymake-line-beginning-position() | ||
| 109 | (save-excursion | ||
| 110 | (beginning-of-line) | ||
| 111 | (point) | ||
| 112 | ) | ||
| 113 | ) | ||
| 114 | |||
| 115 | (defun flymake-line-end-position() | ||
| 116 | (save-excursion | ||
| 117 | (end-of-line) | ||
| 118 | (point) | ||
| 119 | ) | ||
| 120 | ) | ||
| 121 | |||
| 122 | (defun flymake-popup-menu(pos menu-data) | ||
| 123 | (cond | ||
| 124 | ((equal flymake-emacs 'xemacs) | ||
| 125 | (let* ((x-pos (nth 0 (nth 0 pos))) | ||
| 126 | (y-pos (nth 1 (nth 0 pos))) | ||
| 127 | (fake-event-props '(button 1 x 1 y 1))) | ||
| 128 | (setq fake-event-props (plist-put fake-event-props 'x x-pos)) | ||
| 129 | (setq fake-event-props (plist-put fake-event-props 'y y-pos)) | ||
| 130 | (popup-menu (flymake-make-xemacs-menu menu-data) (make-event 'button-press fake-event-props)) | ||
| 131 | ) | ||
| 132 | ) | ||
| 133 | (t (x-popup-menu pos (flymake-make-emacs-menu menu-data))) | ||
| 134 | ) | ||
| 135 | ) | ||
| 136 | |||
| 137 | (defun flymake-make-emacs-menu(menu-data) | ||
| 138 | (let* ((menu-title (nth 0 menu-data)) | ||
| 139 | (menu-items (nth 1 menu-data)) | ||
| 140 | (menu-commands nil)) | ||
| 141 | |||
| 142 | (setq menu-commands (mapcar (lambda (foo) | ||
| 143 | (cons (nth 0 foo) (nth 1 foo))) | ||
| 144 | menu-items)) | ||
| 145 | (list menu-title (cons "" menu-commands)) | ||
| 146 | ) | ||
| 147 | ) | ||
| 148 | |||
| 149 | (defun flymake-nop() | ||
| 150 | ) | ||
| 151 | |||
| 152 | (defun flymake-make-xemacs-menu(menu-data) | ||
| 153 | (let* ((menu-title (nth 0 menu-data)) | ||
| 154 | (menu-items (nth 1 menu-data)) | ||
| 155 | (menu-commands nil)) | ||
| 156 | (setq menu-commands (mapcar (lambda (foo) | ||
| 157 | (vector (nth 0 foo) (or (nth 1 foo) '(flymake-nop)) t)) | ||
| 158 | menu-items)) | ||
| 159 | (cons menu-title menu-commands) | ||
| 160 | ) | ||
| 161 | ) | ||
| 162 | |||
| 163 | (defun flymake-xemacs-window-edges(&optional window) | ||
| 164 | (let ((edges (window-pixel-edges window)) | ||
| 165 | tmp) | ||
| 166 | (setq tmp edges) | ||
| 167 | (setcar tmp (/ (car tmp) (face-width 'default))) | ||
| 168 | (setq tmp (cdr tmp)) | ||
| 169 | (setcar tmp (/ (car tmp) (face-height 'default))) | ||
| 170 | (setq tmp (cdr tmp)) | ||
| 171 | (setcar tmp (/ (car tmp) (face-width 'default))) | ||
| 172 | (setq tmp (cdr tmp)) | ||
| 173 | (setcar tmp (/ (car tmp) (face-height 'default))) | ||
| 174 | edges | ||
| 175 | ) | ||
| 176 | ) | ||
| 177 | |||
| 178 | (defun flymake-current-row() | ||
| 179 | "return current row in current frame" | ||
| 180 | (cond | ||
| 181 | ((equal flymake-emacs 'xemacs) (count-lines (window-start) (point))) | ||
| 182 | (t (+ (car (cdr (window-edges))) (count-lines (window-start) (point)))) | ||
| 183 | ) | ||
| 184 | ) | ||
| 185 | |||
| 186 | (defun flymake-selected-frame() | ||
| 187 | (cond | ||
| 188 | ((equal flymake-emacs 'xemacs) (selected-window)) | ||
| 189 | (t (selected-frame)) | ||
| 190 | ) | ||
| 191 | ) | ||
| 192 | |||
| 193 | ;;;; ]] | ||
| 194 | |||
| 195 | (defcustom flymake-log-level -1 | ||
| 196 | "Logging level, only messages with level > flymake-log-level will not be logged | ||
| 197 | -1 = NONE, 0 = ERROR, 1 = WARNING, 2 = INFO, 3 = DEBUG" | ||
| 198 | :group 'flymake | ||
| 199 | :type 'integer | ||
| 200 | ) | ||
| 201 | |||
| 202 | (defun flymake-log(level text &rest args) | ||
| 203 | "Log a message with optional arguments" | ||
| 204 | (if (<= level flymake-log-level) | ||
| 205 | (let* ((msg (apply 'format text args))) | ||
| 206 | (message msg) | ||
| 207 | ;(with-temp-buffer | ||
| 208 | ; (insert msg) | ||
| 209 | ; (insert "\n") | ||
| 210 | ; (flymake-save-buffer-in-file (current-buffer) "d:/flymake.log" t) ; make log file name customizable | ||
| 211 | ;) | ||
| 212 | ) | ||
| 213 | ) | ||
| 214 | ) | ||
| 215 | |||
| 216 | (defun flymake-ins-after(list pos val) | ||
| 217 | "insert val into list after position pos" | ||
| 218 | (let ((tmp (copy-sequence list))) ; (???) | ||
| 219 | (setcdr (nthcdr pos tmp) (cons val (nthcdr (1+ pos) tmp))) | ||
| 220 | tmp | ||
| 221 | ) | ||
| 222 | ) | ||
| 223 | |||
| 224 | (defun flymake-set-at(list pos val) | ||
| 225 | "set val at position pos in list" | ||
| 226 | (let ((tmp (copy-sequence list))) ; (???) | ||
| 227 | (setcar (nthcdr pos tmp) val) | ||
| 228 | tmp | ||
| 229 | ) | ||
| 230 | ) | ||
| 231 | |||
| 232 | (defvar flymake-pid-to-names(flymake-makehash) | ||
| 233 | "pid -> source buffer name, output file name mapping" | ||
| 234 | ) | ||
| 235 | |||
| 236 | (defun flymake-reg-names(pid source-buffer-name) | ||
| 237 | "Save into in pid map" | ||
| 238 | (unless (stringp source-buffer-name) | ||
| 239 | (error "invalid buffer name") | ||
| 240 | ) | ||
| 241 | (puthash pid (list source-buffer-name) flymake-pid-to-names) | ||
| 242 | ) | ||
| 243 | |||
| 244 | (defun flymake-get-source-buffer-name(pid) | ||
| 245 | "Return buffer name stored in pid map" | ||
| 246 | (nth 0 (gethash pid flymake-pid-to-names)) | ||
| 247 | ) | ||
| 248 | |||
| 249 | (defun flymake-unreg-names(pid) | ||
| 250 | "Delete pid->buffer name mapping" | ||
| 251 | (remhash pid flymake-pid-to-names) | ||
| 252 | ) | ||
| 253 | |||
| 254 | (defun flymake-get-buffer-var(buffer var-name) | ||
| 255 | "switch to buffer if necessary and return local variable var" | ||
| 256 | (unless (bufferp buffer) | ||
| 257 | (error "invalid buffer") | ||
| 258 | ) | ||
| 259 | |||
| 260 | (if (eq buffer (current-buffer)) | ||
| 261 | (symbol-value var-name) | ||
| 262 | ;else | ||
| 263 | (save-excursion | ||
| 264 | (set-buffer buffer) | ||
| 265 | (symbol-value var-name) | ||
| 266 | ) | ||
| 267 | ) | ||
| 268 | ) | ||
| 269 | |||
| 270 | (defun flymake-set-buffer-var(buffer var-name var-value) | ||
| 271 | "switch to buffer if necessary and set local variable var-name to var-value" | ||
| 272 | (unless (bufferp buffer) | ||
| 273 | (error "invalid buffer") | ||
| 274 | ) | ||
| 275 | |||
| 276 | (if (eq buffer (current-buffer)) | ||
| 277 | (set var-name var-value) | ||
| 278 | ;else | ||
| 279 | (save-excursion | ||
| 280 | (set-buffer buffer) | ||
| 281 | (set var-name var-value) | ||
| 282 | ) | ||
| 283 | ) | ||
| 284 | ) | ||
| 285 | |||
| 286 | (defvar flymake-buffer-data(flymake-makehash) | ||
| 287 | "data specific to syntax check tool, in name-value pairs" | ||
| 288 | ) | ||
| 289 | (make-variable-buffer-local 'flymake-buffer-data) | ||
| 290 | (defun flymake-get-buffer-data(buffer) | ||
| 291 | (flymake-get-buffer-var buffer 'flymake-buffer-data) | ||
| 292 | ) | ||
| 293 | (defun flymake-set-buffer-data(buffer data) | ||
| 294 | (flymake-set-buffer-var buffer 'flymake-buffer-data data) | ||
| 295 | ) | ||
| 296 | (defun flymake-get-buffer-value(buffer name) | ||
| 297 | (gethash name (flymake-get-buffer-data buffer)) | ||
| 298 | ) | ||
| 299 | (defun flymake-set-buffer-value(buffer name value) | ||
| 300 | (puthash name value (flymake-get-buffer-data buffer)) | ||
| 301 | ) | ||
| 302 | |||
| 303 | (defvar flymake-output-residual nil | ||
| 304 | "" | ||
| 305 | ) | ||
| 306 | (make-variable-buffer-local 'flymake-output-residual) | ||
| 307 | (defun flymake-get-buffer-output-residual(buffer) | ||
| 308 | (flymake-get-buffer-var buffer 'flymake-output-residual) | ||
| 309 | ) | ||
| 310 | (defun flymake-set-buffer-output-residual(buffer residual) | ||
| 311 | (flymake-set-buffer-var buffer 'flymake-output-residual residual) | ||
| 312 | ) | ||
| 313 | |||
| 314 | (defcustom flymake-allowed-file-name-masks '((".+\\.c$" flymake-simple-make-init flymake-simple-cleanup flymake-get-real-file-name) | ||
| 315 | (".+\\.cpp$" flymake-simple-make-init flymake-simple-cleanup flymake-get-real-file-name) | ||
| 316 | (".+\\.xml$" flymake-xml-init flymake-simple-cleanup flymake-get-real-file-name) | ||
| 317 | (".+\\.html?$" flymake-xml-init flymake-simple-cleanup flymake-get-real-file-name) | ||
| 318 | (".+\\.cs$" flymake-simple-make-init flymake-simple-cleanup flymake-get-real-file-name) | ||
| 319 | (".+\\.pl$" flymake-perl-init flymake-simple-cleanup flymake-get-real-file-name) | ||
| 320 | (".+\\.h$" flymake-master-make-header-init flymake-master-cleanup flymake-get-real-file-name) | ||
| 321 | (".+\\.java$" flymake-simple-make-java-init flymake-simple-java-cleanup flymake-get-real-file-name) | ||
| 322 | (".+[0-9]+\\.tex$" flymake-master-tex-init flymake-master-cleanup flymake-get-real-file-name) | ||
| 323 | (".+\\.tex$" flymake-simple-tex-init flymake-simple-cleanup flymake-get-real-file-name) | ||
| 324 | (".+\\.idl$" flymake-simple-make-init flymake-simple-cleanup flymake-get-real-file-name) | ||
| 325 | ; (".+\\.cpp$" 1) | ||
| 326 | ; (".+\\.java$" 3) | ||
| 327 | ; (".+\\.h$" 2 (".+\\.cpp$" ".+\\.c$") | ||
| 328 | ; ("[ \t]*#[ \t]*include[ \t]*\"\\([\w0-9/\\_\.]*[/\\]*\\)\\(%s\\)\"" 1 2)) | ||
| 329 | ; (".+\\.idl$" 1) | ||
| 330 | ; (".+\\.odl$" 1) | ||
| 331 | ; (".+[0-9]+\\.tex$" 2 (".+\\.tex$") | ||
| 332 | ; ("[ \t]*\\input[ \t]*{\\(.*\\)\\(%s\\)}" 1 2 )) | ||
| 333 | ; (".+\\.tex$" 1) | ||
| 334 | ) | ||
| 335 | "*Files syntax checking is allowed for" | ||
| 336 | :group 'flymake | ||
| 337 | :type '(repeat (string symbol symbol symbol)) | ||
| 338 | ) | ||
| 339 | |||
| 340 | (defun flymake-get-file-name-mode-and-masks(file-name) | ||
| 341 | "return the corresponding entry from flymake-allowed-file-name-masks" | ||
| 342 | (unless (stringp file-name) | ||
| 343 | (error "invalid file-name") | ||
| 344 | ) | ||
| 345 | (let ((count (length flymake-allowed-file-name-masks)) | ||
| 346 | (idx 0) | ||
| 347 | (mode-and-masks nil)) | ||
| 348 | (while (and (not mode-and-masks) (< idx count)) | ||
| 349 | (if (string-match (nth 0 (nth idx flymake-allowed-file-name-masks)) file-name) | ||
| 350 | (setq mode-and-masks (cdr (nth idx flymake-allowed-file-name-masks))) | ||
| 351 | ) | ||
| 352 | (setq idx (1+ idx)) | ||
| 353 | ) | ||
| 354 | (flymake-log 3 "file %s, init=%s" file-name (car mode-and-masks)) | ||
| 355 | mode-and-masks | ||
| 356 | ) | ||
| 357 | ) | ||
| 358 | |||
| 359 | (defun flymake-can-syntax-check-file(file-name) | ||
| 360 | "Determine whether we can syntax check file-name: nil if cannot, non-nil if can" | ||
| 361 | (if (flymake-get-init-function file-name) | ||
| 362 | t | ||
| 363 | ;else | ||
| 364 | nil | ||
| 365 | ) | ||
| 366 | ) | ||
| 367 | |||
| 368 | (defun flymake-get-init-function(file-name) | ||
| 369 | "return init function to be used for the file" | ||
| 370 | (let* ((init-f (nth 0 (flymake-get-file-name-mode-and-masks file-name)))) | ||
| 371 | ;(flymake-log 0 "calling %s" init-f) | ||
| 372 | ;(funcall init-f (current-buffer)) | ||
| 373 | ) | ||
| 374 | (nth 0 (flymake-get-file-name-mode-and-masks file-name)) | ||
| 375 | ) | ||
| 376 | |||
| 377 | (defun flymake-get-cleanup-function(file-name) | ||
| 378 | "return cleanup function to be used for the file" | ||
| 379 | (nth 1 (flymake-get-file-name-mode-and-masks file-name)) | ||
| 380 | ) | ||
| 381 | |||
| 382 | (defun flymake-get-real-file-name-function(file-name) | ||
| 383 | "" | ||
| 384 | (or (nth 2 (flymake-get-file-name-mode-and-masks file-name)) 'flymake-get-real-file-name) | ||
| 385 | ) | ||
| 386 | |||
| 387 | (defcustom flymake-buildfile-dirs '("." ".." "../.." "../../.." "../../../.." "../../../../.." "../../../../../.." "../../../../../../.." "../../../../../../../.." "../../../../../../../../.." "../../../../../../../../../.." "../../../../../../../../../../..") | ||
| 388 | "dirs to look for buildfile" | ||
| 389 | :group 'flymake | ||
| 390 | :type '(repeat (string)) | ||
| 391 | ) | ||
| 392 | |||
| 393 | (defvar flymake-find-buildfile-cache (flymake-makehash 'equal)) | ||
| 394 | (defun flymake-get-buildfile-from-cache(dir-name) | ||
| 395 | (gethash dir-name flymake-find-buildfile-cache) | ||
| 396 | ) | ||
| 397 | (defun flymake-add-buildfile-to-cache(dir-name buildfile) | ||
| 398 | (puthash dir-name buildfile flymake-find-buildfile-cache) | ||
| 399 | ) | ||
| 400 | (defun flymake-clear-buildfile-cache() | ||
| 401 | (clrhash flymake-find-buildfile-cache) | ||
| 402 | ) | ||
| 403 | |||
| 404 | (defun flymake-find-buildfile(buildfile-name source-dir-name dirs) | ||
| 405 | "find buildfile (i.e. Makefile, build.xml, etc.) starting from current directory. Return its path or nil if not found" | ||
| 406 | (if (flymake-get-buildfile-from-cache source-dir-name) | ||
| 407 | (progn | ||
| 408 | (flymake-get-buildfile-from-cache source-dir-name) | ||
| 409 | ) | ||
| 410 | ;else | ||
| 411 | (let* ((buildfile-dir nil) | ||
| 412 | (buildfile nil) | ||
| 413 | (dir-count (length dirs)) | ||
| 414 | (dir-idx 0) | ||
| 415 | (found nil)) | ||
| 416 | |||
| 417 | (while (and (not found) (< dir-idx dir-count)) | ||
| 418 | |||
| 419 | (setq buildfile-dir (concat source-dir-name (nth dir-idx dirs))) | ||
| 420 | (setq buildfile (concat buildfile-dir "/" buildfile-name)) | ||
| 421 | |||
| 422 | (when (file-exists-p buildfile) | ||
| 423 | (setq found t) | ||
| 424 | ) | ||
| 425 | |||
| 426 | (setq dir-idx (1+ dir-idx)) | ||
| 427 | ) | ||
| 428 | (if found | ||
| 429 | (progn | ||
| 430 | (flymake-log 3 "found buildfile at %s/%s" buildfile-dir buildfile-name) | ||
| 431 | (flymake-add-buildfile-to-cache source-dir-name buildfile-dir) | ||
| 432 | buildfile-dir | ||
| 433 | ) | ||
| 434 | ;else | ||
| 435 | (progn | ||
| 436 | (flymake-log 3 "buildfile for %s not found" source-dir-name) | ||
| 437 | nil | ||
| 438 | ) | ||
| 439 | ) | ||
| 440 | ) | ||
| 441 | ) | ||
| 442 | ) | ||
| 443 | |||
| 444 | (defun flymake-fix-path-name(name) | ||
| 445 | "replace all occurences of '\' with '/'" | ||
| 446 | (when name | ||
| 447 | (let* ((new-name (flymake-replace-regexp-in-string "[\\]" "/" (expand-file-name name))) | ||
| 448 | (last-char (elt new-name (1- (length new-name))))) | ||
| 449 | (setq new-name (flymake-replace-regexp-in-string "\\./" "" new-name)) | ||
| 450 | (if (equal "/" (char-to-string last-char)) | ||
| 451 | (setq new-name (substring new-name 0 (1- (length new-name)))) | ||
| 452 | ) | ||
| 453 | new-name | ||
| 454 | ) | ||
| 455 | ) | ||
| 456 | ) | ||
| 457 | |||
| 458 | (defun flymake-same-files(file-name-one file-name-two) | ||
| 459 | "t if file-name-one and file-name-two actually point to the same file" | ||
| 460 | (equal (flymake-fix-path-name file-name-one) (flymake-fix-path-name file-name-two)) | ||
| 461 | ) | ||
| 462 | |||
| 463 | (defun flymake-ensure-ends-with-slash(path) | ||
| 464 | (if (not (= (elt path (1- (length path))) (string-to-char "/"))) | ||
| 465 | (concat path "/") | ||
| 466 | ;else | ||
| 467 | path | ||
| 468 | ) | ||
| 469 | ) | ||
| 470 | |||
| 471 | (defun flymake-get-common-path-prefix(string-one string-two) | ||
| 472 | "return common prefix for two paths" | ||
| 473 | (when (and string-one string-two) | ||
| 474 | (let* ((slash-pos-one -1) | ||
| 475 | (slash-pos-two -1) | ||
| 476 | (done nil) | ||
| 477 | (prefix nil)) | ||
| 478 | |||
| 479 | (setq string-one (flymake-ensure-ends-with-slash string-one)) | ||
| 480 | (setq string-two (flymake-ensure-ends-with-slash string-two)) | ||
| 481 | |||
| 482 | (while (not done) | ||
| 483 | (setq slash-pos-one (string-match "/" string-one (1+ slash-pos-one))) | ||
| 484 | (setq slash-pos-two (string-match "/" string-two (1+ slash-pos-two))) | ||
| 485 | |||
| 486 | (if (and slash-pos-one slash-pos-two | ||
| 487 | (= slash-pos-one slash-pos-two) | ||
| 488 | (string= (substring string-one 0 slash-pos-one) (substring string-two 0 slash-pos-two))) | ||
| 489 | (progn | ||
| 490 | (setq prefix (substring string-one 0 (1+ slash-pos-one))) | ||
| 491 | ) | ||
| 492 | ;else | ||
| 493 | (setq done t) | ||
| 494 | ) | ||
| 495 | ) | ||
| 496 | prefix | ||
| 497 | ) | ||
| 498 | ) | ||
| 499 | ) | ||
| 500 | |||
| 501 | (defun flymake-build-relative-path(from-dir to-dir) | ||
| 502 | "return rel: from-dir/rel == to-dir" | ||
| 503 | (if (not (equal (elt from-dir 0) (elt to-dir 0))) | ||
| 504 | (error "first chars in paths %s, %s must be equal (same drive)" from-dir to-dir) | ||
| 505 | ;else | ||
| 506 | (let* ((from (flymake-ensure-ends-with-slash (flymake-fix-path-name from-dir))) | ||
| 507 | (to (flymake-ensure-ends-with-slash (flymake-fix-path-name to-dir))) | ||
| 508 | (prefix (flymake-get-common-path-prefix from to)) | ||
| 509 | (from-suffix (substring from (length prefix))) | ||
| 510 | (up-count (length (flymake-split-string from-suffix "[/]"))) | ||
| 511 | (to-suffix (substring to (length prefix))) | ||
| 512 | (idx 0) | ||
| 513 | (rel nil)) | ||
| 514 | |||
| 515 | (if (and (> (length to-suffix) 0) (equal "/" (char-to-string (elt to-suffix 0)))) | ||
| 516 | (setq to-suffix (substring to-suffix 1)) | ||
| 517 | ) | ||
| 518 | |||
| 519 | (while (< idx up-count) | ||
| 520 | (if (> (length rel) 0) | ||
| 521 | (setq rel (concat rel "/")) | ||
| 522 | ) | ||
| 523 | (setq rel (concat rel "..")) | ||
| 524 | (setq idx (1+ idx)) | ||
| 525 | ) | ||
| 526 | (if (> (length rel) 0) | ||
| 527 | (setq rel (concat rel "/")) | ||
| 528 | ) | ||
| 529 | (if (> (length to-suffix) 0) | ||
| 530 | (setq rel (concat rel to-suffix)) | ||
| 531 | ) | ||
| 532 | |||
| 533 | (or rel "./") | ||
| 534 | ) | ||
| 535 | ) | ||
| 536 | ) | ||
| 537 | |||
| 538 | (defcustom flymake-master-file-dirs '("." "./src" "./UnitTest") | ||
| 539 | "dirs where to llok for master files" | ||
| 540 | :group 'flymake | ||
| 541 | :type '(repeat (string)) | ||
| 542 | ) | ||
| 543 | |||
| 544 | (defcustom flymake-master-file-count-limit 32 | ||
| 545 | "max number of master files to check" | ||
| 546 | :group 'flymake | ||
| 547 | :type 'integer | ||
| 548 | ) | ||
| 549 | |||
| 550 | (defun flymake-find-possible-master-files(file-name master-file-dirs masks) | ||
| 551 | "find (by name and location) all posible master files, which are .cpp and .c for and .h. | ||
| 552 | Files are searched for starting from the .h directory and max max-level parent dirs. | ||
| 553 | File contents are not checked." | ||
| 554 | (let* ((dir-idx 0) | ||
| 555 | (dir-count (length master-file-dirs)) | ||
| 556 | (files nil) | ||
| 557 | (done nil) | ||
| 558 | (masks-count (length masks))) | ||
| 559 | |||
| 560 | (while (and (not done) (< dir-idx dir-count)) | ||
| 561 | (let* ((dir (concat (flymake-fix-path-name (file-name-directory file-name)) "/" (nth dir-idx master-file-dirs))) | ||
| 562 | (masks-idx 0)) | ||
| 563 | (while (and (file-exists-p dir) (not done) (< masks-idx masks-count)) | ||
| 564 | (let* ((mask (nth masks-idx masks)) | ||
| 565 | (dir-files (directory-files dir t mask)) | ||
| 566 | (file-count (length dir-files)) | ||
| 567 | (file-idx 0)) | ||
| 568 | |||
| 569 | (flymake-log 3 "dir %s, %d file(s) for mask %s" dir file-count mask) | ||
| 570 | (while (and (not done) (< file-idx file-count)) | ||
| 571 | (when (not (file-directory-p (nth file-idx dir-files))) | ||
| 572 | (setq files (cons (nth file-idx dir-files) files)) | ||
| 573 | (when (>= (length files) flymake-master-file-count-limit) | ||
| 574 | (flymake-log 3 "master file count limit (%d) reached" flymake-master-file-count-limit) | ||
| 575 | (setq done t) | ||
| 576 | ) | ||
| 577 | ) | ||
| 578 | (setq file-idx (1+ file-idx)) | ||
| 579 | ) | ||
| 580 | ) | ||
| 581 | (setq masks-idx (1+ masks-idx)) | ||
| 582 | ) | ||
| 583 | ) | ||
| 584 | (setq dir-idx (1+ dir-idx)) | ||
| 585 | ) | ||
| 586 | (when files | ||
| 587 | (setq flymake-included-file-name (file-name-nondirectory file-name)) | ||
| 588 | (setq files (sort files 'flymake-master-file-compare)) | ||
| 589 | (setq flymake-included-file-name nil) | ||
| 590 | ) | ||
| 591 | (flymake-log 3 "found %d possible master file(s)" (length files)) | ||
| 592 | files | ||
| 593 | ) | ||
| 594 | ) | ||
| 595 | |||
| 596 | (defvar flymake-included-file-name nil ; this is used to pass a parameter to a sort predicate below | ||
| 597 | "" | ||
| 598 | ) | ||
| 599 | |||
| 600 | (defun flymake-master-file-compare(file-one file-two) | ||
| 601 | "used in sort to move most possible file names to the beginning of the list (File.h -> File.cpp moved to top" | ||
| 602 | (and (equal (file-name-sans-extension flymake-included-file-name) | ||
| 603 | (file-name-sans-extension (file-name-nondirectory file-one))) | ||
| 604 | (not (equal file-one file-two)) | ||
| 605 | ) | ||
| 606 | ) | ||
| 607 | |||
| 608 | (defcustom flymake-check-file-limit 8192 | ||
| 609 | "max number of chars to look at when checking possible master file" | ||
| 610 | :group 'flymake | ||
| 611 | :type 'integer | ||
| 612 | ) | ||
| 613 | |||
| 614 | (defun flymake-check-patch-master-file-buffer(master-file-temp-buffer | ||
| 615 | master-file-name patched-master-file-name | ||
| 616 | source-file-name patched-source-file-name | ||
| 617 | include-dirs regexp-list) | ||
| 618 | "check whether master-file-name is indeed a master file for source-file-name. | ||
| 619 | For .cpp master file this means it includes source-file-name (.h). | ||
| 620 | If yes, patch a copy of master-file-name to include patched-source-file-name instead of source-file-name. | ||
| 621 | Whenether a buffer for master-file-name exists, use it as a source instead of reading master file from disk" | ||
| 622 | (let* ((found nil) | ||
| 623 | (regexp (format (nth 0 regexp-list) ; "[ \t]*#[ \t]*include[ \t]*\"\\([\w0-9/\\_\.]*[/\\]*\\)\\(%s\\)\"" | ||
| 624 | (file-name-nondirectory source-file-name))) | ||
| 625 | (path-idx (nth 1 regexp-list)) | ||
| 626 | (name-idx (nth 2 regexp-list)) | ||
| 627 | (inc-path nil) | ||
| 628 | (inc-name nil) | ||
| 629 | (search-limit flymake-check-file-limit)) | ||
| 630 | (save-excursion | ||
| 631 | (unwind-protect | ||
| 632 | (progn | ||
| 633 | (set-buffer master-file-temp-buffer) | ||
| 634 | (when (> search-limit (point-max)) | ||
| 635 | (setq search-limit (point-max)) | ||
| 636 | ) | ||
| 637 | (flymake-log 3 "checking %s against regexp %s" master-file-name regexp) | ||
| 638 | (goto-char (point-min)) | ||
| 639 | (while (and (< (point) search-limit) (re-search-forward regexp search-limit t)) | ||
| 640 | (let* ((match-beg (match-beginning name-idx)) | ||
| 641 | (match-end (match-end name-idx))) | ||
| 642 | |||
| 643 | (flymake-log 3 "found possible match for %s" (file-name-nondirectory source-file-name)) | ||
| 644 | (setq inc-path (match-string path-idx)) | ||
| 645 | (setq inc-name (match-string name-idx)) | ||
| 646 | (when (string= inc-name (file-name-nondirectory source-file-name)) | ||
| 647 | (flymake-log 3 "inc-path=%s inc-name=%s" inc-path inc-name) | ||
| 648 | (when (flymake-check-include source-file-name inc-path inc-name include-dirs) | ||
| 649 | (setq found t) | ||
| 650 | ; replace-match is not used here as it fails in xemacs with | ||
| 651 | ; 'last match not a buffer' error as check-includes calls replace-in-string | ||
| 652 | (flymake-replace-region (current-buffer) match-beg match-end | ||
| 653 | (file-name-nondirectory patched-source-file-name)) | ||
| 654 | ) | ||
| 655 | ) | ||
| 656 | (forward-line 1) | ||
| 657 | ) | ||
| 658 | ) | ||
| 659 | (when found | ||
| 660 | (flymake-save-buffer-in-file (current-buffer) patched-master-file-name) | ||
| 661 | ) | ||
| 662 | ) | ||
| 663 | ;+(flymake-log 3 "killing buffer %s" (buffer-name master-file-temp-buffer)) | ||
| 664 | (kill-buffer master-file-temp-buffer) | ||
| 665 | ) | ||
| 666 | ) | ||
| 667 | ;+(flymake-log 3 "check-patch master file %s: %s" master-file-name found) | ||
| 668 | (when found | ||
| 669 | (flymake-log 2 "found master file %s" master-file-name) | ||
| 670 | ) | ||
| 671 | found | ||
| 672 | ) | ||
| 673 | ) | ||
| 674 | |||
| 675 | (defun flymake-replace-region(buffer beg end rep) | ||
| 676 | "replace text in buffer in region (beg; end) with rep" | ||
| 677 | (save-excursion | ||
| 678 | (delete-region beg end) | ||
| 679 | (goto-char beg) | ||
| 680 | (insert rep) | ||
| 681 | ) | ||
| 682 | ) | ||
| 683 | |||
| 684 | (defun flymake-read-file-to-temp-buffer(file-name) | ||
| 685 | "isert contents of file-name into newly created temp buffer" | ||
| 686 | (let* ((temp-buffer (get-buffer-create (generate-new-buffer-name (concat "flymake:" (file-name-nondirectory file-name)))))) | ||
| 687 | (save-excursion | ||
| 688 | (set-buffer temp-buffer) | ||
| 689 | (insert-file-contents file-name) | ||
| 690 | ) | ||
| 691 | temp-buffer | ||
| 692 | ) | ||
| 693 | ) | ||
| 694 | |||
| 695 | (defun flymake-copy-buffer-to-temp-buffer(buffer) | ||
| 696 | "copy contents of buffer into newly created temp buffer" | ||
| 697 | (let ((contents nil) | ||
| 698 | (temp-buffer nil)) | ||
| 699 | (save-excursion | ||
| 700 | (set-buffer buffer) | ||
| 701 | (setq contents (buffer-string)) | ||
| 702 | |||
| 703 | (setq temp-buffer (get-buffer-create (generate-new-buffer-name (concat "flymake:" (buffer-name buffer))))) | ||
| 704 | (set-buffer temp-buffer) | ||
| 705 | (insert contents) | ||
| 706 | ) | ||
| 707 | temp-buffer | ||
| 708 | ) | ||
| 709 | ) | ||
| 710 | |||
| 711 | (defun flymake-check-include(source-file-name inc-path inc-name include-dirs) | ||
| 712 | "t if source-file-name is the one found via include dirs using inc-path and inc-name" | ||
| 713 | (if (file-name-absolute-p inc-path) | ||
| 714 | (flymake-same-files source-file-name (concat inc-path "/" inc-name)) | ||
| 715 | ;else | ||
| 716 | (let* ((count (length include-dirs)) | ||
| 717 | (idx 0) | ||
| 718 | (file-name nil) | ||
| 719 | (found nil)) | ||
| 720 | (while (and (not found) (< idx count)) | ||
| 721 | (setq file-name (concat (file-name-directory source-file-name) "/" (nth idx include-dirs))) | ||
| 722 | (if (> (length inc-path) 0) | ||
| 723 | (setq file-name (concat file-name "/" inc-path)) | ||
| 724 | ) | ||
| 725 | (setq file-name (concat file-name "/" inc-name)) | ||
| 726 | (when (flymake-same-files source-file-name file-name) | ||
| 727 | (setq found t) | ||
| 728 | ) | ||
| 729 | (setq idx (1+ idx)) | ||
| 730 | ) | ||
| 731 | found | ||
| 732 | ) | ||
| 733 | ) | ||
| 734 | ) | ||
| 735 | |||
| 736 | (defun flymake-find-buffer-for-file(file-name) | ||
| 737 | "buffer if there exists a buffer visiting file-name, nil otherwise" | ||
| 738 | (let ((buffer-name (get-file-buffer file-name))) | ||
| 739 | (if buffer-name | ||
| 740 | (get-buffer buffer-name) | ||
| 741 | ) | ||
| 742 | ) | ||
| 743 | ) | ||
| 744 | |||
| 745 | (defun flymake-create-master-file(source-file-name patched-source-file-name get-incl-dirs-f create-temp-f masks include-regexp-list) | ||
| 746 | "save source-file-name with a different name, find master file, patch it and save it to." | ||
| 747 | (let* ((possible-master-files (flymake-find-possible-master-files source-file-name flymake-master-file-dirs masks)) | ||
| 748 | (master-file-count (length possible-master-files)) | ||
| 749 | (idx 0) | ||
| 750 | (temp-buffer nil) | ||
| 751 | (master-file-name nil) | ||
| 752 | (patched-master-file-name nil) | ||
| 753 | (found nil)) | ||
| 754 | |||
| 755 | (while (and (not found) (< idx master-file-count)) | ||
| 756 | (setq master-file-name (nth idx possible-master-files)) | ||
| 757 | (setq patched-master-file-name (funcall create-temp-f master-file-name "flymake_master")) | ||
| 758 | (if (flymake-find-buffer-for-file master-file-name) | ||
| 759 | (setq temp-buffer (flymake-copy-buffer-to-temp-buffer (flymake-find-buffer-for-file master-file-name))) | ||
| 760 | ;else | ||
| 761 | (setq temp-buffer (flymake-read-file-to-temp-buffer master-file-name)) | ||
| 762 | ) | ||
| 763 | (setq found | ||
| 764 | (flymake-check-patch-master-file-buffer | ||
| 765 | temp-buffer | ||
| 766 | master-file-name | ||
| 767 | patched-master-file-name | ||
| 768 | source-file-name | ||
| 769 | patched-source-file-name | ||
| 770 | (funcall get-incl-dirs-f (file-name-directory master-file-name)) | ||
| 771 | include-regexp-list)) | ||
| 772 | (setq idx (1+ idx)) | ||
| 773 | ) | ||
| 774 | (if found | ||
| 775 | (list master-file-name patched-master-file-name) | ||
| 776 | ;else | ||
| 777 | (progn | ||
| 778 | (flymake-log 3 "none of %d master file(s) checked includes %s" master-file-count | ||
| 779 | (file-name-nondirectory source-file-name)) | ||
| 780 | nil | ||
| 781 | ) | ||
| 782 | ) | ||
| 783 | ) | ||
| 784 | ) | ||
| 785 | |||
| 786 | (defun flymake-save-buffer-in-file(buffer file-name) | ||
| 787 | (or buffer | ||
| 788 | (error "invalid buffer") | ||
| 789 | ) | ||
| 790 | (save-excursion | ||
| 791 | (save-restriction | ||
| 792 | (set-buffer buffer) | ||
| 793 | (widen) | ||
| 794 | (make-directory (file-name-directory file-name) 1) | ||
| 795 | (write-region (point-min) (point-max) file-name nil 566) | ||
| 796 | ) | ||
| 797 | ) | ||
| 798 | (flymake-log 3 "saved buffer %s in file %s" (buffer-name buffer) file-name) | ||
| 799 | ) | ||
| 800 | |||
| 801 | (defun flymake-save-string-to-file(file-name data) | ||
| 802 | "save string data to file file-name" | ||
| 803 | (write-region data nil file-name nil 566) | ||
| 804 | ) | ||
| 805 | |||
| 806 | (defun flymake-read-file-to-string(file-name) | ||
| 807 | "read file contents and return them as a string" | ||
| 808 | (with-temp-buffer | ||
| 809 | (insert-file-contents file-name) | ||
| 810 | (buffer-substring (point-min) (point-max)) | ||
| 811 | ) | ||
| 812 | ) | ||
| 813 | |||
| 814 | (defun flymake-process-filter(process output) | ||
| 815 | "flymake process filter: parse output, highlight err lines" | ||
| 816 | (let* ((pid (process-id process)) | ||
| 817 | (source-buffer (get-buffer (flymake-get-source-buffer-name pid)))) | ||
| 818 | |||
| 819 | (flymake-log 3 "received %d byte(s) of output from process %d" (length output) pid) | ||
| 820 | (when source-buffer | ||
| 821 | (flymake-parse-output-and-residual source-buffer output) | ||
| 822 | ) | ||
| 823 | ) | ||
| 824 | ) | ||
| 825 | |||
| 826 | (defun flymake-process-sentinel(process event) | ||
| 827 | "Sentinel for syntax check buffers" | ||
| 828 | (if (memq (process-status process) '(signal exit)) | ||
| 829 | (let*((exit-status (process-exit-status process)) | ||
| 830 | (command (process-command process)) | ||
| 831 | (pid (process-id process)) | ||
| 832 | (source-buffer (get-buffer (flymake-get-source-buffer-name pid))) | ||
| 833 | (cleanup-f (flymake-get-cleanup-function (buffer-file-name source-buffer)))) | ||
| 834 | |||
| 835 | (flymake-log 2 "process %d exited with code %d" pid exit-status) | ||
| 836 | (condition-case err | ||
| 837 | (progn | ||
| 838 | (flymake-log 3 "cleaning up using %s" cleanup-f) | ||
| 839 | (funcall cleanup-f source-buffer) | ||
| 840 | |||
| 841 | (flymake-unreg-names pid) | ||
| 842 | (delete-process process) | ||
| 843 | |||
| 844 | (when source-buffer | ||
| 845 | (save-excursion | ||
| 846 | (set-buffer source-buffer) | ||
| 847 | |||
| 848 | (flymake-parse-residual source-buffer) | ||
| 849 | (flymake-post-syntax-check source-buffer) | ||
| 850 | (flymake-set-buffer-is-running source-buffer nil) | ||
| 851 | ) | ||
| 852 | ) | ||
| 853 | ) | ||
| 854 | (error | ||
| 855 | (let ((err-str (format "Error in process sentinel for buffer %s: %s" | ||
| 856 | source-buffer (error-message-string err)))) | ||
| 857 | (flymake-log 0 err-str) | ||
| 858 | (flymake-set-buffer-is-running source-buffer nil) | ||
| 859 | ) | ||
| 860 | ) | ||
| 861 | ) | ||
| 862 | ) | ||
| 863 | ) | ||
| 864 | ) | ||
| 865 | |||
| 866 | (defun flymake-post-syntax-check(source-buffer) | ||
| 867 | "" | ||
| 868 | (flymake-set-buffer-err-info source-buffer (flymake-get-buffer-new-err-info source-buffer)) | ||
| 869 | (flymake-set-buffer-new-err-info source-buffer nil) | ||
| 870 | |||
| 871 | (flymake-set-buffer-err-info source-buffer (flymake-fix-line-numbers | ||
| 872 | (flymake-get-buffer-err-info source-buffer) | ||
| 873 | 1 | ||
| 874 | (flymake-count-lines source-buffer))) | ||
| 875 | (flymake-delete-own-overlays source-buffer) | ||
| 876 | (flymake-highlight-err-lines source-buffer (flymake-get-buffer-err-info source-buffer)) | ||
| 877 | |||
| 878 | (let ((err-count (flymake-get-err-count (flymake-get-buffer-err-info source-buffer) "e")) | ||
| 879 | (warn-count (flymake-get-err-count (flymake-get-buffer-err-info source-buffer) "w"))) | ||
| 880 | |||
| 881 | (flymake-log 2 "%s: %d error(s), %d warning(s) in %.2f second(s)" | ||
| 882 | (buffer-name source-buffer) err-count warn-count | ||
| 883 | (- (flymake-float-time) (flymake-get-buffer-check-start-time source-buffer))) | ||
| 884 | (flymake-set-buffer-check-start-time source-buffer nil) | ||
| 885 | (if (and (equal 0 err-count) (equal 0 warn-count)) | ||
| 886 | (if (equal 0 exit-status) | ||
| 887 | (flymake-report-status source-buffer "" "") ; PASSED | ||
| 888 | ;else | ||
| 889 | (if (not (flymake-get-buffer-check-was-interrupted source-buffer)) | ||
| 890 | (flymake-report-fatal-status (current-buffer) "CFGERR" | ||
| 891 | (format "Configuration error has occured while running %s" command)) | ||
| 892 | ;else | ||
| 893 | (flymake-report-status source-buffer nil "") ; "STOPPED" | ||
| 894 | ) | ||
| 895 | ) | ||
| 896 | ;else | ||
| 897 | (flymake-report-status source-buffer (format "%d/%d" err-count warn-count) "") | ||
| 898 | ) | ||
| 899 | ) | ||
| 900 | ) | ||
| 901 | |||
| 902 | (defun flymake-parse-output-and-residual(source-buffer output) | ||
| 903 | "split output into lines, merge in residual if necessary" | ||
| 904 | (save-excursion | ||
| 905 | (set-buffer source-buffer) | ||
| 906 | (let* ((buffer-residual (flymake-get-buffer-output-residual source-buffer)) | ||
| 907 | (total-output (if buffer-residual (concat buffer-residual output) output)) | ||
| 908 | (lines-and-residual (flymake-split-output total-output)) | ||
| 909 | (lines (nth 0 lines-and-residual)) | ||
| 910 | (new-residual (nth 1 lines-and-residual))) | ||
| 911 | |||
| 912 | (flymake-set-buffer-output-residual source-buffer new-residual) | ||
| 913 | (flymake-set-buffer-new-err-info source-buffer (flymake-parse-err-lines | ||
| 914 | (flymake-get-buffer-new-err-info source-buffer) | ||
| 915 | source-buffer lines)) | ||
| 916 | ) | ||
| 917 | ) | ||
| 918 | ) | ||
| 919 | |||
| 920 | (defun flymake-parse-residual(source-buffer) | ||
| 921 | "parse residual if it's non empty" | ||
| 922 | (save-excursion | ||
| 923 | (set-buffer source-buffer) | ||
| 924 | (when (flymake-get-buffer-output-residual source-buffer) | ||
| 925 | (flymake-set-buffer-new-err-info source-buffer (flymake-parse-err-lines | ||
| 926 | (flymake-get-buffer-new-err-info source-buffer) | ||
| 927 | source-buffer | ||
| 928 | (list (flymake-get-buffer-output-residual source-buffer)))) | ||
| 929 | (flymake-set-buffer-output-residual source-buffer nil) | ||
| 930 | ) | ||
| 931 | ) | ||
| 932 | ) | ||
| 933 | |||
| 934 | (defvar flymake-err-info nil | ||
| 935 | "sorted list of line numbers and lists of err info in the form (file, err-text)." | ||
| 936 | ) | ||
| 937 | (make-variable-buffer-local 'flymake-err-info) | ||
| 938 | (defun flymake-get-buffer-err-info(buffer) | ||
| 939 | (flymake-get-buffer-var buffer 'flymake-err-info) | ||
| 940 | ) | ||
| 941 | (defun flymake-set-buffer-err-info(buffer err-info) | ||
| 942 | (flymake-set-buffer-var buffer 'flymake-err-info err-info) | ||
| 943 | ) | ||
| 944 | (defun flymake-er-make-er(line-no line-err-info-list) | ||
| 945 | (list line-no line-err-info-list) | ||
| 946 | ) | ||
| 947 | (defun flymake-er-get-line(err-info) | ||
| 948 | (nth 0 err-info) | ||
| 949 | ) | ||
| 950 | (defun flymake-er-get-line-err-info-list(err-info) | ||
| 951 | (nth 1 err-info) | ||
| 952 | ) | ||
| 953 | |||
| 954 | (defvar flymake-new-err-info nil | ||
| 955 | "the same as flymake -err-info, effective when a syntax check is in progress" | ||
| 956 | ) | ||
| 957 | (make-variable-buffer-local 'flymake-new-err-info) | ||
| 958 | (defun flymake-get-buffer-new-err-info(buffer) | ||
| 959 | (flymake-get-buffer-var buffer 'flymake-new-err-info) | ||
| 960 | ) | ||
| 961 | (defun flymake-set-buffer-new-err-info(buffer new-err-info) | ||
| 962 | (flymake-set-buffer-var buffer 'flymake-new-err-info new-err-info) | ||
| 963 | ) | ||
| 964 | |||
| 965 | ;; getters/setters for line-err-info: (file, line, type, text). | ||
| 966 | (defun flymake-ler-make-ler(file line type text &optional full-file) | ||
| 967 | (list file line type text full-file) | ||
| 968 | ) | ||
| 969 | (defun flymake-ler-get-file(line-err-info) | ||
| 970 | (nth 0 line-err-info) | ||
| 971 | ) | ||
| 972 | (defun flymake-ler-get-line(line-err-info) | ||
| 973 | (nth 1 line-err-info) | ||
| 974 | ) | ||
| 975 | (defun flymake-ler-get-type(line-err-info) | ||
| 976 | (nth 2 line-err-info) | ||
| 977 | ) | ||
| 978 | (defun flymake-ler-get-text(line-err-info) | ||
| 979 | (nth 3 line-err-info) | ||
| 980 | ) | ||
| 981 | (defun flymake-ler-get-full-file(line-err-info) | ||
| 982 | (nth 4 line-err-info) | ||
| 983 | ) | ||
| 984 | (defun flymake-ler-set-file(line-err-info file) | ||
| 985 | (flymake-ler-make-ler file | ||
| 986 | (flymake-ler-get-line line-err-info) | ||
| 987 | (flymake-ler-get-type line-err-info) | ||
| 988 | (flymake-ler-get-text line-err-info) | ||
| 989 | (flymake-ler-get-full-file line-err-info)) | ||
| 990 | ) | ||
| 991 | (defun flymake-ler-set-full-file(line-err-info full-file) | ||
| 992 | (flymake-ler-make-ler (flymake-ler-get-file line-err-info) | ||
| 993 | (flymake-ler-get-line line-err-info) | ||
| 994 | (flymake-ler-get-type line-err-info) | ||
| 995 | (flymake-ler-get-text line-err-info) | ||
| 996 | full-file) | ||
| 997 | ) | ||
| 998 | (defun flymake-ler-set-line(line-err-info line) | ||
| 999 | (flymake-ler-make-ler (flymake-ler-get-file line-err-info) | ||
| 1000 | line | ||
| 1001 | (flymake-ler-get-type line-err-info) | ||
| 1002 | (flymake-ler-get-text line-err-info) | ||
| 1003 | (flymake-ler-get-full-file line-err-info)) | ||
| 1004 | ) | ||
| 1005 | |||
| 1006 | (defun flymake-get-line-err-count(line-err-info-list type) | ||
| 1007 | "return number of errors of specified type - e or w" | ||
| 1008 | (let* ((idx 0) | ||
| 1009 | (count (length line-err-info-list)) | ||
| 1010 | (err-count 0)) | ||
| 1011 | |||
| 1012 | (while (< idx count) | ||
| 1013 | (when (equal type (flymake-ler-get-type (nth idx line-err-info-list))) | ||
| 1014 | (setq err-count (1+ err-count)) | ||
| 1015 | ) | ||
| 1016 | (setq idx (1+ idx)) | ||
| 1017 | ) | ||
| 1018 | err-count | ||
| 1019 | ) | ||
| 1020 | ) | ||
| 1021 | |||
| 1022 | (defun flymake-get-err-count(err-info-list type) | ||
| 1023 | "return number of errors of specified type for the err-info-list" | ||
| 1024 | (let* ((idx 0) | ||
| 1025 | (count (length err-info-list)) | ||
| 1026 | (err-count 0)) | ||
| 1027 | (while (< idx count) | ||
| 1028 | (setq err-count (+ err-count (flymake-get-line-err-count (nth 1 (nth idx err-info-list)) type))) | ||
| 1029 | (setq idx (1+ idx)) | ||
| 1030 | ) | ||
| 1031 | err-count | ||
| 1032 | ) | ||
| 1033 | ) | ||
| 1034 | |||
| 1035 | (defun flymake-fix-line-numbers(err-info-list min-line max-line) | ||
| 1036 | "replace line-numbers < min-line with min-line and > max-line with max-line - as some compilers might report line number outside the file being compiled" | ||
| 1037 | (let* ((count (length err-info-list)) | ||
| 1038 | (err-info nil) | ||
| 1039 | (line 0)) | ||
| 1040 | (while (> count 0) | ||
| 1041 | (setq err-info (nth (1- count) err-info-list)) | ||
| 1042 | (setq line (flymake-er-get-line err-info)) | ||
| 1043 | (when (or (< line min-line) (> line max-line)) | ||
| 1044 | (setq line (if (< line min-line) min-line max-line)) | ||
| 1045 | (setq err-info-list (flymake-set-at err-info-list (1- count) | ||
| 1046 | (flymake-er-make-er line | ||
| 1047 | (flymake-er-get-line-err-info-list err-info)))) | ||
| 1048 | ) | ||
| 1049 | (setq count (1- count)) | ||
| 1050 | ) | ||
| 1051 | ) | ||
| 1052 | err-info-list | ||
| 1053 | ) | ||
| 1054 | |||
| 1055 | (defun flymake-highlight-err-lines(buffer err-info-list) | ||
| 1056 | "highlight err-lines in buffer using info from err-info-list" | ||
| 1057 | (save-excursion | ||
| 1058 | (set-buffer buffer) | ||
| 1059 | (let* ((idx 0) | ||
| 1060 | (count (length err-info-list))) | ||
| 1061 | (while (< idx count) | ||
| 1062 | (flymake-highlight-line (car (nth idx err-info-list)) (nth 1 (nth idx err-info-list))) | ||
| 1063 | (setq idx (1+ idx)) | ||
| 1064 | ) | ||
| 1065 | ) | ||
| 1066 | ) | ||
| 1067 | ) | ||
| 1068 | |||
| 1069 | (defun flymake-overlay-p(ov) | ||
| 1070 | "Determine whether overlay was created by flymake" | ||
| 1071 | (and (overlayp ov) (overlay-get ov 'flymake-overlay)) | ||
| 1072 | ) | ||
| 1073 | |||
| 1074 | (defun flymake-make-overlay(beg end tooltip-text face mouse-face) | ||
| 1075 | "Allocate a flymake overlay in range beg end" | ||
| 1076 | (when (not (flymake-region-has-flymake-overlays beg end)) | ||
| 1077 | (let ((ov (make-overlay beg end nil t t))) | ||
| 1078 | (overlay-put ov 'face face) | ||
| 1079 | (overlay-put ov 'mouse-face mouse-face) | ||
| 1080 | (overlay-put ov 'help-echo tooltip-text) | ||
| 1081 | (overlay-put ov 'flymake-overlay t) | ||
| 1082 | (overlay-put ov 'priority 100) | ||
| 1083 | ;+(flymake-log 3 "created overlay %s" ov) | ||
| 1084 | ov | ||
| 1085 | ) | ||
| 1086 | (flymake-log 3 "created an overlay at (%d-%d)" beg end) | ||
| 1087 | ) | ||
| 1088 | ) | ||
| 1089 | |||
| 1090 | (defun flymake-delete-own-overlays(buffer) | ||
| 1091 | "Delete all flymake overlays in buffer" | ||
| 1092 | (save-excursion | ||
| 1093 | (set-buffer buffer) | ||
| 1094 | (let ((ov (overlays-in (point-min) (point-max)))) | ||
| 1095 | (while (consp ov) | ||
| 1096 | (when (flymake-overlay-p (car ov)) | ||
| 1097 | (delete-overlay (car ov)) | ||
| 1098 | ;+(flymake-log 3 "deleted overlay %s" ov) | ||
| 1099 | ) | ||
| 1100 | (setq ov (cdr ov)) | ||
| 1101 | ) | ||
| 1102 | ) | ||
| 1103 | ) | ||
| 1104 | ) | ||
| 1105 | |||
| 1106 | (defun flymake-region-has-flymake-overlays(beg end) | ||
| 1107 | "t if specified regions has at least one flymake overlay, nil otrherwise" | ||
| 1108 | (let ((ov (overlays-in beg end)) | ||
| 1109 | (has-flymake-overlays nil)) | ||
| 1110 | (while (consp ov) | ||
| 1111 | (when (flymake-overlay-p (car ov)) | ||
| 1112 | (setq has-flymake-overlays t) | ||
| 1113 | ) | ||
| 1114 | (setq ov (cdr ov)) | ||
| 1115 | ) | ||
| 1116 | ) | ||
| 1117 | ) | ||
| 1118 | |||
| 1119 | (defface flymake-errline-face | ||
| 1120 | ;+ '((((class color)) (:foreground "OrangeRed" :bold t :underline t)) | ||
| 1121 | ;+ '((((class color)) (:underline "OrangeRed")) | ||
| 1122 | '((((class color)) (:background "LightPink")) | ||
| 1123 | (t (:bold t))) | ||
| 1124 | "Face used for marking error lines" | ||
| 1125 | :group 'flymake | ||
| 1126 | ) | ||
| 1127 | |||
| 1128 | (defface flymake-warnline-face | ||
| 1129 | '((((class color)) (:background "LightBlue2")) | ||
| 1130 | (t (:bold t))) | ||
| 1131 | "Face used for marking warning lines" | ||
| 1132 | :group 'flymake | ||
| 1133 | ) | ||
| 1134 | |||
| 1135 | |||
| 1136 | (defun flymake-highlight-line(line-no line-err-info-list) | ||
| 1137 | "highlight line line-no in current buffer, perhaps use text from line-err-info-list to enhance highlighting" | ||
| 1138 | (goto-line line-no) | ||
| 1139 | (let* ((line-beg (flymake-line-beginning-position)) | ||
| 1140 | (line-end (flymake-line-end-position)) | ||
| 1141 | (beg line-beg) | ||
| 1142 | (end line-end) | ||
| 1143 | (tooltip-text (flymake-ler-get-text (nth 0 line-err-info-list))) | ||
| 1144 | (face nil)) | ||
| 1145 | |||
| 1146 | (goto-char line-beg) | ||
| 1147 | (while (looking-at "[ \t]") | ||
| 1148 | (forward-char) | ||
| 1149 | ) | ||
| 1150 | |||
| 1151 | (setq beg (point)) | ||
| 1152 | |||
| 1153 | (goto-char line-end) | ||
| 1154 | (while (and (looking-at "[ \t\r\n]") (> (point) 1)) | ||
| 1155 | (backward-char) | ||
| 1156 | ) | ||
| 1157 | |||
| 1158 | (setq end (1+ (point))) | ||
| 1159 | |||
| 1160 | (when (<= end beg) | ||
| 1161 | (setq beg line-beg) | ||
| 1162 | (setq end line-end) | ||
| 1163 | ) | ||
| 1164 | (when (= end beg) | ||
| 1165 | (goto-char end) | ||
| 1166 | (forward-line) | ||
| 1167 | (setq end (point)) | ||
| 1168 | ) | ||
| 1169 | (if (> (flymake-get-line-err-count line-err-info-list "e") 0) | ||
| 1170 | (setq face 'flymake-errline-face) | ||
| 1171 | ;else | ||
| 1172 | (setq face 'flymake-warnline-face) | ||
| 1173 | ) | ||
| 1174 | (flymake-make-overlay beg end tooltip-text face nil) | ||
| 1175 | ) | ||
| 1176 | ) | ||
| 1177 | |||
| 1178 | (defun flymake-parse-err-lines(err-info-list source-buffer lines) | ||
| 1179 | "parse err lines, store info in err-info-list" | ||
| 1180 | (let* ((count (length lines)) | ||
| 1181 | (idx 0) | ||
| 1182 | (line-err-info nil) | ||
| 1183 | (real-file-name nil) | ||
| 1184 | (source-file-name (buffer-file-name source-buffer)) | ||
| 1185 | (get-real-file-name-f (flymake-get-real-file-name-function source-file-name))) | ||
| 1186 | |||
| 1187 | (while (< idx count) | ||
| 1188 | (setq line-err-info (flymake-parse-line (nth idx lines))) | ||
| 1189 | (when line-err-info | ||
| 1190 | (setq real-file-name (funcall get-real-file-name-f source-buffer (flymake-ler-get-file line-err-info))) | ||
| 1191 | (setq line-err-info (flymake-ler-set-full-file line-err-info real-file-name)) | ||
| 1192 | |||
| 1193 | (if (flymake-same-files real-file-name source-file-name) | ||
| 1194 | (setq line-err-info (flymake-ler-set-file line-err-info nil)) | ||
| 1195 | ;else | ||
| 1196 | (setq line-err-info (flymake-ler-set-file line-err-info (file-name-nondirectory real-file-name))) | ||
| 1197 | ) | ||
| 1198 | |||
| 1199 | (setq err-info-list (flymake-add-err-info err-info-list line-err-info)) | ||
| 1200 | ) | ||
| 1201 | (flymake-log 3 "parsed '%s', %s line-err-info" (nth idx lines) (if line-err-info "got" "no")) | ||
| 1202 | (setq idx (1+ idx)) | ||
| 1203 | ) | ||
| 1204 | err-info-list | ||
| 1205 | ) | ||
| 1206 | ) | ||
| 1207 | |||
| 1208 | (defun flymake-split-output(output) | ||
| 1209 | "split output into lines, return last one as residual if it does not end with newline char. Returns ((lines) residual)" | ||
| 1210 | (when (and output (> (length output) 0)) | ||
| 1211 | (let* ((lines (flymake-split-string output "[\n\r]+")) | ||
| 1212 | (complete (equal "\n" (char-to-string (aref output (1- (length output)))))) | ||
| 1213 | (residual nil)) | ||
| 1214 | (when (not complete) | ||
| 1215 | (setq residual (car (last lines))) | ||
| 1216 | (setq lines (butlast lines)) | ||
| 1217 | ) | ||
| 1218 | (list lines residual) | ||
| 1219 | ) | ||
| 1220 | ) | ||
| 1221 | ) | ||
| 1222 | |||
| 1223 | (eval-when-compile (require 'compile)) | ||
| 1224 | (defvar flymake-err-line-patterns ; regexp file-idx line-idx col-idx (optional) text-idx(optional), match-end to end of string is error text | ||
| 1225 | (append | ||
| 1226 | '( | ||
| 1227 | ; MS Visual C++ 6.0 | ||
| 1228 | ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \: \\(\\(error\\|warning\\|fatal error\\) \\(C[0-9]+\\):[ \t\n]*\\(.+\\)\\)" | ||
| 1229 | 1 3 nil 4) | ||
| 1230 | ; jikes | ||
| 1231 | ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)\:\\([0-9]+\\)\:[0-9]+\:[0-9]+\:[0-9]+\: \\(\\(Error\\|Warning\\|Caution\\|Semantic Error\\):[ \t\n]*\\(.+\\)\\)" | ||
| 1232 | 1 3 nil 4) | ||
| 1233 | ; MS midl | ||
| 1234 | ("midl[ ]*:[ ]*\\(command line error .*\\)" | ||
| 1235 | nil nil nil 1) | ||
| 1236 | ; MS C# | ||
| 1237 | ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\),[0-9]+)\: \\(\\(error\\|warning\\|fatal error\\) \\(CS[0-9]+\\):[ \t\n]*\\(.+\\)\\)" | ||
| 1238 | 1 3 nil 4) | ||
| 1239 | ; perl | ||
| 1240 | ("\\(.*\\) at \\([^ \n]+\\) line \\([0-9]+\\)[,.\n]" 2 3 nil 1) | ||
| 1241 | ; LaTeX warnings (fileless) ("\\(LaTeX \\(Warning\\|Error\\): .*\\) on input line \\([0-9]+\\)" 20 3 nil 1) | ||
| 1242 | ; ant/javac | ||
| 1243 | (" *\\(\\[javac\\]\\)? *\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)\:\\([0-9]+\\)\:[ \t\n]*\\(.+\\)" | ||
| 1244 | 2 4 nil 5) | ||
| 1245 | ) | ||
| 1246 | compilation-error-regexp-alist) | ||
| 1247 | "patterns for matching error/warning lines, (regexp file-idx line-idx err-text-idx)" | ||
| 1248 | ) | ||
| 1249 | ;(defcustom flymake-err-line-patterns | ||
| 1250 | ; '( | ||
| 1251 | ; ; MS Visual C++ 6.0 | ||
| 1252 | ; ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \: \\(\\(error\\|warning\\|fatal error\\) \\(C[0-9]+\\):[ \t\n]*\\(.+\\)\\)" | ||
| 1253 | ; 1 3 4) | ||
| 1254 | ; ; jikes | ||
| 1255 | ; ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)\:\\([0-9]+\\)\:[0-9]+\:[0-9]+\:[0-9]+\: \\(\\(Error\\|Warning\\|Caution\\):[ \t\n]*\\(.+\\)\\)" | ||
| 1256 | ; 1 3 4)) | ||
| 1257 | ; "patterns for matching error/warning lines, (regexp file-idx line-idx err-text-idx)" | ||
| 1258 | ; :group 'flymake | ||
| 1259 | ; :type '(repeat (string number number number)) | ||
| 1260 | ;) | ||
| 1261 | |||
| 1262 | (defun flymake-parse-line(line) | ||
| 1263 | "parse line to see whether it's an error of warning, return it's components or nil for no match" | ||
| 1264 | (let ((raw-file-name nil) | ||
| 1265 | (line-no 0) | ||
| 1266 | (err-type "e") | ||
| 1267 | (err-text nil) | ||
| 1268 | (count (length flymake-err-line-patterns)) | ||
| 1269 | (idx 0) | ||
| 1270 | (matched nil)) | ||
| 1271 | (while (and (< idx count) (not matched)) | ||
| 1272 | (when (string-match (car (nth idx flymake-err-line-patterns)) line) | ||
| 1273 | (let* ((file-idx (nth 1 (nth idx flymake-err-line-patterns))) | ||
| 1274 | (line-idx (nth 2 (nth idx flymake-err-line-patterns)))) | ||
| 1275 | |||
| 1276 | (setq raw-file-name (if file-idx (match-string file-idx line) nil)) | ||
| 1277 | (setq line-no (if line-idx (string-to-int (match-string line-idx line)) 0)) | ||
| 1278 | (setq err-text (if (> (length (nth idx flymake-err-line-patterns)) 4) | ||
| 1279 | (match-string (nth 4 (nth idx flymake-err-line-patterns)) line) | ||
| 1280 | (flymake-patch-err-text (substring line (match-end 0))))) | ||
| 1281 | (or err-text (setq err-text "<no error text>")) | ||
| 1282 | (if (and err-text (string-match "^[wW]arning" err-text)) | ||
| 1283 | (setq err-type "w") | ||
| 1284 | ) | ||
| 1285 | (flymake-log 3 "parse line: file-idx=%s line-idx=%s file=%s line=%s text=%s" file-idx line-idx | ||
| 1286 | raw-file-name line-no err-text) | ||
| 1287 | (setq matched t) | ||
| 1288 | ) | ||
| 1289 | ) | ||
| 1290 | (setq idx (1+ idx)) | ||
| 1291 | ) | ||
| 1292 | (if matched | ||
| 1293 | (flymake-ler-make-ler raw-file-name line-no err-type err-text) | ||
| 1294 | ; else | ||
| 1295 | () | ||
| 1296 | ) | ||
| 1297 | ) | ||
| 1298 | ) | ||
| 1299 | |||
| 1300 | (defun flymake-find-err-info(err-info-list line-no) | ||
| 1301 | "find (line-err-info-list pos) for specified line-no" | ||
| 1302 | (if err-info-list | ||
| 1303 | (let* ((line-err-info-list nil) | ||
| 1304 | (pos 0) | ||
| 1305 | (count (length err-info-list))) | ||
| 1306 | |||
| 1307 | (while (and (< pos count) (< (car (nth pos err-info-list)) line-no)) | ||
| 1308 | (setq pos (1+ pos)) | ||
| 1309 | ) | ||
| 1310 | (when (and (< pos count) (equal (car (nth pos err-info-list)) line-no)) | ||
| 1311 | (setq line-err-info-list (flymake-er-get-line-err-info-list (nth pos err-info-list))) | ||
| 1312 | ) | ||
| 1313 | (list line-err-info-list pos) | ||
| 1314 | ) | ||
| 1315 | ;else | ||
| 1316 | '(nil 0) | ||
| 1317 | ) | ||
| 1318 | ) | ||
| 1319 | |||
| 1320 | (defun flymake-line-err-info-is-less-or-equal(line-one line-two) | ||
| 1321 | (or (string< (flymake-ler-get-type line-one) (flymake-ler-get-type line-two)) | ||
| 1322 | (and (string= (flymake-ler-get-type line-one) (flymake-ler-get-type line-two)) | ||
| 1323 | (not (flymake-ler-get-file line-one)) (flymake-ler-get-file line-two) | ||
| 1324 | ) | ||
| 1325 | (and (string= (flymake-ler-get-type line-one) (flymake-ler-get-type line-two)) | ||
| 1326 | (or (and (flymake-ler-get-file line-one) (flymake-ler-get-file line-two)) | ||
| 1327 | (and (not (flymake-ler-get-file line-one)) (not (flymake-ler-get-file line-two))) | ||
| 1328 | ) | ||
| 1329 | ) | ||
| 1330 | ) | ||
| 1331 | ) | ||
| 1332 | |||
| 1333 | (defun flymake-add-line-err-info(line-err-info-list line-err-info) | ||
| 1334 | "insert new err info favoring sorting: err-type e/w, filename nil/non-nill" | ||
| 1335 | (if (not line-err-info-list) | ||
| 1336 | (list line-err-info) | ||
| 1337 | ;else | ||
| 1338 | (let* ((count (length line-err-info-list)) | ||
| 1339 | (idx 0)) | ||
| 1340 | (while (and (< idx count) (flymake-line-err-info-is-less-or-equal (nth idx line-err-info-list) line-err-info)) | ||
| 1341 | (setq idx (1+ idx)) | ||
| 1342 | ) | ||
| 1343 | (cond ((equal 0 idx) (setq line-err-info-list (cons line-err-info line-err-info-list))) | ||
| 1344 | (t (setq line-err-info-list (flymake-ins-after line-err-info-list (1- idx) line-err-info))) | ||
| 1345 | ) | ||
| 1346 | line-err-info-list | ||
| 1347 | ) | ||
| 1348 | ) | ||
| 1349 | ) | ||
| 1350 | |||
| 1351 | (defun flymake-add-err-info(err-info-list line-err-info) | ||
| 1352 | "add error info (file line type text) to err info list preserving sort order" | ||
| 1353 | (let* ((count (length err-info-list)) | ||
| 1354 | (line-no (if (flymake-ler-get-file line-err-info) 1 (flymake-ler-get-line line-err-info))) | ||
| 1355 | (info-and-pos (flymake-find-err-info err-info-list line-no)) | ||
| 1356 | (exists (car info-and-pos)) | ||
| 1357 | (pos (nth 1 info-and-pos)) | ||
| 1358 | (line-err-info-list nil) | ||
| 1359 | (err-info nil)) | ||
| 1360 | |||
| 1361 | (if exists | ||
| 1362 | (setq line-err-info-list (flymake-er-get-line-err-info-list (car (nthcdr pos err-info-list)))) | ||
| 1363 | ) | ||
| 1364 | (setq line-err-info-list (flymake-add-line-err-info line-err-info-list line-err-info)) | ||
| 1365 | |||
| 1366 | (setq err-info (flymake-er-make-er line-no line-err-info-list)) | ||
| 1367 | (cond (exists (setq err-info-list (flymake-set-at err-info-list pos err-info))) | ||
| 1368 | ((equal 0 pos) (setq err-info-list (cons err-info err-info-list))) | ||
| 1369 | (t (setq err-info-list (flymake-ins-after err-info-list (1- pos) err-info))) | ||
| 1370 | ) | ||
| 1371 | err-info-list | ||
| 1372 | ) | ||
| 1373 | ) | ||
| 1374 | |||
| 1375 | (defun flymake-get-project-include-dirs-imp(basedir) | ||
| 1376 | "include dirs for the project current file belongs to" | ||
| 1377 | (if (flymake-get-project-include-dirs-from-cache basedir) | ||
| 1378 | (progn | ||
| 1379 | (flymake-get-project-include-dirs-from-cache basedir) | ||
| 1380 | ) | ||
| 1381 | ;else | ||
| 1382 | (let* ((command-line (concat "make -C\"" basedir "\" DUMPVARS=INCLUDE_DIRS dumpvars")) | ||
| 1383 | (output (shell-command-to-string command-line)) | ||
| 1384 | (lines (flymake-split-string output "\n")) | ||
| 1385 | (count (length lines)) | ||
| 1386 | (idx 0) | ||
| 1387 | (inc-dirs nil)) | ||
| 1388 | (while (and (< idx count) (not (string-match "^INCLUDE_DIRS=.*" (nth idx lines)))) | ||
| 1389 | (setq idx (1+ idx)) | ||
| 1390 | ) | ||
| 1391 | (when (< idx count) | ||
| 1392 | (let* ((inc-lines (flymake-split-string (nth idx lines) " *-I")) | ||
| 1393 | (inc-count (length inc-lines))) | ||
| 1394 | (while (> inc-count 0) | ||
| 1395 | (when (not (string-match "^INCLUDE_DIRS=.*" (nth (1- inc-count) inc-lines))) | ||
| 1396 | (setq inc-dirs (cons (flymake-replace-regexp-in-string "\"" "" (nth (1- inc-count) inc-lines)) inc-dirs)) | ||
| 1397 | ) | ||
| 1398 | (setq inc-count (1- inc-count)) | ||
| 1399 | ) | ||
| 1400 | ) | ||
| 1401 | ) | ||
| 1402 | (flymake-add-project-include-dirs-to-cache basedir inc-dirs) | ||
| 1403 | inc-dirs | ||
| 1404 | ) | ||
| 1405 | ) | ||
| 1406 | ) | ||
| 1407 | |||
| 1408 | (defcustom flymake-get-project-include-dirs-function 'flymake-get-project-include-dirs-imp | ||
| 1409 | "function used to get project inc dirs, one paramater: basedir name" | ||
| 1410 | :group 'flymake | ||
| 1411 | :type 'function | ||
| 1412 | ) | ||
| 1413 | |||
| 1414 | (defun flymake-get-project-include-dirs(basedir) | ||
| 1415 | (funcall flymake-get-project-include-dirs-function basedir) | ||
| 1416 | ) | ||
| 1417 | |||
| 1418 | (defun flymake-get-system-include-dirs() | ||
| 1419 | "system include dirs - from the 'INCLUDE' env setting" | ||
| 1420 | (let* ((includes (getenv "INCLUDE"))) | ||
| 1421 | (if includes (flymake-split-string includes path-separator) nil) | ||
| 1422 | ) | ||
| 1423 | ) | ||
| 1424 | |||
| 1425 | (defvar flymake-project-include-dirs-cache (flymake-makehash 'equal)) | ||
| 1426 | (defun flymake-get-project-include-dirs-from-cache(base-dir) | ||
| 1427 | (gethash base-dir flymake-project-include-dirs-cache) | ||
| 1428 | ) | ||
| 1429 | (defun flymake-add-project-include-dirs-to-cache(base-dir include-dirs) | ||
| 1430 | (puthash base-dir include-dirs flymake-project-include-dirs-cache) | ||
| 1431 | ) | ||
| 1432 | (defun flymake-clear-project-include-dirs-cache() | ||
| 1433 | (clrhash flymake-project-include-dirs-cache) | ||
| 1434 | ) | ||
| 1435 | |||
| 1436 | (defun flymake-get-include-dirs(base-dir) | ||
| 1437 | "dirs to use when resolving local filenames" | ||
| 1438 | (let* ((include-dirs (append '(".") (flymake-get-project-include-dirs base-dir) (flymake-get-system-include-dirs)))) | ||
| 1439 | include-dirs | ||
| 1440 | ) | ||
| 1441 | ) | ||
| 1442 | |||
| 1443 | (defun flymake-find-file(rel-file-name include-dirs) | ||
| 1444 | "iterate through include-dirs, return first 'include-dir/rel-file-name' that exists, or just rel-file-name if not" | ||
| 1445 | (let* ((count (length include-dirs)) | ||
| 1446 | (idx 0) | ||
| 1447 | (found nil) | ||
| 1448 | (full-file-name rel-file-name)) | ||
| 1449 | |||
| 1450 | (while (and (not found) (< idx count)) | ||
| 1451 | (let* ((dir (nth idx include-dirs))) | ||
| 1452 | (setq full-file-name (concat dir "/" rel-file-name)) | ||
| 1453 | (when (file-exists-p full-file-name) | ||
| 1454 | (setq done t) | ||
| 1455 | ) | ||
| 1456 | ) | ||
| 1457 | (setq idx (1+ idx)) | ||
| 1458 | ) | ||
| 1459 | (if found | ||
| 1460 | full-file-name | ||
| 1461 | ;else | ||
| 1462 | rel-file-name | ||
| 1463 | ) | ||
| 1464 | ) | ||
| 1465 | ) | ||
| 1466 | |||
| 1467 | (defun flymake-restore-formatting(source-buffer) | ||
| 1468 | "Remove any formatting made by flymake" | ||
| 1469 | ) | ||
| 1470 | |||
| 1471 | (defun flymake-get-program-dir(buffer) | ||
| 1472 | "dir to start profram in" | ||
| 1473 | (unless (bufferp buffer) | ||
| 1474 | (error "invlid buffer") | ||
| 1475 | ) | ||
| 1476 | (save-excursion | ||
| 1477 | (set-buffer buffer) | ||
| 1478 | default-directory | ||
| 1479 | ) | ||
| 1480 | ) | ||
| 1481 | |||
| 1482 | (defun flymake-safe-delete-file(file-name) | ||
| 1483 | (when (and file-name (file-exists-p file-name)) | ||
| 1484 | (delete-file file-name) | ||
| 1485 | (flymake-log 1 "deleted file %s" file-name) | ||
| 1486 | ) | ||
| 1487 | ) | ||
| 1488 | |||
| 1489 | (defun flymake-safe-delete-directory(dir-name) | ||
| 1490 | (condition-case err | ||
| 1491 | (progn | ||
| 1492 | (delete-directory dir-name) | ||
| 1493 | (flymake-log 1 "deleted dir %s" dir-name) | ||
| 1494 | ) | ||
| 1495 | (error | ||
| 1496 | (flymake-log 1 "failed to delete dir %s, error ignored" dir-name) | ||
| 1497 | ) | ||
| 1498 | ) | ||
| 1499 | ) | ||
| 1500 | |||
| 1501 | (defcustom flymake-compilation-prevents-syntax-check t | ||
| 1502 | "if non-nil, syntax check won't be started in case compilation is running" | ||
| 1503 | :group 'flymake | ||
| 1504 | :type 'boolean | ||
| 1505 | ) | ||
| 1506 | |||
| 1507 | (defun flymake-start-syntax-check(buffer) | ||
| 1508 | "start syntax checking for buffer" | ||
| 1509 | (unless (bufferp buffer) | ||
| 1510 | (error "expected a buffer") | ||
| 1511 | ) | ||
| 1512 | (save-excursion | ||
| 1513 | (set-buffer buffer) | ||
| 1514 | (flymake-log 3 "flymake is running: %s" (flymake-get-buffer-is-running buffer)) | ||
| 1515 | (when (and (not (flymake-get-buffer-is-running buffer)) | ||
| 1516 | (flymake-can-syntax-check-file (buffer-file-name buffer))) | ||
| 1517 | (when (or (not flymake-compilation-prevents-syntax-check) | ||
| 1518 | (not (flymake-compilation-is-running))) ;+ (flymake-rep-ort-status buffer "COMP") | ||
| 1519 | (flymake-clear-buildfile-cache) | ||
| 1520 | (flymake-clear-project-include-dirs-cache) | ||
| 1521 | |||
| 1522 | (flymake-set-buffer-check-was-interrupted buffer nil) | ||
| 1523 | (flymake-set-buffer-data buffer (flymake-makehash 'equal)) | ||
| 1524 | |||
| 1525 | (let* ((source-file-name (buffer-file-name buffer)) | ||
| 1526 | (init-f (flymake-get-init-function source-file-name)) | ||
| 1527 | (cleanup-f (flymake-get-cleanup-function source-file-name)) | ||
| 1528 | (cmd-and-args (funcall init-f buffer)) | ||
| 1529 | (cmd (nth 0 cmd-and-args)) | ||
| 1530 | (args (nth 1 cmd-and-args)) | ||
| 1531 | (dir (nth 2 cmd-and-args))) | ||
| 1532 | (if (not cmd-and-args) | ||
| 1533 | (progn | ||
| 1534 | (flymake-log 0 "init function %s for %s failed, cleaning up" init-f source-file-name) | ||
| 1535 | (funcall cleanup-f buffer) | ||
| 1536 | ) | ||
| 1537 | ;else | ||
| 1538 | (progn | ||
| 1539 | (flymake-set-buffer-last-change-time buffer nil) | ||
| 1540 | (flymake-start-syntax-check-process buffer cmd args dir) | ||
| 1541 | ) | ||
| 1542 | ) | ||
| 1543 | ) | ||
| 1544 | ) | ||
| 1545 | ) | ||
| 1546 | ) | ||
| 1547 | ) | ||
| 1548 | |||
| 1549 | (defun flymake-start-syntax-check-process(buffer cmd args dir) | ||
| 1550 | "start syntax check-process" | ||
| 1551 | |||
| 1552 | (let* ((process nil)) | ||
| 1553 | (condition-case err | ||
| 1554 | (progn | ||
| 1555 | (when dir | ||
| 1556 | (let ((default-directory dir)) | ||
| 1557 | (flymake-log 3 "starting process on dir %s" default-directory) | ||
| 1558 | ) | ||
| 1559 | ) | ||
| 1560 | (setq process (get-process (apply 'start-process "flymake-proc" nil cmd args))) | ||
| 1561 | (set-process-sentinel process 'flymake-process-sentinel) | ||
| 1562 | (set-process-filter process 'flymake-process-filter) | ||
| 1563 | |||
| 1564 | (flymake-reg-names (process-id process) (buffer-name buffer)) | ||
| 1565 | |||
| 1566 | (flymake-set-buffer-is-running buffer t) | ||
| 1567 | (flymake-set-buffer-last-change-time buffer nil) | ||
| 1568 | (flymake-set-buffer-check-start-time buffer (flymake-float-time)) | ||
| 1569 | |||
| 1570 | (flymake-report-status buffer nil "*") | ||
| 1571 | (flymake-log 2 "started process %d, command=%s, dir=%s" | ||
| 1572 | (process-id process) (process-command process) default-directory) | ||
| 1573 | process | ||
| 1574 | ) | ||
| 1575 | (error | ||
| 1576 | (let ((err-str (format "Failed to launch syntax check process '%s' with args %s: %s" | ||
| 1577 | cmd args (error-message-string err))) | ||
| 1578 | (source-file-name (buffer-file-name buffer)) | ||
| 1579 | (cleanup-f (flymake-get-cleanup-function source-file-name))) | ||
| 1580 | (flymake-log 0 err-str) | ||
| 1581 | (funcall cleanup-f buffer) | ||
| 1582 | (flymake-report-fatal-status buffer "PROCERR" err-str) | ||
| 1583 | ) | ||
| 1584 | ) | ||
| 1585 | ) | ||
| 1586 | ) | ||
| 1587 | ) | ||
| 1588 | |||
| 1589 | (defun flymake-kill-process(pid &optional rest) | ||
| 1590 | "kill process pid" | ||
| 1591 | (signal-process pid 9) | ||
| 1592 | (let* ((buffer-name (flymake-get-source-buffer-name pid))) | ||
| 1593 | (when (and buffer-name (get-buffer buffer-name)) | ||
| 1594 | (flymake-set-buffer-check-was-interrupted (get-buffer buffer-name) t) | ||
| 1595 | ) | ||
| 1596 | ) | ||
| 1597 | (flymake-log 1 "killed process %d" pid) | ||
| 1598 | ) | ||
| 1599 | |||
| 1600 | (defun flymake-stop-all-syntax-checks() | ||
| 1601 | "kill all syntax check processes" | ||
| 1602 | (interactive) | ||
| 1603 | (let ((pids (copy-hash-table flymake-pid-to-names))) | ||
| 1604 | (maphash 'flymake-kill-process pids) | ||
| 1605 | ) | ||
| 1606 | ) | ||
| 1607 | |||
| 1608 | (defun flymake-compilation-is-running() | ||
| 1609 | (and (boundp 'compilation-in-progress) | ||
| 1610 | compilation-in-progress) | ||
| 1611 | ) | ||
| 1612 | |||
| 1613 | (defun flymake-compile() | ||
| 1614 | "kill all flymake syntax checks, start compilation" | ||
| 1615 | (interactive) | ||
| 1616 | (flymake-stop-all-syntax-checks) | ||
| 1617 | (call-interactively 'compile) | ||
| 1618 | ) | ||
| 1619 | |||
| 1620 | (defvar flymake-is-running nil | ||
| 1621 | "t if flymake syntax check process is running for the current buffer" | ||
| 1622 | ) | ||
| 1623 | (make-variable-buffer-local 'flymake-is-running) | ||
| 1624 | (defun flymake-get-buffer-is-running(buffer) | ||
| 1625 | (flymake-get-buffer-var buffer 'flymake-is-running) | ||
| 1626 | ) | ||
| 1627 | (defun flymake-set-buffer-is-running(buffer is-running) | ||
| 1628 | (flymake-set-buffer-var buffer 'flymake-is-running is-running) | ||
| 1629 | ) | ||
| 1630 | |||
| 1631 | (defvar flymake-timer nil | ||
| 1632 | "timer for starting syntax checks" | ||
| 1633 | ) | ||
| 1634 | (make-variable-buffer-local 'flymake-timer) | ||
| 1635 | (defun flymake-get-buffer-timer(buffer) | ||
| 1636 | (flymake-get-buffer-var buffer 'flymake-timer) | ||
| 1637 | ) | ||
| 1638 | (defun flymake-set-buffer-timer(buffer timer) | ||
| 1639 | (flymake-set-buffer-var buffer 'flymake-timer timer) | ||
| 1640 | ) | ||
| 1641 | |||
| 1642 | (defvar flymake-last-change-time nil | ||
| 1643 | "time of last buffer change" | ||
| 1644 | ) | ||
| 1645 | (make-variable-buffer-local 'flymake-last-change-time) | ||
| 1646 | (defun flymake-get-buffer-last-change-time(buffer) | ||
| 1647 | (flymake-get-buffer-var buffer 'flymake-last-change-time) | ||
| 1648 | ) | ||
| 1649 | (defun flymake-set-buffer-last-change-time(buffer change-time) | ||
| 1650 | (flymake-set-buffer-var buffer 'flymake-last-change-time change-time) | ||
| 1651 | ) | ||
| 1652 | |||
| 1653 | (defvar flymake-check-start-time nil | ||
| 1654 | "time at which syntax check was started") | ||
| 1655 | (make-variable-buffer-local 'flymake-check-start-time) | ||
| 1656 | (defun flymake-get-buffer-check-start-time(buffer) | ||
| 1657 | (flymake-get-buffer-var buffer 'flymake-check-start-time) | ||
| 1658 | ) | ||
| 1659 | (defun flymake-set-buffer-check-start-time(buffer check-start-time) | ||
| 1660 | (flymake-set-buffer-var buffer 'flymake-check-start-time check-start-time) | ||
| 1661 | ) | ||
| 1662 | |||
| 1663 | (defvar flymake-check-was-interrupted nil | ||
| 1664 | "t if syntax check was killed by flymake-compile" | ||
| 1665 | ) | ||
| 1666 | (make-variable-buffer-local 'flymake-check-was-interrupted) | ||
| 1667 | (defun flymake-get-buffer-check-was-interrupted(buffer) | ||
| 1668 | (flymake-get-buffer-var buffer 'flymake-check-was-interrupted) | ||
| 1669 | ) | ||
| 1670 | (defun flymake-set-buffer-check-was-interrupted(buffer interrupted) | ||
| 1671 | (flymake-set-buffer-var buffer 'flymake-check-was-interrupted interrupted) | ||
| 1672 | ) | ||
| 1673 | |||
| 1674 | (defcustom flymake-no-changes-timeout 0.5 | ||
| 1675 | "time to wait after last change before starting compilation" | ||
| 1676 | :group 'flymake | ||
| 1677 | :type 'number | ||
| 1678 | ) | ||
| 1679 | |||
| 1680 | (defun flymake-on-timer-event(buffer) | ||
| 1681 | "start a syntax check for buffer if necessary" | ||
| 1682 | ;+(flymake-log 3 "timer: running=%s, time=%s, cur-time=%s" (flymake-get-buffer-is-running buffer) (flymake-get-buffer-last-change-time buffer) (flymake-float-time)) | ||
| 1683 | |||
| 1684 | (when (and (bufferp buffer) (not (flymake-get-buffer-is-running buffer))) | ||
| 1685 | (save-excursion | ||
| 1686 | (set-buffer buffer) | ||
| 1687 | (when (and (flymake-get-buffer-last-change-time buffer) | ||
| 1688 | (> (flymake-float-time) (+ flymake-no-changes-timeout (flymake-get-buffer-last-change-time buffer)))) | ||
| 1689 | (flymake-set-buffer-last-change-time buffer nil) | ||
| 1690 | (flymake-log 3 "starting syntax check as more than 1 second passed since last change") | ||
| 1691 | (flymake-start-syntax-check buffer) | ||
| 1692 | ) | ||
| 1693 | ) | ||
| 1694 | ) | ||
| 1695 | ) | ||
| 1696 | |||
| 1697 | (defun flymake-start-syntax-check-for-current-buffer() | ||
| 1698 | "run flymake-start-syntax-check for current buffer if it isn't already running" | ||
| 1699 | (interactive) | ||
| 1700 | (flymake-start-syntax-check (current-buffer)) | ||
| 1701 | ) | ||
| 1702 | |||
| 1703 | (defun flymake-current-line-no() | ||
| 1704 | "return number of current line in current buffer" | ||
| 1705 | (interactive) | ||
| 1706 | (let ((beg (point-min)) | ||
| 1707 | (end (if (= (point) (point-max)) (point) (1+ (point))))) | ||
| 1708 | (count-lines beg end) | ||
| 1709 | ) | ||
| 1710 | ) | ||
| 1711 | |||
| 1712 | (defun flymake-get-line-count(buffer) | ||
| 1713 | "return number of lines in buffer" | ||
| 1714 | (unless (bufferp buffer) | ||
| 1715 | (error "invalid buffer") | ||
| 1716 | ) | ||
| 1717 | (save-excursion | ||
| 1718 | (set-buffer buffer) | ||
| 1719 | (count-lines (point-min) (point-max)) | ||
| 1720 | ) | ||
| 1721 | ) | ||
| 1722 | |||
| 1723 | (defun flymake-count-lines(buffer) | ||
| 1724 | "return number of lines in buffer" | ||
| 1725 | (save-excursion | ||
| 1726 | (set-buffer buffer) | ||
| 1727 | (count-lines (point-min) (point-max)) | ||
| 1728 | ) | ||
| 1729 | ) | ||
| 1730 | |||
| 1731 | (defun flymake-get-point-pixel-pos() | ||
| 1732 | "return point position in pixels: (x, y)" | ||
| 1733 | (let ((mouse-pos (mouse-position)) | ||
| 1734 | (pixel-pos nil) | ||
| 1735 | (ret nil)) | ||
| 1736 | (if (car (cdr mouse-pos)) | ||
| 1737 | (progn | ||
| 1738 | (set-mouse-position (flymake-selected-frame) (current-column) (flymake-current-row)) | ||
| 1739 | (setq pixel-pos (mouse-pixel-position)) | ||
| 1740 | (set-mouse-position (car mouse-pos) (car (cdr mouse-pos)) (cdr (cdr mouse-pos))) | ||
| 1741 | (setq ret (list (car (cdr pixel-pos)) (cdr (cdr pixel-pos)))) | ||
| 1742 | ) | ||
| 1743 | ;else | ||
| 1744 | (progn | ||
| 1745 | (setq ret '(0 0)) | ||
| 1746 | ) | ||
| 1747 | ) | ||
| 1748 | (flymake-log 3 "mouse pos is %s" ret) | ||
| 1749 | ret | ||
| 1750 | ) | ||
| 1751 | ) | ||
| 1752 | |||
| 1753 | (defun flymake-display-err-menu-for-current-line() | ||
| 1754 | "Display a menu with errors/warnings for current line if it has errors and/or warnings" | ||
| 1755 | (interactive) | ||
| 1756 | (let* ((line-no (flymake-current-line-no)) | ||
| 1757 | (line-err-info-list (nth 0 (flymake-find-err-info (flymake-get-buffer-err-info (current-buffer)) line-no))) | ||
| 1758 | (menu-data (flymake-make-err-menu-data line-no line-err-info-list)) | ||
| 1759 | (choice nil) | ||
| 1760 | (mouse-pos (flymake-get-point-pixel-pos)) | ||
| 1761 | (moved-mouse-pos (list (car mouse-pos) (+ 10 (car (cdr mouse-pos))))) | ||
| 1762 | (menu-pos (list (flymake-get-point-pixel-pos) (selected-window)))) | ||
| 1763 | (if menu-data | ||
| 1764 | (progn | ||
| 1765 | (setq choice (flymake-popup-menu menu-pos menu-data)) | ||
| 1766 | (flymake-log 3 "choice=%s" choice) | ||
| 1767 | (when choice | ||
| 1768 | (eval choice) | ||
| 1769 | ) | ||
| 1770 | ) | ||
| 1771 | ;else | ||
| 1772 | (flymake-log 1 "no errors for line %d" line-no) | ||
| 1773 | ) | ||
| 1774 | ) | ||
| 1775 | ) | ||
| 1776 | |||
| 1777 | (defun flymake-make-err-menu-data(line-no line-err-info-list) | ||
| 1778 | "Make a (menu-title (item-title item-action)*) list with errors/warnings from line-err-info" | ||
| 1779 | (let* ((menu-items nil)) | ||
| 1780 | (when line-err-info-list | ||
| 1781 | (let* ((count (length line-err-info-list)) | ||
| 1782 | (menu-item-text nil)) | ||
| 1783 | (while (> count 0) | ||
| 1784 | (setq menu-item-text (flymake-ler-get-text (nth (1- count) line-err-info-list))) | ||
| 1785 | (let* ((file (flymake-ler-get-file (nth (1- count) line-err-info-list))) | ||
| 1786 | (full-file (flymake-ler-get-full-file (nth (1- count) line-err-info-list))) | ||
| 1787 | (line (flymake-ler-get-line (nth (1- count) line-err-info-list)))) | ||
| 1788 | (if file | ||
| 1789 | (setq menu-item-text (concat menu-item-text " - " file "(" (format "%d" line) ")")) | ||
| 1790 | ) | ||
| 1791 | (setq menu-items (cons (list menu-item-text | ||
| 1792 | (if file (list 'flymake-goto-file-and-line full-file line) nil)) | ||
| 1793 | menu-items)) | ||
| 1794 | ) | ||
| 1795 | (setq count (1- count)) | ||
| 1796 | ) | ||
| 1797 | (flymake-log 3 "created menu-items with %d item(s)" (length menu-items)) | ||
| 1798 | ) | ||
| 1799 | ) | ||
| 1800 | (if menu-items | ||
| 1801 | (let* ((menu-title (format "Line %d: %d error(s), %d warning(s)" line-no | ||
| 1802 | (flymake-get-line-err-count line-err-info-list "e") | ||
| 1803 | (flymake-get-line-err-count line-err-info-list "w")))) | ||
| 1804 | (list menu-title menu-items) | ||
| 1805 | ) | ||
| 1806 | ;else | ||
| 1807 | nil | ||
| 1808 | ) | ||
| 1809 | ) | ||
| 1810 | ) | ||
| 1811 | |||
| 1812 | (defun flymake-goto-file-and-line(file line) | ||
| 1813 | "try to get buffer for file and goto line line in it" | ||
| 1814 | (if (not (file-exists-p file)) | ||
| 1815 | (flymake-log 1 "file %s does not exists" file) | ||
| 1816 | ;else | ||
| 1817 | (progn | ||
| 1818 | (find-file file) | ||
| 1819 | (goto-line line) | ||
| 1820 | ) | ||
| 1821 | ) | ||
| 1822 | ) | ||
| 1823 | ;; flymake minor mode declarations | ||
| 1824 | |||
| 1825 | (defvar flymake-mode nil) | ||
| 1826 | (make-variable-buffer-local 'flymake-mode) | ||
| 1827 | |||
| 1828 | (defvar flymake-mode-line nil | ||
| 1829 | "" | ||
| 1830 | ) | ||
| 1831 | (make-variable-buffer-local 'flymake-mode-line) | ||
| 1832 | (defun flymake-get-buffer-mode-line(buffer) | ||
| 1833 | (flymake-get-buffer-var buffer 'flymake-mode-line) | ||
| 1834 | ) | ||
| 1835 | (defun flymake-set-buffer-mode-line(buffer mode-line-string) | ||
| 1836 | (flymake-set-buffer-var buffer 'flymake-mode-line mode-line-string) | ||
| 1837 | ) | ||
| 1838 | |||
| 1839 | (defvar flymake-mode-line-e-w nil) | ||
| 1840 | (make-variable-buffer-local 'flymake-mode-line-e-w) | ||
| 1841 | (defun flymake-get-buffer-mode-line-e-w(buffer) | ||
| 1842 | (flymake-get-buffer-var buffer 'flymake-mode-line-e-w) | ||
| 1843 | ) | ||
| 1844 | (defun flymake-set-buffer-mode-line-e-w(buffer e-w) | ||
| 1845 | (flymake-set-buffer-var buffer 'flymake-mode-line-e-w e-w) | ||
| 1846 | ) | ||
| 1847 | |||
| 1848 | (defvar flymake-mode-line-status nil) | ||
| 1849 | (make-variable-buffer-local 'flymake-mode-line-status) | ||
| 1850 | (defun flymake-get-buffer-mode-line-status(buffer) | ||
| 1851 | (flymake-get-buffer-var buffer 'flymake-mode-line-status) | ||
| 1852 | ) | ||
| 1853 | (defun flymake-set-buffer-mode-line-status(buffer status) | ||
| 1854 | (flymake-set-buffer-var buffer 'flymake-mode-line-status status) | ||
| 1855 | ) | ||
| 1856 | |||
| 1857 | (defun flymake-report-status(buffer e-w &optional status) | ||
| 1858 | "show status in the mode line" | ||
| 1859 | (when (bufferp buffer) | ||
| 1860 | (save-excursion | ||
| 1861 | (set-buffer buffer) | ||
| 1862 | (when e-w | ||
| 1863 | (flymake-set-buffer-mode-line-e-w buffer e-w) | ||
| 1864 | ) | ||
| 1865 | (when status | ||
| 1866 | (flymake-set-buffer-mode-line-status buffer status) | ||
| 1867 | ) | ||
| 1868 | (let* ((mode-line " Flymake")) | ||
| 1869 | (when (> (length (flymake-get-buffer-mode-line-e-w buffer)) 0) | ||
| 1870 | (setq mode-line (concat mode-line ":" (flymake-get-buffer-mode-line-e-w buffer))) | ||
| 1871 | ) | ||
| 1872 | (setq mode-line (concat mode-line (flymake-get-buffer-mode-line-status buffer))) | ||
| 1873 | (flymake-set-buffer-mode-line buffer mode-line) | ||
| 1874 | (force-mode-line-update) | ||
| 1875 | ) | ||
| 1876 | ) | ||
| 1877 | ) | ||
| 1878 | ) | ||
| 1879 | |||
| 1880 | (defun flymake-display-warning(warning) | ||
| 1881 | "display a warning to the user" | ||
| 1882 | (message-box warning) | ||
| 1883 | ) | ||
| 1884 | |||
| 1885 | (defcustom flymake-gui-warnings-enabled t | ||
| 1886 | "enables/disables gui warnings" | ||
| 1887 | :group 'flymake | ||
| 1888 | :type 'boolean | ||
| 1889 | ) | ||
| 1890 | |||
| 1891 | (defun flymake-report-fatal-status(buffer status warning) | ||
| 1892 | "display a warning and switch flymake mode OFF" | ||
| 1893 | (when flymake-gui-warnings-enabled | ||
| 1894 | (flymake-display-warning (format "Flymake: %s. Flymake will be switched OFF" warning)) | ||
| 1895 | ) | ||
| 1896 | (save-excursion | ||
| 1897 | (set-buffer buffer) | ||
| 1898 | (flymake-mode 0) | ||
| 1899 | (flymake-log 0 "switched OFF Flymake mode for buffer %s due to fatal status %s, warning %s" | ||
| 1900 | (buffer-name buffer) status warning) | ||
| 1901 | ) | ||
| 1902 | ) | ||
| 1903 | |||
| 1904 | (defun flymake-mode(&optional arg) | ||
| 1905 | "toggle flymake-mode" | ||
| 1906 | (interactive) | ||
| 1907 | (let ((old-flymake-mode flymake-mode)) | ||
| 1908 | |||
| 1909 | (setq turn-on | ||
| 1910 | (if (null arg) | ||
| 1911 | (not flymake-mode) | ||
| 1912 | ;else | ||
| 1913 | (> (prefix-numeric-value arg) 0)) | ||
| 1914 | ) | ||
| 1915 | |||
| 1916 | (if turn-on | ||
| 1917 | (if (flymake-can-syntax-check-file (buffer-file-name)) | ||
| 1918 | (flymake-mode-on) | ||
| 1919 | ;else | ||
| 1920 | (flymake-log 2 "flymake cannot check syntax in buffer %s" (buffer-name)) | ||
| 1921 | ) | ||
| 1922 | ;else | ||
| 1923 | (flymake-mode-off) | ||
| 1924 | ) | ||
| 1925 | (force-mode-line-update) | ||
| 1926 | ) | ||
| 1927 | ) | ||
| 1928 | |||
| 1929 | ;;;###autoload | ||
| 1930 | (unless (assq 'flymake-mode minor-mode-alist) | ||
| 1931 | (setq minor-mode-alist (cons '(flymake-mode flymake-mode-line) minor-mode-alist)) | ||
| 1932 | ) | ||
| 1933 | |||
| 1934 | ;;;###autoload | ||
| 1935 | (defun flymake-mode-on() | ||
| 1936 | "turn flymake mode on" | ||
| 1937 | (when (not flymake-mode) | ||
| 1938 | (make-local-variable 'after-change-functions) | ||
| 1939 | (setq after-change-functions (cons 'flymake-after-change-function after-change-functions)) | ||
| 1940 | (add-hook 'after-save-hook 'flymake-after-save-hook) | ||
| 1941 | (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook) | ||
| 1942 | ;+(add-hook 'find-file-hooks 'flymake-find-file-hook) | ||
| 1943 | |||
| 1944 | (flymake-report-status (current-buffer) "" "") | ||
| 1945 | |||
| 1946 | (flymake-set-buffer-timer (current-buffer) (run-at-time nil 1 'flymake-on-timer-event (current-buffer))) | ||
| 1947 | |||
| 1948 | (setq flymake-mode t) | ||
| 1949 | (flymake-log 1 "flymake mode turned ON for buffer %s" (buffer-name (current-buffer))) | ||
| 1950 | (when flymake-start-syntax-check-on-find-file | ||
| 1951 | (flymake-start-syntax-check-for-current-buffer) ; will be started by on-load hook | ||
| 1952 | ) | ||
| 1953 | ) | ||
| 1954 | ) | ||
| 1955 | |||
| 1956 | ;;;###autoload | ||
| 1957 | (defun flymake-mode-off() | ||
| 1958 | "turn flymake mode off" | ||
| 1959 | (when flymake-mode | ||
| 1960 | (setq after-change-functions (delq 'flymake-after-change-function after-change-functions)) | ||
| 1961 | (remove-hook 'after-save-hook (function flymake-after-save-hook) t) | ||
| 1962 | (remove-hook 'kill-buffer-hook (function flymake-kill-buffer-hook) t) | ||
| 1963 | ;+(remove-hook 'find-file-hooks (function flymake-find-file-hook) t) | ||
| 1964 | |||
| 1965 | (flymake-delete-own-overlays (current-buffer)) | ||
| 1966 | |||
| 1967 | (when (flymake-get-buffer-timer (current-buffer)) | ||
| 1968 | (cancel-timer (flymake-get-buffer-timer (current-buffer))) | ||
| 1969 | (flymake-set-buffer-timer (current-buffer) nil) | ||
| 1970 | ) | ||
| 1971 | |||
| 1972 | (flymake-set-buffer-is-running (current-buffer) nil) | ||
| 1973 | |||
| 1974 | (setq flymake-mode nil) | ||
| 1975 | (flymake-log 1 "flymake mode turned OFF for buffer %s" (buffer-name (current-buffer))) | ||
| 1976 | ) | ||
| 1977 | ) | ||
| 1978 | |||
| 1979 | (defcustom flymake-start-syntax-check-on-newline t | ||
| 1980 | "start syntax check if newline char was added/removed from the buffer" | ||
| 1981 | :group 'flymake | ||
| 1982 | :type 'boolean | ||
| 1983 | ) | ||
| 1984 | |||
| 1985 | (defun flymake-after-change-function(start stop len) | ||
| 1986 | "Start syntax check for current buffer if it isn't already running" | ||
| 1987 | ;+(flymake-log 0 "setting change time to %s" (flymake-float-time)) | ||
| 1988 | (let((new-text (buffer-substring start stop))) | ||
| 1989 | (when (and flymake-start-syntax-check-on-newline (equal new-text "\n")) | ||
| 1990 | (flymake-log 3 "starting syntax check as new-line has been seen") | ||
| 1991 | (flymake-start-syntax-check-for-current-buffer) | ||
| 1992 | ) | ||
| 1993 | (flymake-set-buffer-last-change-time (current-buffer) (flymake-float-time)) | ||
| 1994 | ) | ||
| 1995 | ) | ||
| 1996 | |||
| 1997 | (defun flymake-after-save-hook() | ||
| 1998 | (if (local-variable-p 'flymake-mode (current-buffer)) ; (???) other way to determine whether flymake is active in buffer being saved? | ||
| 1999 | (progn | ||
| 2000 | (flymake-log 3 "starting syntax check as buffer was saved") | ||
| 2001 | (flymake-start-syntax-check-for-current-buffer) ; no more mode 3. cannot start check if mode 3 (to temp copies) is active - (???) | ||
| 2002 | ) | ||
| 2003 | ) | ||
| 2004 | ) | ||
| 2005 | |||
| 2006 | (defun flymake-kill-buffer-hook() | ||
| 2007 | (when (flymake-get-buffer-timer (current-buffer)) | ||
| 2008 | (cancel-timer (flymake-get-buffer-timer (current-buffer))) | ||
| 2009 | (flymake-set-buffer-timer (current-buffer) nil) | ||
| 2010 | ) | ||
| 2011 | ) | ||
| 2012 | |||
| 2013 | (defcustom flymake-start-syntax-check-on-find-file t | ||
| 2014 | "statr syntax check on find file" | ||
| 2015 | :group 'flymake | ||
| 2016 | :type 'boolean | ||
| 2017 | ) | ||
| 2018 | |||
| 2019 | (defun flymake-find-file-hook() | ||
| 2020 | ;+(when flymake-start-syntax-check-on-find-file | ||
| 2021 | ;+ (flymake-log 3 "starting syntax check on file open") | ||
| 2022 | ;+ (flymake-start-syntax-check-for-current-buffer) | ||
| 2023 | ;+) | ||
| 2024 | (when (and (not (local-variable-p 'flymake-mode (current-buffer))) | ||
| 2025 | (flymake-can-syntax-check-file (buffer-file-name (current-buffer)))) | ||
| 2026 | (flymake-mode) | ||
| 2027 | (flymake-log 3 "automatically turned ON flymake mode") | ||
| 2028 | ) | ||
| 2029 | ) | ||
| 2030 | |||
| 2031 | (defun flymake-get-first-err-line-no(err-info-list) | ||
| 2032 | "return first line-no with error" | ||
| 2033 | (when err-info-list | ||
| 2034 | (flymake-er-get-line (car err-info-list)) | ||
| 2035 | ) | ||
| 2036 | ) | ||
| 2037 | |||
| 2038 | (defun flymake-get-last-err-line-no(err-info-list) | ||
| 2039 | "return last line-no with error" | ||
| 2040 | (when err-info-list | ||
| 2041 | (flymake-er-get-line (nth (1- (length err-info-list)) err-info-list)) | ||
| 2042 | ) | ||
| 2043 | ) | ||
| 2044 | |||
| 2045 | (defun flymake-get-next-err-line-no(err-info-list line-no) | ||
| 2046 | "return next line with erroe" | ||
| 2047 | (when err-info-list | ||
| 2048 | (let* ((count (length err-info-list)) | ||
| 2049 | (idx 0)) | ||
| 2050 | (while (and (< idx count) (>= line-no (flymake-er-get-line (nth idx err-info-list)))) | ||
| 2051 | (setq idx (1+ idx)) | ||
| 2052 | ) | ||
| 2053 | (if (< idx count) | ||
| 2054 | (flymake-er-get-line (nth idx err-info-list)) | ||
| 2055 | ) | ||
| 2056 | ) | ||
| 2057 | ) | ||
| 2058 | ) | ||
| 2059 | |||
| 2060 | (defun flymake-get-prev-err-line-no(err-info-list line-no) | ||
| 2061 | "return prev line with error" | ||
| 2062 | (when err-info-list | ||
| 2063 | (let* ((count (length err-info-list))) | ||
| 2064 | (while (and (> count 0) (<= line-no (flymake-er-get-line (nth (1- count) err-info-list)))) | ||
| 2065 | (setq count (1- count)) | ||
| 2066 | ) | ||
| 2067 | (if (> count 0) | ||
| 2068 | (flymake-er-get-line (nth (1- count) err-info-list)) | ||
| 2069 | ) | ||
| 2070 | ) | ||
| 2071 | ) | ||
| 2072 | ) | ||
| 2073 | |||
| 2074 | (defun flymake-skip-whitespace() | ||
| 2075 | "move forward until nonwhitespace is reached" | ||
| 2076 | (while (looking-at "[ \t]") | ||
| 2077 | (forward-char) | ||
| 2078 | ) | ||
| 2079 | ) | ||
| 2080 | |||
| 2081 | (defun flymake-goto-line(line-no) | ||
| 2082 | "goto-line, then skip whitespace" | ||
| 2083 | (goto-line line-no) | ||
| 2084 | (flymake-skip-whitespace) | ||
| 2085 | ) | ||
| 2086 | |||
| 2087 | (defun flymake-goto-next-error() | ||
| 2088 | "go to next error in err ring" | ||
| 2089 | (interactive) | ||
| 2090 | (let ((line-no (flymake-get-next-err-line-no (flymake-get-buffer-err-info (current-buffer)) (flymake-current-line-no)))) | ||
| 2091 | (when (not line-no) | ||
| 2092 | (setq line-no (flymake-get-first-err-line-no (flymake-get-buffer-err-info (current-buffer)))) | ||
| 2093 | (flymake-log 1 "passed end of file") | ||
| 2094 | ) | ||
| 2095 | (if line-no | ||
| 2096 | (flymake-goto-line line-no) | ||
| 2097 | ;else | ||
| 2098 | (flymake-log 1 "no errors in current buffer") | ||
| 2099 | ) | ||
| 2100 | ) | ||
| 2101 | ) | ||
| 2102 | |||
| 2103 | (defun flymake-goto-prev-error() | ||
| 2104 | "go to prev error in err ring" | ||
| 2105 | (interactive) | ||
| 2106 | (let ((line-no (flymake-get-prev-err-line-no (flymake-get-buffer-err-info (current-buffer)) (flymake-current-line-no)))) | ||
| 2107 | (when (not line-no) | ||
| 2108 | (setq line-no (flymake-get-last-err-line-no (flymake-get-buffer-err-info (current-buffer)))) | ||
| 2109 | (flymake-log 1 "passed beginning of file") | ||
| 2110 | ) | ||
| 2111 | (if line-no | ||
| 2112 | (flymake-goto-line line-no) | ||
| 2113 | ;else | ||
| 2114 | (flymake-log 1 "no errors in current buffer") | ||
| 2115 | ) | ||
| 2116 | ) | ||
| 2117 | ) | ||
| 2118 | |||
| 2119 | (defun flymake-patch-err-text(string) | ||
| 2120 | (if (string-match "^[\n\t :0-9]*\\(.*\\)$" string) | ||
| 2121 | (match-string 1 string) | ||
| 2122 | ;else | ||
| 2123 | string | ||
| 2124 | ) | ||
| 2125 | ) | ||
| 2126 | |||
| 2127 | ;;;; general init-cleanup and helper routines | ||
| 2128 | |||
| 2129 | (defun flymake-create-temp-inplace(file-name prefix) | ||
| 2130 | (unless (stringp file-name) | ||
| 2131 | (error "invalid file-name") | ||
| 2132 | ) | ||
| 2133 | (or prefix | ||
| 2134 | (setq prefix "flymake") | ||
| 2135 | ) | ||
| 2136 | (let* ((temp-name (concat (file-name-sans-extension file-name) | ||
| 2137 | "_" prefix | ||
| 2138 | (and (file-name-extension file-name) | ||
| 2139 | (concat "." (file-name-extension file-name)))))) | ||
| 2140 | (flymake-log 3 "create-temp-inplace: file=%s temp=%s" file-name temp-name) | ||
| 2141 | temp-name | ||
| 2142 | ) | ||
| 2143 | ) | ||
| 2144 | |||
| 2145 | (defun flymake-create-temp-with-folder-structure(file-name prefix) | ||
| 2146 | (unless (stringp file-name) | ||
| 2147 | (error "invalid file-name") | ||
| 2148 | ) | ||
| 2149 | |||
| 2150 | (let* ((dir (file-name-directory file-name)) | ||
| 2151 | (slash-pos (string-match "/" dir)) | ||
| 2152 | (temp-dir (concat (flymake-ensure-ends-with-slash (flymake-get-temp-dir)) (substring dir (1+ slash-pos))))) | ||
| 2153 | |||
| 2154 | (file-truename (concat (flymake-ensure-ends-with-slash temp-dir) | ||
| 2155 | (file-name-nondirectory file-name))) | ||
| 2156 | ) | ||
| 2157 | ) | ||
| 2158 | |||
| 2159 | (defun flymake-strrchr(str ch) | ||
| 2160 | (let* ((count (length str)) | ||
| 2161 | (pos nil)) | ||
| 2162 | (while (and (not pos) (> count 0)) | ||
| 2163 | (if (= ch (elt str (1- count))) | ||
| 2164 | (setq pos (1- count)) | ||
| 2165 | ) | ||
| 2166 | (setq count (1- count)) | ||
| 2167 | ) | ||
| 2168 | pos | ||
| 2169 | ) | ||
| 2170 | ) | ||
| 2171 | |||
| 2172 | (defun flymake-delete-temp-directory(dir-name) | ||
| 2173 | "attempt to delete temp dir created by flymake-create-temp-with-folder-structure, do not fail on error" | ||
| 2174 | (let* ((temp-dir (flymake-get-temp-dir)) | ||
| 2175 | (suffix (substring dir-name (1+ (length temp-dir)))) | ||
| 2176 | (slash-pos nil)) | ||
| 2177 | |||
| 2178 | (while (> (length suffix) 0) | ||
| 2179 | ;+(flymake-log 0 "suffix=%s" suffix) | ||
| 2180 | (flymake-safe-delete-directory (file-truename (concat (flymake-ensure-ends-with-slash temp-dir) suffix))) | ||
| 2181 | (setq slash-pos (flymake-strrchr suffix (string-to-char "/"))) | ||
| 2182 | (if slash-pos | ||
| 2183 | (setq suffix (substring suffix 0 slash-pos)) | ||
| 2184 | ;else | ||
| 2185 | (setq suffix "") | ||
| 2186 | ) | ||
| 2187 | ) | ||
| 2188 | ) | ||
| 2189 | ) | ||
| 2190 | |||
| 2191 | (defun flymake-init-create-temp-buffer-copy(buffer create-temp-f) | ||
| 2192 | "make a temporary copy of the current buffer, save its name in buffer data and return the name" | ||
| 2193 | (let* ((source-file-name (buffer-file-name buffer)) | ||
| 2194 | (temp-source-file-name (funcall create-temp-f source-file-name "flymake"))) | ||
| 2195 | |||
| 2196 | (flymake-save-buffer-in-file buffer temp-source-file-name) | ||
| 2197 | (flymake-set-buffer-value buffer "temp-source-file-name" temp-source-file-name) | ||
| 2198 | |||
| 2199 | temp-source-file-name | ||
| 2200 | ) | ||
| 2201 | ) | ||
| 2202 | |||
| 2203 | (defun flymake-simple-cleanup(buffer) | ||
| 2204 | "cleanup after flymake-init-create-temp-buffer-copy -- delete temp file" | ||
| 2205 | (let* ((temp-source-file-name (flymake-get-buffer-value buffer "temp-source-file-name"))) | ||
| 2206 | (flymake-safe-delete-file temp-source-file-name) | ||
| 2207 | (flymake-set-buffer-last-change-time buffer nil) | ||
| 2208 | ) | ||
| 2209 | ) | ||
| 2210 | |||
| 2211 | (defun flymake-get-real-file-name(buffer file-name-from-err-msg) | ||
| 2212 | "Translate file name from error message to `real' file name. Return full-name. Names are real, not patched" | ||
| 2213 | (let* ((real-name nil) | ||
| 2214 | (source-file-name (buffer-file-name buffer)) | ||
| 2215 | (master-file-name (flymake-get-buffer-value buffer "master-file-name")) | ||
| 2216 | (temp-source-file-name (flymake-get-buffer-value buffer "temp-source-file-name")) | ||
| 2217 | (temp-master-file-name (flymake-get-buffer-value buffer "temp-master-file-name")) | ||
| 2218 | (base-dirs (list (flymake-get-buffer-value buffer "base-dir") | ||
| 2219 | (file-name-directory source-file-name) | ||
| 2220 | (if master-file-name (file-name-directory master-file-name) nil))) | ||
| 2221 | (files (list (list source-file-name source-file-name) | ||
| 2222 | (list temp-source-file-name source-file-name) | ||
| 2223 | (list master-file-name master-file-name) | ||
| 2224 | (list temp-master-file-name master-file-name)))) | ||
| 2225 | |||
| 2226 | (when (equal 0 (length file-name-from-err-msg)) | ||
| 2227 | (setq file-name-from-err-msg source-file-name) | ||
| 2228 | ) | ||
| 2229 | |||
| 2230 | (setq real-name (flymake-get-full-patched-file-name file-name-from-err-msg base-dirs files)) | ||
| 2231 | ; if real-name is nil, than file name from err msg is none of the files we've patched | ||
| 2232 | (if (not real-name) | ||
| 2233 | (setq real-name (flymake-get-full-nonpatched-file-name file-name-from-err-msg base-dirs)) | ||
| 2234 | ) | ||
| 2235 | (if (not real-name) | ||
| 2236 | (setq real-name file-name-from-err-msg) | ||
| 2237 | ) | ||
| 2238 | (setq real-name (flymake-fix-path-name real-name)) | ||
| 2239 | (flymake-log 3 "get-real-file-name: file-name=%s real-name=%s" file-name-from-err-msg real-name) | ||
| 2240 | real-name | ||
| 2241 | ) | ||
| 2242 | ) | ||
| 2243 | |||
| 2244 | (defun flymake-get-full-patched-file-name(file-name-from-err-msg base-dirs files) | ||
| 2245 | (let* ((base-dirs-count (length base-dirs)) | ||
| 2246 | (file-count (length files)) | ||
| 2247 | (real-name nil)) | ||
| 2248 | |||
| 2249 | (while (and (not real-name) (> base-dirs-count 0)) | ||
| 2250 | (setq file-count (length files)) | ||
| 2251 | (while (and (not real-name) (> file-count 0)) | ||
| 2252 | (let* ((this-dir (nth (1- base-dirs-count) base-dirs)) | ||
| 2253 | (this-file (nth 0 (nth (1- file-count) files))) | ||
| 2254 | (this-real-name (nth 1 (nth (1- file-count) files)))) | ||
| 2255 | ;+(flymake-log 0 "this-dir=%s this-file=%s this-real=%s msg-file=%s" this-dir this-file this-real-name file-name-from-err-msg) | ||
| 2256 | (when (and this-dir this-file (flymake-same-files | ||
| 2257 | (flymake-get-absolute-file-name-basedir file-name-from-err-msg this-dir) | ||
| 2258 | this-file)) | ||
| 2259 | (setq real-name this-real-name) | ||
| 2260 | ) | ||
| 2261 | ) | ||
| 2262 | (setq file-count (1- file-count)) | ||
| 2263 | ) | ||
| 2264 | (setq base-dirs-count (1- base-dirs-count)) | ||
| 2265 | ) | ||
| 2266 | real-name | ||
| 2267 | ) | ||
| 2268 | ) | ||
| 2269 | |||
| 2270 | (defun flymake-get-full-nonpatched-file-name(file-name-from-err-msg base-dirs) | ||
| 2271 | (let* ((real-name nil)) | ||
| 2272 | (if (file-name-absolute-p file-name-from-err-msg) | ||
| 2273 | (setq real-name file-name-from-err-msg) | ||
| 2274 | ;else | ||
| 2275 | (let* ((base-dirs-count (length base-dirs))) | ||
| 2276 | (while (and (not real-name) (> base-dirs-count 0)) | ||
| 2277 | (let* ((full-name (flymake-get-absolute-file-name-basedir file-name-from-err-msg | ||
| 2278 | (nth (1- base-dirs-count) base-dirs)))) | ||
| 2279 | (if (file-exists-p full-name) | ||
| 2280 | (setq real-name full-name) | ||
| 2281 | ) | ||
| 2282 | (setq base-dirs-count (1- base-dirs-count)) | ||
| 2283 | ) | ||
| 2284 | ) | ||
| 2285 | ) | ||
| 2286 | ) | ||
| 2287 | real-name | ||
| 2288 | ) | ||
| 2289 | ) | ||
| 2290 | |||
| 2291 | (defun flymake-get-absolute-file-name-basedir(file-name dir-name) | ||
| 2292 | (if (file-name-absolute-p file-name) | ||
| 2293 | file-name | ||
| 2294 | ;else | ||
| 2295 | (concat dir-name "/" file-name) | ||
| 2296 | ) | ||
| 2297 | ) | ||
| 2298 | |||
| 2299 | (defun flymake-init-find-buildfile-dir(buffer source-file-name buildfile-name) | ||
| 2300 | "find buildfile, store its dir in buffer data and return its dir, if found" | ||
| 2301 | (let* ((buildfile-dir (flymake-find-buildfile buildfile-name | ||
| 2302 | (file-name-directory source-file-name) | ||
| 2303 | flymake-buildfile-dirs))) | ||
| 2304 | (if (not buildfile-dir) | ||
| 2305 | (progn | ||
| 2306 | (flymake-log 1 "no buildfile (%s) for %s" buildfile-name source-file-name) | ||
| 2307 | (flymake-report-fatal-status buffer "NOMK" (format "No buildfile (%s) found for %s" buildfile-name source-file-name)) | ||
| 2308 | ) | ||
| 2309 | ;else | ||
| 2310 | (progn | ||
| 2311 | (flymake-set-buffer-value buffer "base-dir" buildfile-dir) | ||
| 2312 | ) | ||
| 2313 | ) | ||
| 2314 | buildfile-dir | ||
| 2315 | ) | ||
| 2316 | ) | ||
| 2317 | |||
| 2318 | (defun flymake-init-create-temp-source-and-master-buffer-copy(buffer get-incl-dirs-f create-temp-f master-file-masks include-regexp-list) | ||
| 2319 | "find master file (or buffer), create it's copy along with a copy of the source file" | ||
| 2320 | (let* ((source-file-name (buffer-file-name buffer)) | ||
| 2321 | (temp-source-file-name (flymake-init-create-temp-buffer-copy buffer create-temp-f)) | ||
| 2322 | (master-file-name nil) | ||
| 2323 | (temp-master-file-name nil) | ||
| 2324 | (master-and-temp-master (flymake-create-master-file | ||
| 2325 | source-file-name temp-source-file-name | ||
| 2326 | get-incl-dirs-f create-temp-f | ||
| 2327 | master-file-masks include-regexp-list))) | ||
| 2328 | |||
| 2329 | (if (not master-and-temp-master) | ||
| 2330 | (progn | ||
| 2331 | (flymake-log 1 "cannot find master file for %s" source-file-name) | ||
| 2332 | (flymake-report-status buffer "!" "") ; NOMASTER | ||
| 2333 | ) | ||
| 2334 | ;else | ||
| 2335 | (progn | ||
| 2336 | (setq master-file-name (nth 0 master-and-temp-master)) | ||
| 2337 | (setq temp-master-file-name (nth 1 master-and-temp-master)) | ||
| 2338 | (flymake-set-buffer-value buffer "master-file-name" master-file-name) | ||
| 2339 | (flymake-set-buffer-value buffer "temp-master-file-name" temp-master-file-name) | ||
| 2340 | ) | ||
| 2341 | ) | ||
| 2342 | temp-master-file-name | ||
| 2343 | ) | ||
| 2344 | ) | ||
| 2345 | |||
| 2346 | (defun flymake-master-cleanup(buffer) | ||
| 2347 | (flymake-simple-cleanup buffer) | ||
| 2348 | (flymake-safe-delete-file (flymake-get-buffer-value buffer "temp-master-file-name")) | ||
| 2349 | ) | ||
| 2350 | |||
| 2351 | ;;;; make-specific init-cleanup routines | ||
| 2352 | |||
| 2353 | (defun flymake-get-syntax-check-program-args(source-file-name base-dir use-relative-base-dir use-relative-source get-cmd-line-f) | ||
| 2354 | "create a command line for the syntax check command, using get-cmd-line-f" | ||
| 2355 | (let* ((my-base-dir base-dir) | ||
| 2356 | (my-source source-file-name)) | ||
| 2357 | |||
| 2358 | (when use-relative-base-dir | ||
| 2359 | (setq my-base-dir (flymake-build-relative-path (file-name-directory source-file-name) base-dir)) | ||
| 2360 | ) | ||
| 2361 | |||
| 2362 | (when use-relative-source | ||
| 2363 | (setq my-source (concat (flymake-build-relative-path base-dir (file-name-directory source-file-name)) | ||
| 2364 | (file-name-nondirectory source-file-name))) | ||
| 2365 | ) | ||
| 2366 | |||
| 2367 | (funcall get-cmd-line-f my-source my-base-dir) | ||
| 2368 | ) | ||
| 2369 | ) | ||
| 2370 | |||
| 2371 | (defun flymake-get-make-cmdline(source base-dir) | ||
| 2372 | (list "make" | ||
| 2373 | (list "-s" | ||
| 2374 | "-C" | ||
| 2375 | base-dir | ||
| 2376 | (concat "CHK_SOURCES=" source) | ||
| 2377 | "SYNTAX_CHECK_MODE=1" | ||
| 2378 | "check-syntax")) | ||
| 2379 | ) | ||
| 2380 | |||
| 2381 | (defun flymake-get-ant-cmdline(source base-dir) | ||
| 2382 | (list "ant" | ||
| 2383 | (list "-buildfile" | ||
| 2384 | (concat base-dir "/" "build.xml") | ||
| 2385 | (concat "-DCHK_SOURCES=" source) | ||
| 2386 | "check-syntax")) | ||
| 2387 | ) | ||
| 2388 | |||
| 2389 | (defun flymake-simple-make-init-impl(buffer create-temp-f use-relative-base-dir use-relative-source build-file-name get-cmdline-f) | ||
| 2390 | "create syntax check command line for a directly checked source file, use create-temp-f for creating temp copy" | ||
| 2391 | (let* ((args nil) | ||
| 2392 | (source-file-name (buffer-file-name buffer)) | ||
| 2393 | (buildfile-dir (flymake-init-find-buildfile-dir buffer source-file-name build-file-name))) | ||
| 2394 | (if buildfile-dir | ||
| 2395 | (let* ((temp-source-file-name (flymake-init-create-temp-buffer-copy buffer create-temp-f))) | ||
| 2396 | (setq args (flymake-get-syntax-check-program-args temp-source-file-name buildfile-dir | ||
| 2397 | use-relative-base-dir use-relative-source | ||
| 2398 | get-cmdline-f)) | ||
| 2399 | ) | ||
| 2400 | ) | ||
| 2401 | |||
| 2402 | args | ||
| 2403 | ) | ||
| 2404 | ) | ||
| 2405 | |||
| 2406 | (defun flymake-simple-make-init(buffer) | ||
| 2407 | (flymake-simple-make-init-impl buffer 'flymake-create-temp-inplace t t "Makefile" 'flymake-get-make-cmdline) | ||
| 2408 | ) | ||
| 2409 | |||
| 2410 | (defun flymake-master-make-init(buffer get-incl-dirs-f master-file-masks include-regexp-list) | ||
| 2411 | "create make command line for a source file checked via master file compilation" | ||
| 2412 | (let* ((make-args nil) | ||
| 2413 | (temp-master-file-name (flymake-init-create-temp-source-and-master-buffer-copy | ||
| 2414 | buffer get-incl-dirs-f 'flymake-create-temp-inplace | ||
| 2415 | master-file-masks include-regexp-list))) | ||
| 2416 | (when temp-master-file-name | ||
| 2417 | (let* ((buildfile-dir (flymake-init-find-buildfile-dir buffer temp-master-file-name "Makefile"))) | ||
| 2418 | (if buildfile-dir | ||
| 2419 | (setq make-args (flymake-get-syntax-check-program-args | ||
| 2420 | temp-master-file-name buildfile-dir nil nil 'flymake-get-make-cmdline)) | ||
| 2421 | ) | ||
| 2422 | ) | ||
| 2423 | ) | ||
| 2424 | |||
| 2425 | make-args | ||
| 2426 | ) | ||
| 2427 | ) | ||
| 2428 | |||
| 2429 | (defun flymake-find-make-buildfile(source-dir) | ||
| 2430 | (flymake-find-buildfile "Makefile" source-dir flymake-buildfile-dirs) | ||
| 2431 | ) | ||
| 2432 | |||
| 2433 | ;;;; .h/make specific | ||
| 2434 | (defun flymake-master-make-header-init(buffer) | ||
| 2435 | (flymake-master-make-init buffer | ||
| 2436 | 'flymake-get-include-dirs | ||
| 2437 | '(".+\\.cpp$" ".+\\.c$") | ||
| 2438 | '("[ \t]*#[ \t]*include[ \t]*\"\\([\w0-9/\\_\.]*[/\\]*\\)\\(%s\\)\"" 1 2)) | ||
| 2439 | ) | ||
| 2440 | |||
| 2441 | ;;;; .java/make specific | ||
| 2442 | (defun flymake-simple-make-java-init(buffer) | ||
| 2443 | (flymake-simple-make-init-impl buffer 'flymake-create-temp-with-folder-structure nil nil "Makefile" 'flymake-get-make-cmdline) | ||
| 2444 | ) | ||
| 2445 | |||
| 2446 | (defun flymake-simple-ant-java-init(buffer) | ||
| 2447 | (flymake-simple-make-init-impl buffer 'flymake-create-temp-with-folder-structure nil nil "build.xml" 'flymake-get-ant-cmdline) | ||
| 2448 | ) | ||
| 2449 | |||
| 2450 | (defun flymake-simple-java-cleanup(buffer) | ||
| 2451 | "cleanup after flymake-simple-make-java-init -- delete temp file and dirs" | ||
| 2452 | (let* ((temp-source-file-name (flymake-get-buffer-value buffer "temp-source-file-name"))) | ||
| 2453 | (flymake-safe-delete-file temp-source-file-name) | ||
| 2454 | (when temp-source-file-name | ||
| 2455 | (flymake-delete-temp-directory (file-name-directory temp-source-file-name)) | ||
| 2456 | ) | ||
| 2457 | ) | ||
| 2458 | ) | ||
| 2459 | |||
| 2460 | ;;;; perl-specific init-cleanup routines | ||
| 2461 | |||
| 2462 | (defun flymake-perl-init(buffer) | ||
| 2463 | (let* ((temp-file (flymake-init-create-temp-buffer-copy buffer 'flymake-create-temp-inplace)) | ||
| 2464 | (local-file (concat (flymake-build-relative-path (file-name-directory (buffer-file-name (current-buffer))) | ||
| 2465 | (file-name-directory temp-file)) | ||
| 2466 | (file-name-nondirectory temp-file)))) | ||
| 2467 | (list "perl" (list "-wc " local-file)) | ||
| 2468 | ) | ||
| 2469 | ) | ||
| 2470 | |||
| 2471 | ;;;; tex-specific init-cleanup routines | ||
| 2472 | |||
| 2473 | (defun flymake-get-tex-args(file-name) | ||
| 2474 | ;(list "latex" (list "-c-style-errors" file-name)) | ||
| 2475 | (list "texify" (list "--pdf" "--tex-option=-c-style-errors" file-name)) | ||
| 2476 | ) | ||
| 2477 | |||
| 2478 | (defun flymake-simple-tex-init(buffer) | ||
| 2479 | (flymake-get-tex-args (flymake-init-create-temp-buffer-copy buffer 'flymake-create-temp-inplace)) | ||
| 2480 | ) | ||
| 2481 | |||
| 2482 | (defun flymake-master-tex-init(buffer) | ||
| 2483 | (let* ((temp-master-file-name (flymake-init-create-temp-source-and-master-buffer-copy | ||
| 2484 | buffer 'flymake-get-include-dirs-dot 'flymake-create-temp-inplace | ||
| 2485 | '(".+\\.tex$") | ||
| 2486 | '("[ \t]*\\input[ \t]*{\\(.*\\)\\(%s\\)}" 1 2)))) | ||
| 2487 | (when temp-master-file-name | ||
| 2488 | (flymake-get-tex-args temp-master-file-name) | ||
| 2489 | ) | ||
| 2490 | ) | ||
| 2491 | ) | ||
| 2492 | |||
| 2493 | (defun flymake-get-include-dirs-dot(base-dir) | ||
| 2494 | '(".") | ||
| 2495 | ) | ||
| 2496 | |||
| 2497 | ;;;; xml-specific init-cleanup routines | ||
| 2498 | |||
| 2499 | (defun flymake-xml-init(buffer) | ||
| 2500 | (list "xml" (list "val" (flymake-init-create-temp-buffer-copy buffer 'flymake-create-temp-inplace))) | ||
| 2501 | ) | ||
| 2502 | |||
| 2503 | ;;; arch-tag: 8f0d6090-061d-4cac-8862-7c151c4a02dd | ||
| 2504 | ;;; flymake.el ends here | ||
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index c5e322a657a..aa81f8aa770 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el | |||
| @@ -533,8 +533,7 @@ those sub directories of DIR." | |||
| 533 | (files | 533 | (files |
| 534 | (read-string (concat "Search for \"" regexp "\" in files (default " grep-tree-last-files "): "))) | 534 | (read-string (concat "Search for \"" regexp "\" in files (default " grep-tree-last-files "): "))) |
| 535 | (dir | 535 | (dir |
| 536 | (file-name-as-directory | 536 | (read-directory-name "Base directory: " nil default-directory t))) |
| 537 | (read-directory-name "Base directory: " nil default-directory t)))) | ||
| 538 | (list regexp files dir))) | 537 | (list regexp files dir))) |
| 539 | (unless grep-tree-command | 538 | (unless grep-tree-command |
| 540 | (grep-compute-defaults)) | 539 | (grep-compute-defaults)) |
| @@ -556,7 +555,7 @@ those sub directories of DIR." | |||
| 556 | nil) ;; we change default-directory to dir | 555 | nil) ;; we change default-directory to dir |
| 557 | (and grep-tree-ignore-CVS-directories "-path '*/CVS' -prune -o ") | 556 | (and grep-tree-ignore-CVS-directories "-path '*/CVS' -prune -o ") |
| 558 | grep-tree-ignore-case)) | 557 | grep-tree-ignore-case)) |
| 559 | (default-directory dir) | 558 | (default-directory (file-name-as-directory (expand-file-name dir))) |
| 560 | (null-device nil)) ; see grep | 559 | (null-device nil)) ; see grep |
| 561 | (grep command-args regexp))) | 560 | (grep command-args regexp))) |
| 562 | 561 | ||
diff --git a/lisp/simple.el b/lisp/simple.el index 1a1d80bcd41..9187c0db484 100644 --- a/lisp/simple.el +++ b/lisp/simple.el | |||
| @@ -785,6 +785,23 @@ If nil, don't change the value of `debug-on-error'." | |||
| 785 | :type 'boolean | 785 | :type 'boolean |
| 786 | :version "21.1") | 786 | :version "21.1") |
| 787 | 787 | ||
| 788 | (defun eval-expression-print-format (value) | ||
| 789 | "Format VALUE as a result of evaluated expression. | ||
| 790 | Return a formatted string which is displayed in the echo area | ||
| 791 | in addition to the value printed by prin1 in functions which | ||
| 792 | display the result of expression evaluation." | ||
| 793 | (if (and (integerp value) | ||
| 794 | (or (not (eq this-command 'eval-last-sexp)) | ||
| 795 | (eq this-command last-command) | ||
| 796 | (and (boundp 'edebug-active) edebug-active))) | ||
| 797 | (let ((char-string | ||
| 798 | (if (or (and (boundp 'edebug-active) edebug-active) | ||
| 799 | (eq this-command 'eval-last-sexp)) | ||
| 800 | (prin1-char value)))) | ||
| 801 | (if char-string | ||
| 802 | (format " (0%o, 0x%x) = %s" value value char-string) | ||
| 803 | (format " (0%o, 0x%x)" value value))))) | ||
| 804 | |||
| 788 | ;; We define this, rather than making `eval' interactive, | 805 | ;; We define this, rather than making `eval' interactive, |
| 789 | ;; for the sake of completion of names like eval-region, eval-current-buffer. | 806 | ;; for the sake of completion of names like eval-region, eval-current-buffer. |
| 790 | (defun eval-expression (eval-expression-arg | 807 | (defun eval-expression (eval-expression-arg |
| @@ -819,7 +836,10 @@ the echo area." | |||
| 819 | (with-no-warnings | 836 | (with-no-warnings |
| 820 | (let ((standard-output (current-buffer))) | 837 | (let ((standard-output (current-buffer))) |
| 821 | (eval-last-sexp-print-value (car values)))) | 838 | (eval-last-sexp-print-value (car values)))) |
| 822 | (prin1 (car values) t)))) | 839 | (prog1 |
| 840 | (prin1 (car values) t) | ||
| 841 | (let ((str (eval-expression-print-format (car values)))) | ||
| 842 | (if str (princ str t))))))) | ||
| 823 | 843 | ||
| 824 | (defun edit-and-eval-command (prompt command) | 844 | (defun edit-and-eval-command (prompt command) |
| 825 | "Prompting with PROMPT, let user edit COMMAND and eval result. | 845 | "Prompting with PROMPT, let user edit COMMAND and eval result. |
diff --git a/lisp/startup.el b/lisp/startup.el index 2402d116734..2b103aee2ce 100644 --- a/lisp/startup.el +++ b/lisp/startup.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; startup.el --- process Emacs shell arguments | 1 | ;;; startup.el --- process Emacs shell arguments |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1985, 86, 92, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002 | 3 | ;; Copyright (C) 1985, 86, 92, 94, 95, 96, 97, 98, 99, 2000, 01, 02, 2004 |
| 4 | ;; Free Software Foundation, Inc. | 4 | ;; Free Software Foundation, Inc. |
| 5 | 5 | ||
| 6 | ;; Maintainer: FSF | 6 | ;; Maintainer: FSF |
| @@ -578,7 +578,7 @@ opening the first frame (e.g. open a connection to the server).") | |||
| 578 | (if (eq system-type 'ms-dos) | 578 | (if (eq system-type 'ms-dos) |
| 579 | (getenv "TMPDIR"))) | 579 | (getenv "TMPDIR"))) |
| 580 | (setq auto-save-file-name-transforms | 580 | (setq auto-save-file-name-transforms |
| 581 | (list (list "\\`/[^/]*:\\(.+/\\)*\\(.*\\)" | 581 | (list (list (car (car auto-save-file-name-transforms)) |
| 582 | ;; Don't put "\\2" inside expand-file-name, since | 582 | ;; Don't put "\\2" inside expand-file-name, since |
| 583 | ;; it will be transformed to "/2" on DOS/Windows. | 583 | ;; it will be transformed to "/2" on DOS/Windows. |
| 584 | (concat temporary-file-directory "\\2") t))) | 584 | (concat temporary-file-directory "\\2") t))) |
diff --git a/lisp/subr.el b/lisp/subr.el index 8559de28746..59620d1bb7e 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -1796,20 +1796,11 @@ The value returned is the value of the last form in BODY. | |||
| 1796 | This does not alter the buffer list ordering. | 1796 | This does not alter the buffer list ordering. |
| 1797 | See also `with-temp-buffer'." | 1797 | See also `with-temp-buffer'." |
| 1798 | (declare (indent 1) (debug t)) | 1798 | (declare (indent 1) (debug t)) |
| 1799 | ;; Most of this code is a copy of save-selected-window. | 1799 | `(let ((save-selected-window-window (selected-window))) |
| 1800 | `(let ((save-selected-window-window (selected-window)) | ||
| 1801 | (save-selected-window-alist | ||
| 1802 | (mapcar (lambda (frame) (list frame (frame-selected-window frame))) | ||
| 1803 | (frame-list)))) | ||
| 1804 | (unwind-protect | 1800 | (unwind-protect |
| 1805 | (progn (select-window ,window 'norecord) | 1801 | (progn (select-window ,window 'norecord) |
| 1806 | ,@body) | 1802 | ,@body) |
| 1807 | (dolist (elt save-selected-window-alist) | ||
| 1808 | (and (frame-live-p (car elt)) | ||
| 1809 | (window-live-p (cadr elt)) | ||
| 1810 | (set-frame-selected-window (car elt) (cadr elt)))) | ||
| 1811 | (if (window-live-p save-selected-window-window) | 1803 | (if (window-live-p save-selected-window-window) |
| 1812 | ;; This is where the code differs from save-selected-window. | ||
| 1813 | (select-window save-selected-window-window 'norecord))))) | 1804 | (select-window save-selected-window-window 'norecord))))) |
| 1814 | 1805 | ||
| 1815 | (defmacro with-selected-frame (frame &rest body) | 1806 | (defmacro with-selected-frame (frame &rest body) |
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el index e4f143c3b87..9535d39b1d1 100644 --- a/lisp/textmodes/artist.el +++ b/lisp/textmodes/artist.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; artist.el --- draw ascii graphics with your mouse | 1 | ;;; artist.el --- draw ascii graphics with your mouse |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2000, 2001, 2004 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Tomas Abrahamsson <tab@lysator.liu.se> | 5 | ;; Author: Tomas Abrahamsson <tab@lysator.liu.se> |
| 6 | ;; Maintainer: Tomas Abrahamsson <tab@lysator.liu.se> | 6 | ;; Maintainer: Tomas Abrahamsson <tab@lysator.liu.se> |
| @@ -1698,19 +1698,14 @@ info-variant-part." | |||
| 1698 | (t (cons (car l) (artist-butlast (cdr l)))))) | 1698 | (t (cons (car l) (artist-butlast (cdr l)))))) |
| 1699 | 1699 | ||
| 1700 | 1700 | ||
| 1701 | (defun artist-last (seq &optional n) | 1701 | (defun artist-last (l &optional n) |
| 1702 | "Return the last link in the list SEQ. | 1702 | "Return the last link in the list L. |
| 1703 | With optional argument N, returns Nth-to-last link (default 1)." | 1703 | With optional argument N, returns Nth-to-last link (default 1)." |
| 1704 | (if (not n) | 1704 | (nth (- (length l) (or n 1)) l)) |
| 1705 | (setq n 1)) | ||
| 1706 | (let ((len (length seq))) | ||
| 1707 | (elt seq (- len n)))) | ||
| 1708 | 1705 | ||
| 1709 | (defun artist-remove-nulls (l) | 1706 | (defun artist-remove-nulls (l) |
| 1710 | "Remove nils in list L." | 1707 | "Remove nils in list L." |
| 1711 | (cond ((null l) nil) | 1708 | (remq nil l)) |
| 1712 | ((null (car l)) (artist-remove-nulls (cdr l))) | ||
| 1713 | (t (cons (car l) (artist-remove-nulls (cdr l)))))) | ||
| 1714 | 1709 | ||
| 1715 | (defun artist-uniq (l) | 1710 | (defun artist-uniq (l) |
| 1716 | "Remove consecutive duplicates in list L. Comparison is done with `equal'." | 1711 | "Remove consecutive duplicates in list L. Comparison is done with `equal'." |
| @@ -3368,8 +3363,8 @@ The POINT-LIST is expected to cover the first quadrant." | |||
| 3368 | (append right-half left-half))) | 3363 | (append right-half left-half))) |
| 3369 | 3364 | ||
| 3370 | 3365 | ||
| 3371 | (defun artist-draw-ellipse-general (x y x-radius y-radius) | 3366 | (defun artist-draw-ellipse-general (x1 y1 x-radius y-radius) |
| 3372 | "Draw an ellipse with center at X, Y and X-RADIUS and Y-RADIUS. | 3367 | "Draw an ellipse with center at X1, Y1 and X-RADIUS and Y-RADIUS. |
| 3373 | 3368 | ||
| 3374 | Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO). | 3369 | Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO). |
| 3375 | 3370 | ||
| @@ -3379,15 +3374,15 @@ SHAPE-INFO is a two-element vector on the form [POINT-LIST FILL-INFO]. | |||
| 3379 | POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR]. | 3374 | POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR]. |
| 3380 | FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE]. | 3375 | FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE]. |
| 3381 | 3376 | ||
| 3382 | Ellipses with zero y-radius are not drawn correctly." | 3377 | Ellipses with zero Y-RADIUS are not drawn correctly." |
| 3383 | (let* ((point-list (artist-ellipse-generate-quadrant x-radius y-radius)) | 3378 | (let* ((point-list (artist-ellipse-generate-quadrant x-radius y-radius)) |
| 3384 | (fill-info (artist-ellipse-compute-fill-info point-list)) | 3379 | (fill-info (artist-ellipse-compute-fill-info point-list)) |
| 3385 | (shape-info (make-vector 2 0))) | 3380 | (shape-info (make-vector 2 0))) |
| 3386 | 3381 | ||
| 3387 | (setq point-list (artist-calculate-new-chars point-list)) | 3382 | (setq point-list (artist-calculate-new-chars point-list)) |
| 3388 | (setq point-list (artist-ellipse-mirror-quadrant point-list)) | 3383 | (setq point-list (artist-ellipse-mirror-quadrant point-list)) |
| 3389 | (setq point-list (artist-ellipse-point-list-add-center x y point-list)) | 3384 | (setq point-list (artist-ellipse-point-list-add-center x1 y1 point-list)) |
| 3390 | (setq fill-info (artist-ellipse-fill-info-add-center x y fill-info)) | 3385 | (setq fill-info (artist-ellipse-fill-info-add-center x1 y1 fill-info)) |
| 3391 | 3386 | ||
| 3392 | ;; Draw the ellipse | 3387 | ;; Draw the ellipse |
| 3393 | (setq point-list | 3388 | (setq point-list |
| @@ -3404,12 +3399,12 @@ Ellipses with zero y-radius are not drawn correctly." | |||
| 3404 | 3399 | ||
| 3405 | (aset shape-info 0 point-list) | 3400 | (aset shape-info 0 point-list) |
| 3406 | (aset shape-info 1 fill-info) | 3401 | (aset shape-info 1 fill-info) |
| 3407 | (artist-make-2point-object (artist-make-endpoint x y) | 3402 | (artist-make-2point-object (artist-make-endpoint x1 y1) |
| 3408 | (artist-make-endpoint x-radius y-radius) | 3403 | (artist-make-endpoint x-radius y-radius) |
| 3409 | shape-info))) | 3404 | shape-info))) |
| 3410 | 3405 | ||
| 3411 | (defun artist-draw-ellipse-with-0-height (x y x-radius y-radius) | 3406 | (defun artist-draw-ellipse-with-0-height (x1 y1 x-radius y-radius) |
| 3412 | "Draw an ellipse with center at X, Y and X-RADIUS and Y-RADIUS. | 3407 | "Draw an ellipse with center at X1, Y1 and X-RADIUS and Y-RADIUS. |
| 3413 | 3408 | ||
| 3414 | Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO). | 3409 | Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO). |
| 3415 | 3410 | ||
| @@ -3419,10 +3414,10 @@ SHAPE-INFO is a two-element vector on the form [POINT-LIST FILL-INFO]. | |||
| 3419 | POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR]. | 3414 | POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR]. |
| 3420 | FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE]. | 3415 | FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE]. |
| 3421 | 3416 | ||
| 3422 | The Y-RADIUS must be 0, but the X-RADUIS must not be 0." | 3417 | The Y-RADIUS must be 0, but the X-RADIUS must not be 0." |
| 3423 | (let ((point-list nil) | 3418 | (let ((point-list nil) |
| 3424 | (width (max (- (abs (* 2 x-radius)) 1))) | 3419 | (width (max (- (abs (* 2 x-radius)) 1))) |
| 3425 | (left-edge (1+ (- x (abs x-radius)))) | 3420 | (left-edge (1+ (- x1 (abs x-radius)))) |
| 3426 | (line-char (if artist-line-char-set artist-line-char ?-)) | 3421 | (line-char (if artist-line-char-set artist-line-char ?-)) |
| 3427 | (i 0) | 3422 | (i 0) |
| 3428 | (point-list nil) | 3423 | (point-list nil) |
| @@ -3430,7 +3425,7 @@ The Y-RADIUS must be 0, but the X-RADUIS must not be 0." | |||
| 3430 | (shape-info (make-vector 2 0))) | 3425 | (shape-info (make-vector 2 0))) |
| 3431 | (while (< i width) | 3426 | (while (< i width) |
| 3432 | (let* ((line-x (+ left-edge i)) | 3427 | (let* ((line-x (+ left-edge i)) |
| 3433 | (line-y y) | 3428 | (line-y y1) |
| 3434 | (new-coord (artist-new-coord line-x line-y))) | 3429 | (new-coord (artist-new-coord line-x line-y))) |
| 3435 | (artist-coord-add-saved-char new-coord | 3430 | (artist-coord-add-saved-char new-coord |
| 3436 | (artist-get-char-at-xy line-x line-y)) | 3431 | (artist-get-char-at-xy line-x line-y)) |
| @@ -3440,7 +3435,7 @@ The Y-RADIUS must be 0, but the X-RADUIS must not be 0." | |||
| 3440 | (setq i (1+ i)))) | 3435 | (setq i (1+ i)))) |
| 3441 | (aset shape-info 0 point-list) | 3436 | (aset shape-info 0 point-list) |
| 3442 | (aset shape-info 1 fill-info) | 3437 | (aset shape-info 1 fill-info) |
| 3443 | (artist-make-2point-object (artist-make-endpoint x y) | 3438 | (artist-make-2point-object (artist-make-endpoint x1 y1) |
| 3444 | (artist-make-endpoint x-radius y-radius) | 3439 | (artist-make-endpoint x-radius y-radius) |
| 3445 | shape-info))) | 3440 | shape-info))) |
| 3446 | 3441 | ||
| @@ -3954,7 +3949,7 @@ The 2-point shape SHAPE is drawn from X1, Y1 to X2, Y2." | |||
| 3954 | 3949 | ||
| 3955 | (defun artist-draw-region-trim-line-endings (min-y max-y) | 3950 | (defun artist-draw-region-trim-line-endings (min-y max-y) |
| 3956 | "Trim lines in current draw-region from MIN-Y to MAX-Y. | 3951 | "Trim lines in current draw-region from MIN-Y to MAX-Y. |
| 3957 | Trimming here means removing white space at end of a line" | 3952 | Trimming here means removing white space at end of a line." |
| 3958 | ;; Safetyc check: switch min-y and max-y if if max-y is smaller | 3953 | ;; Safetyc check: switch min-y and max-y if if max-y is smaller |
| 3959 | (if (< max-y min-y) | 3954 | (if (< max-y min-y) |
| 3960 | (let ((tmp min-y)) | 3955 | (let ((tmp min-y)) |
| @@ -4286,7 +4281,7 @@ If optional argument THIS-IS-LAST-POINT is non-nil, this point is the last." | |||
| 4286 | 4281 | ||
| 4287 | (defun artist-key-set-point-common (arg) | 4282 | (defun artist-key-set-point-common (arg) |
| 4288 | "Common routine for setting point in current shape. | 4283 | "Common routine for setting point in current shape. |
| 4289 | With ARG set to t, set the last point." | 4284 | With non-nil ARG, set the last point." |
| 4290 | (let ((draw-how (artist-go-get-draw-how-from-symbol artist-curr-go)) | 4285 | (let ((draw-how (artist-go-get-draw-how-from-symbol artist-curr-go)) |
| 4291 | (col (artist-current-column)) | 4286 | (col (artist-current-column)) |
| 4292 | (row (artist-current-line)) | 4287 | (row (artist-current-line)) |
| @@ -4793,7 +4788,7 @@ If optional argument STATE is positive, turn borders on." | |||
| 4793 | 4788 | ||
| 4794 | 4789 | ||
| 4795 | (defun artist-mouse-choose-operation (ev op) | 4790 | (defun artist-mouse-choose-operation (ev op) |
| 4796 | "Choose operation for evenvt EV and operation OP." | 4791 | "Choose operation for event EV and operation OP." |
| 4797 | (interactive | 4792 | (interactive |
| 4798 | (progn | 4793 | (progn |
| 4799 | (select-window (posn-window (event-start last-input-event))) | 4794 | (select-window (posn-window (event-start last-input-event))) |
diff --git a/lisp/vc-arch.el b/lisp/vc-arch.el index c8efca02832..6c67581a5a8 100644 --- a/lisp/vc-arch.el +++ b/lisp/vc-arch.el | |||
| @@ -375,7 +375,7 @@ Return non-nil if FILE is unchanged." | |||
| 375 | (vc-arch-command nil 0 file "commit" "-s" summary "-L" comment "--" | 375 | (vc-arch-command nil 0 file "commit" "-s" summary "-L" comment "--" |
| 376 | (vc-switches 'Arch 'checkin)))) | 376 | (vc-switches 'Arch 'checkin)))) |
| 377 | 377 | ||
| 378 | (defun vc-arch-diff (file &optional oldvers newvers) | 378 | (defun vc-arch-diff (file &optional oldvers newvers buffer) |
| 379 | "Get a difference report using Arch between two versions of FILE." | 379 | "Get a difference report using Arch between two versions of FILE." |
| 380 | (if (and newvers | 380 | (if (and newvers |
| 381 | (vc-up-to-date-p file) | 381 | (vc-up-to-date-p file) |
| @@ -390,7 +390,7 @@ Return non-nil if FILE is unchanged." | |||
| 390 | (default-directory (vc-arch-root file)) | 390 | (default-directory (vc-arch-root file)) |
| 391 | (status | 391 | (status |
| 392 | (vc-arch-command | 392 | (vc-arch-command |
| 393 | "*vc-diff*" | 393 | (or buffer "*vc-diff*") |
| 394 | (if async 'async 1) | 394 | (if async 'async 1) |
| 395 | nil "file-diffs" | 395 | nil "file-diffs" |
| 396 | ;; Arch does not support the typical flags. | 396 | ;; Arch does not support the typical flags. |
diff --git a/lisp/vc-mcvs.el b/lisp/vc-mcvs.el index 94beb7eb093..5c0bac48b3a 100644 --- a/lisp/vc-mcvs.el +++ b/lisp/vc-mcvs.el | |||
| @@ -438,17 +438,17 @@ The changes are between FIRST-VERSION and SECOND-VERSION." | |||
| 438 | ;;; History functions | 438 | ;;; History functions |
| 439 | ;;; | 439 | ;;; |
| 440 | 440 | ||
| 441 | (defun vc-mcvs-print-log (file) | 441 | (defun vc-mcvs-print-log (file &optional buffer) |
| 442 | "Get change log associated with FILE." | 442 | "Get change log associated with FILE." |
| 443 | (let ((default-directory (vc-mcvs-root file))) | 443 | (let ((default-directory (vc-mcvs-root file))) |
| 444 | ;; Run the command from the root dir so that `mcvs filt' returns | 444 | ;; Run the command from the root dir so that `mcvs filt' returns |
| 445 | ;; valid relative names. | 445 | ;; valid relative names. |
| 446 | (vc-mcvs-command | 446 | (vc-mcvs-command |
| 447 | nil | 447 | buffer |
| 448 | (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0) | 448 | (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0) |
| 449 | file "log"))) | 449 | file "log"))) |
| 450 | 450 | ||
| 451 | (defun vc-mcvs-diff (file &optional oldvers newvers) | 451 | (defun vc-mcvs-diff (file &optional oldvers newvers buffer) |
| 452 | "Get a difference report using Meta-CVS between two versions of FILE." | 452 | "Get a difference report using Meta-CVS between two versions of FILE." |
| 453 | (if (string= (vc-workfile-version file) "0") | 453 | (if (string= (vc-workfile-version file) "0") |
| 454 | ;; This file is added but not yet committed; there is no master file. | 454 | ;; This file is added but not yet committed; there is no master file. |
| @@ -457,7 +457,7 @@ The changes are between FIRST-VERSION and SECOND-VERSION." | |||
| 457 | ;; We regard this as "changed". | 457 | ;; We regard this as "changed". |
| 458 | ;; Diff it against /dev/null. | 458 | ;; Diff it against /dev/null. |
| 459 | ;; Note: this is NOT a "mcvs diff". | 459 | ;; Note: this is NOT a "mcvs diff". |
| 460 | (apply 'vc-do-command "*vc-diff*" | 460 | (apply 'vc-do-command (or buffer "*vc-diff*") |
| 461 | 1 "diff" file | 461 | 1 "diff" file |
| 462 | (append (vc-switches nil 'diff) '("/dev/null"))) | 462 | (append (vc-switches nil 'diff) '("/dev/null"))) |
| 463 | ;; Even if it's empty, it's locally modified. | 463 | ;; Even if it's empty, it's locally modified. |
| @@ -467,7 +467,7 @@ The changes are between FIRST-VERSION and SECOND-VERSION." | |||
| 467 | ;; valid relative names. | 467 | ;; valid relative names. |
| 468 | (default-directory (vc-mcvs-root file)) | 468 | (default-directory (vc-mcvs-root file)) |
| 469 | (status | 469 | (status |
| 470 | (apply 'vc-mcvs-command "*vc-diff*" | 470 | (apply 'vc-mcvs-command (or buffer "*vc-diff*") |
| 471 | (if async 'async 1) | 471 | (if async 'async 1) |
| 472 | file "diff" | 472 | file "diff" |
| 473 | (and oldvers (concat "-r" oldvers)) | 473 | (and oldvers (concat "-r" oldvers)) |
diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index 172af902cb9..4a485414d7a 100644 --- a/lisp/w32-fns.el +++ b/lisp/w32-fns.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; w32-fns.el --- Lisp routines for Windows NT | 1 | ;;; w32-fns.el --- Lisp routines for Windows NT |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1994, 2001 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1994, 2001, 2004 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Geoff Voelker <voelker@cs.washington.edu> | 5 | ;; Author: Geoff Voelker <voelker@cs.washington.edu> |
| 6 | ;; Keywords: internal | 6 | ;; Keywords: internal |
| @@ -54,7 +54,8 @@ numbers, and the build number." | |||
| 54 | (x-server-version)) | 54 | (x-server-version)) |
| 55 | 55 | ||
| 56 | (defun w32-using-nt () | 56 | (defun w32-using-nt () |
| 57 | "Return non-nil if literally running on Windows NT (i.e., not Windows 9X)." | 57 | "Return non-nil if running on a 32-bit Windows system. |
| 58 | That includes all Windows systems except for 9X/Me." | ||
| 58 | (and (eq system-type 'windows-nt) (getenv "SystemRoot"))) | 59 | (and (eq system-type 'windows-nt) (getenv "SystemRoot"))) |
| 59 | 60 | ||
| 60 | (defun w32-shell-name () | 61 | (defun w32-shell-name () |
| @@ -71,7 +72,7 @@ numbers, and the build number." | |||
| 71 | w32-system-shells))) | 72 | w32-system-shells))) |
| 72 | 73 | ||
| 73 | (defun w32-shell-dos-semantics () | 74 | (defun w32-shell-dos-semantics () |
| 74 | "Return t if the interactive shell being used expects msdos shell semantics." | 75 | "Return non-nil if the interactive shell being used expects MSDOS shell semantics." |
| 75 | (or (w32-system-shell-p (w32-shell-name)) | 76 | (or (w32-system-shell-p (w32-shell-name)) |
| 76 | (and (member (downcase (file-name-nondirectory (w32-shell-name))) | 77 | (and (member (downcase (file-name-nondirectory (w32-shell-name))) |
| 77 | '("cmdproxy" "cmdproxy.exe")) | 78 | '("cmdproxy" "cmdproxy.exe")) |
| @@ -265,13 +266,13 @@ with a definition that really does change some file names." | |||
| 265 | (get 'x-selections type)) | 266 | (get 'x-selections type)) |
| 266 | 267 | ||
| 267 | (defun set-w32-system-coding-system (coding-system) | 268 | (defun set-w32-system-coding-system (coding-system) |
| 268 | "Set the coding system used by the Windows System to CODING-SYSTEM. | 269 | "Set the coding system used by the Windows system to CODING-SYSTEM. |
| 269 | This is used for things like passing font names with non-ASCII | 270 | This is used for things like passing font names with non-ASCII |
| 270 | characters in them to the system. For a list of possible values of | 271 | characters in them to the system. For a list of possible values of |
| 271 | CODING-SYSTEM, use \\[list-coding-systems]. | 272 | CODING-SYSTEM, use \\[list-coding-systems]. |
| 272 | 273 | ||
| 273 | This function is provided for backward compatibility, since | 274 | This function is provided for backward compatibility, since |
| 274 | w32-system-coding-system is now an alias for `locale-coding-system'." | 275 | `w32-system-coding-system' is now an alias for `locale-coding-system'." |
| 275 | (interactive | 276 | (interactive |
| 276 | (list (let ((default locale-coding-system)) | 277 | (list (let ((default locale-coding-system)) |
| 277 | (read-coding-system | 278 | (read-coding-system |
diff --git a/man/ChangeLog b/man/ChangeLog index 30247e10435..ffd8bae6a2e 100644 --- a/man/ChangeLog +++ b/man/ChangeLog | |||
| @@ -1,3 +1,12 @@ | |||
| 1 | 2004-05-28 Simon Josefsson <jas@extundo.com> | ||
| 2 | |||
| 3 | * smtpmail.texi (Authentication): Improve STARTTLS discussion. | ||
| 4 | |||
| 5 | 2004-05-27 Luc Teirlinck <teirllm@auburn.edu> | ||
| 6 | |||
| 7 | * dired.texi (Dired and Find): `find-ls-option' does not apply to | ||
| 8 | `M-x locate'. | ||
| 9 | |||
| 1 | 2004-05-16 Karl Berry <karl@gnu.org> | 10 | 2004-05-16 Karl Berry <karl@gnu.org> |
| 2 | 11 | ||
| 3 | * emacs.texi (ack.texi) [@ifnottex]: Change condition; with @ifinfo, | 12 | * emacs.texi (ack.texi) [@ifnottex]: Change condition; with @ifinfo, |
diff --git a/man/dired.texi b/man/dired.texi index 88e994ed027..fd269811b9f 100644 --- a/man/dired.texi +++ b/man/dired.texi | |||
| @@ -1079,6 +1079,12 @@ minibuffer arguments, @var{directory} and @var{find-args}; it runs | |||
| 1079 | @code{find} what condition to test. To use this command, you need to | 1079 | @code{find} what condition to test. To use this command, you need to |
| 1080 | know how to use @code{find}. | 1080 | know how to use @code{find}. |
| 1081 | 1081 | ||
| 1082 | @vindex find-ls-option | ||
| 1083 | The format of listing produced by these commands is controlled by the | ||
| 1084 | variable @code{find-ls-option}, whose default value specifies using | ||
| 1085 | options @samp{-ld} for @code{ls}. If your listings are corrupted, you | ||
| 1086 | may need to change the value of this variable. | ||
| 1087 | |||
| 1082 | @findex locate | 1088 | @findex locate |
| 1083 | @findex locate-with-filter | 1089 | @findex locate-with-filter |
| 1084 | @cindex file database (locate) | 1090 | @cindex file database (locate) |
| @@ -1087,12 +1093,6 @@ know how to use @code{find}. | |||
| 1087 | program. @kbd{M-x locate-with-filter} is similar, but keeps only lines | 1093 | program. @kbd{M-x locate-with-filter} is similar, but keeps only lines |
| 1088 | matching a given regular expression. | 1094 | matching a given regular expression. |
| 1089 | 1095 | ||
| 1090 | @vindex find-ls-option | ||
| 1091 | The format of listing produced by these commands is controlled by the | ||
| 1092 | variable @code{find-ls-option}, whose default value specifies using | ||
| 1093 | options @samp{-ld} for @code{ls}. If your listings are corrupted, you | ||
| 1094 | may need to change the value of this variable. | ||
| 1095 | |||
| 1096 | @node Misc Dired Commands | 1096 | @node Misc Dired Commands |
| 1097 | @section Other Dired Commands | 1097 | @section Other Dired Commands |
| 1098 | 1098 | ||
diff --git a/man/smtpmail.texi b/man/smtpmail.texi index 08ce87ac995..6efe6f71630 100644 --- a/man/smtpmail.texi +++ b/man/smtpmail.texi | |||
| @@ -215,13 +215,30 @@ variables contains the authentication information needed for this. | |||
| 215 | The first variable, @code{smtpmail-auth-credentials}, instructs the | 215 | The first variable, @code{smtpmail-auth-credentials}, instructs the |
| 216 | SMTP library to use a SASL authentication step, currently only the | 216 | SMTP library to use a SASL authentication step, currently only the |
| 217 | CRAM-MD5 and LOGIN mechanisms are supported and will be selected in | 217 | CRAM-MD5 and LOGIN mechanisms are supported and will be selected in |
| 218 | that order if the server supports them. The second variable, | 218 | that order if the server support both. |
| 219 | @code{smtpmail-starttls-credentials}, instructs the SMTP library to | 219 | |
| 220 | connect to the server using STARTTLS. This means the protocol | 220 | The second variable, @code{smtpmail-starttls-credentials}, instructs |
| 221 | exchange can be integrity protected and confidential by using TLS, and | 221 | the SMTP library to connect to the server using STARTTLS. This means |
| 222 | optionally also authentication of the client. It is common to use | 222 | the protocol exchange may be integrity protected and confidential by |
| 223 | both these mechanisms, e.g., to use STARTTLS to achieve integrity and | 223 | using TLS, and optionally also authentication of the client. This |
| 224 | confidentiality and then use SASL for client authentication. | 224 | feature uses the elisp package @file{starttls.el} (see it for more |
| 225 | information on customization), which in turn require that at least one | ||
| 226 | of the following external tools are installed: | ||
| 227 | |||
| 228 | @enumerate | ||
| 229 | @item | ||
| 230 | The GNUTLS command line tool @samp{gnutls-cli}, you can get it from | ||
| 231 | @url{http://www.gnu.org/software/gnutls/}. This is the recommended | ||
| 232 | tool, mainly because it can verify the server certificates. | ||
| 233 | |||
| 234 | @item | ||
| 235 | The @samp{starttls} external program, you can get it from | ||
| 236 | @file{starttls-*.tar.gz} from @uref{ftp://ftp.opaopa.org/pub/elisp/}. | ||
| 237 | @end enumerate | ||
| 238 | |||
| 239 | It is not uncommon to use both these mechanisms, e.g., to use STARTTLS | ||
| 240 | to achieve integrity and confidentiality and then use SASL for client | ||
| 241 | authentication. | ||
| 225 | 242 | ||
| 226 | @table @code | 243 | @table @code |
| 227 | @item smtpmail-auth-credentials | 244 | @item smtpmail-auth-credentials |
| @@ -231,11 +248,13 @@ hostname, port, username and password tuples. When the SMTP library | |||
| 231 | connects to a host on a certain port, this variable is searched to | 248 | connects to a host on a certain port, this variable is searched to |
| 232 | find a matching entry for that hostname and port. If an entry is | 249 | find a matching entry for that hostname and port. If an entry is |
| 233 | found, the authentication process is invoked and the credentials are | 250 | found, the authentication process is invoked and the credentials are |
| 234 | used. The hostname field follows the same format as | 251 | used. |
| 252 | |||
| 253 | The hostname field follows the same format as | ||
| 235 | @code{smtpmail-smtp-server} (i.e., a string) and the port field the | 254 | @code{smtpmail-smtp-server} (i.e., a string) and the port field the |
| 236 | same format as @code{smtpmail-smtp-service} (i.e., a string or an | 255 | same format as @code{smtpmail-smtp-service} (i.e., a string or an |
| 237 | integer). The username and password fields, which either can be | 256 | integer). The username and password fields, which either can be |
| 238 | @code{nil} to indicate that the user is queried for the value | 257 | @code{nil} to indicate that the user is prompted for the value |
| 239 | interactively, should be strings with the username and password, | 258 | interactively, should be strings with the username and password, |
| 240 | respectively, information that is normally provided by system | 259 | respectively, information that is normally provided by system |
| 241 | administrators. | 260 | administrators. |
| @@ -246,10 +265,7 @@ administrators. | |||
| 246 | tuples with hostname, port, name of file containing client key, and | 265 | tuples with hostname, port, name of file containing client key, and |
| 247 | name of file containing client certificate. The processing is similar | 266 | name of file containing client certificate. The processing is similar |
| 248 | to the previous variable. The client key and certificate may be | 267 | to the previous variable. The client key and certificate may be |
| 249 | @code{nil} if you do not wish to use client authentication. The use | 268 | @code{nil} if you do not wish to use client authentication. |
| 250 | of this variable requires the @samp{starttls} external program to be | ||
| 251 | installed, you can get @file{starttls-*.tar.gz} from | ||
| 252 | @uref{ftp://ftp.opaopa.org/pub/elisp/}. | ||
| 253 | @end table | 269 | @end table |
| 254 | 270 | ||
| 255 | The following example illustrates what you could put in | 271 | The following example illustrates what you could put in |
diff --git a/src/.arch-inventory b/src/.arch-inventory new file mode 100644 index 00000000000..9f6d601a788 --- /dev/null +++ b/src/.arch-inventory | |||
| @@ -0,0 +1,3 @@ | |||
| 1 | precious ^(config\.stamp|config\.h|epaths\.h)$ | ||
| 2 | |||
| 3 | # arch-tag: 277cc7ae-b3f5-44af-abf1-84c073164543 | ||
diff --git a/src/ChangeLog b/src/ChangeLog index f15b1e582d9..df10f95e500 100644 --- a/src/ChangeLog +++ b/src/ChangeLog | |||
| @@ -1,3 +1,35 @@ | |||
| 1 | 2004-05-28 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * alloc.c: Undo Kim's recent changes and fix the same bug differently. | ||
| 4 | (marker_blocks_pending_free): Remove. | ||
| 5 | (Fgarbage_collect): Sweep after cleaning up undo-lists. | ||
| 6 | Mark the undo lists after claning them up. | ||
| 7 | Don't free block in marker_blocks_pending_free. | ||
| 8 | (mark_buffer): Don't mark undo_list. | ||
| 9 | (gc_sweep): Sweep hash-tables and strings first. | ||
| 10 | Do free marker blocks that are empty. | ||
| 11 | |||
| 12 | 2004-05-28 Jim Blandy <jimb@redhat.com> | ||
| 13 | |||
| 14 | * regex.c (print_partial_compiled_pattern): Add missing 'break' | ||
| 15 | after 'case wordend'. For symbeg and symend, print to stderr, | ||
| 16 | like the other cases. | ||
| 17 | |||
| 18 | 2004-05-28 Noah Friedman <friedman@splode.com> | ||
| 19 | |||
| 20 | * process.c (Fdelete_process): Do not call remove_process. | ||
| 21 | |||
| 22 | 2004-05-28 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 23 | |||
| 24 | * alloc.c (struct backtrace): Remove. | ||
| 25 | (Fgarbage_collect): Use the new mark_backtrace. | ||
| 26 | |||
| 27 | * eval.c (mark_backtrace): New function. | ||
| 28 | |||
| 29 | * minibuf.c (run_exit_minibuf_hook): New function. | ||
| 30 | (read_minibuf_unwind): Don't run exit-minibuffer-hook any more. | ||
| 31 | (read_minibuf): Use separate unwind handler to run exit-minibuf-hook. | ||
| 32 | |||
| 1 | 2004-05-27 Kim F. Storm <storm@cua.dk> | 33 | 2004-05-27 Kim F. Storm <storm@cua.dk> |
| 2 | 34 | ||
| 3 | * xdisp.c (back_to_previous_visible_line_start): Skip backwards | 35 | * xdisp.c (back_to_previous_visible_line_start): Skip backwards |
| @@ -15,8 +47,8 @@ | |||
| 15 | 47 | ||
| 16 | 2004-05-23 K,Ba(Broly L,Bu(Brentey <lorentey@elte.hu> (tiny change) | 48 | 2004-05-23 K,Ba(Broly L,Bu(Brentey <lorentey@elte.hu> (tiny change) |
| 17 | 49 | ||
| 18 | * coding.c (Fset_safe_terminal_coding_system_internal): Set | 50 | * coding.c (Fset_safe_terminal_coding_system_internal): |
| 19 | suppress_error in safe_terminal_coding, not terminal_coding. | 51 | Set suppress_error in safe_terminal_coding, not terminal_coding. |
| 20 | 52 | ||
| 21 | 2004-05-22 Richard M. Stallman <rms@gnu.org> | 53 | 2004-05-22 Richard M. Stallman <rms@gnu.org> |
| 22 | 54 | ||
| @@ -71,7 +103,7 @@ | |||
| 71 | (re_opcode_t): New opcodes `symbeg' and `symend'. | 103 | (re_opcode_t): New opcodes `symbeg' and `symend'. |
| 72 | (print_partial_compiled_pattern): Print the new opcodes properly. | 104 | (print_partial_compiled_pattern): Print the new opcodes properly. |
| 73 | (regex_compile): Parse the new operators. | 105 | (regex_compile): Parse the new operators. |
| 74 | (analyse_first): Skip symbeg and symend (they match only the empty string). | 106 | (analyse_first): Skip sym(beg|end) (they match only the empty string). |
| 75 | (mutually_exclusive_p): `symend' is mutually exclusive with \s_ and | 107 | (mutually_exclusive_p): `symend' is mutually exclusive with \s_ and |
| 76 | \sw; `symbeg' is mutually exclusive with \S_ and \Sw. | 108 | \sw; `symbeg' is mutually exclusive with \S_ and \Sw. |
| 77 | (re_match_2_internal): Match symbeg and symend. | 109 | (re_match_2_internal): Match symbeg and symend. |
diff --git a/src/alloc.c b/src/alloc.c index 1d50f19e921..adedb414aad 100644 --- a/src/alloc.c +++ b/src/alloc.c | |||
| @@ -257,6 +257,7 @@ EMACS_INT gcs_done; /* accumulated GCs */ | |||
| 257 | static void mark_buffer P_ ((Lisp_Object)); | 257 | static void mark_buffer P_ ((Lisp_Object)); |
| 258 | extern void mark_kboards P_ ((void)); | 258 | extern void mark_kboards P_ ((void)); |
| 259 | extern void mark_ttys P_ ((void)); | 259 | extern void mark_ttys P_ ((void)); |
| 260 | extern void mark_backtrace P_ ((void)); | ||
| 260 | static void gc_sweep P_ ((void)); | 261 | static void gc_sweep P_ ((void)); |
| 261 | static void mark_glyph_matrix P_ ((struct glyph_matrix *)); | 262 | static void mark_glyph_matrix P_ ((struct glyph_matrix *)); |
| 262 | static void mark_face_cache P_ ((struct face_cache *)); | 263 | static void mark_face_cache P_ ((struct face_cache *)); |
| @@ -2866,10 +2867,6 @@ int marker_block_index; | |||
| 2866 | 2867 | ||
| 2867 | union Lisp_Misc *marker_free_list; | 2868 | union Lisp_Misc *marker_free_list; |
| 2868 | 2869 | ||
| 2869 | /* Marker blocks which should be freed at end of GC. */ | ||
| 2870 | |||
| 2871 | struct marker_block *marker_blocks_pending_free; | ||
| 2872 | |||
| 2873 | /* Total number of marker blocks now in use. */ | 2870 | /* Total number of marker blocks now in use. */ |
| 2874 | 2871 | ||
| 2875 | int n_marker_blocks; | 2872 | int n_marker_blocks; |
| @@ -2880,7 +2877,6 @@ init_marker () | |||
| 2880 | marker_block = NULL; | 2877 | marker_block = NULL; |
| 2881 | marker_block_index = MARKER_BLOCK_SIZE; | 2878 | marker_block_index = MARKER_BLOCK_SIZE; |
| 2882 | marker_free_list = 0; | 2879 | marker_free_list = 0; |
| 2883 | marker_blocks_pending_free = 0; | ||
| 2884 | n_marker_blocks = 0; | 2880 | n_marker_blocks = 0; |
| 2885 | } | 2881 | } |
| 2886 | 2882 | ||
| @@ -4283,20 +4279,6 @@ struct catchtag | |||
| 4283 | struct catchtag *next; | 4279 | struct catchtag *next; |
| 4284 | }; | 4280 | }; |
| 4285 | 4281 | ||
| 4286 | struct backtrace | ||
| 4287 | { | ||
| 4288 | struct backtrace *next; | ||
| 4289 | Lisp_Object *function; | ||
| 4290 | Lisp_Object *args; /* Points to vector of args. */ | ||
| 4291 | int nargs; /* Length of vector. */ | ||
| 4292 | /* If nargs is UNEVALLED, args points to slot holding list of | ||
| 4293 | unevalled args. */ | ||
| 4294 | char evalargs; | ||
| 4295 | /* Nonzero means call value of debugger when done with this operation. */ | ||
| 4296 | char debug_on_exit; | ||
| 4297 | }; | ||
| 4298 | |||
| 4299 | |||
| 4300 | 4282 | ||
| 4301 | /*********************************************************************** | 4283 | /*********************************************************************** |
| 4302 | Protection from GC | 4284 | Protection from GC |
| @@ -4331,7 +4313,6 @@ returns nil, because real GC can't be done. */) | |||
| 4331 | register struct specbinding *bind; | 4313 | register struct specbinding *bind; |
| 4332 | struct catchtag *catch; | 4314 | struct catchtag *catch; |
| 4333 | struct handler *handler; | 4315 | struct handler *handler; |
| 4334 | register struct backtrace *backlist; | ||
| 4335 | char stack_top_variable; | 4316 | char stack_top_variable; |
| 4336 | register int i; | 4317 | register int i; |
| 4337 | int message_p; | 4318 | int message_p; |
| @@ -4460,17 +4441,7 @@ returns nil, because real GC can't be done. */) | |||
| 4460 | mark_object (handler->handler); | 4441 | mark_object (handler->handler); |
| 4461 | mark_object (handler->var); | 4442 | mark_object (handler->var); |
| 4462 | } | 4443 | } |
| 4463 | for (backlist = backtrace_list; backlist; backlist = backlist->next) | 4444 | mark_backtrace (); |
| 4464 | { | ||
| 4465 | mark_object (*backlist->function); | ||
| 4466 | |||
| 4467 | if (backlist->nargs == UNEVALLED || backlist->nargs == MANY) | ||
| 4468 | i = 0; | ||
| 4469 | else | ||
| 4470 | i = backlist->nargs - 1; | ||
| 4471 | for (; i >= 0; i--) | ||
| 4472 | mark_object (backlist->args[i]); | ||
| 4473 | } | ||
| 4474 | mark_kboards (); | 4445 | mark_kboards (); |
| 4475 | mark_ttys (); | 4446 | mark_ttys (); |
| 4476 | 4447 | ||
| @@ -4485,42 +4456,36 @@ returns nil, because real GC can't be done. */) | |||
| 4485 | } | 4456 | } |
| 4486 | #endif | 4457 | #endif |
| 4487 | 4458 | ||
| 4488 | gc_sweep (); | 4459 | /* Everything is now marked, except for the things that require special |
| 4489 | 4460 | finalization, i.e. the undo_list. | |
| 4490 | /* Look thru every buffer's undo list for elements that used to | 4461 | Look thru every buffer's undo list |
| 4491 | contain update markers that were changed to Lisp_Misc_Free | 4462 | for elements that update markers that were not marked, |
| 4492 | objects and delete them. This may leave a few cons cells | 4463 | and delete them. */ |
| 4493 | unchained, but we will get those on the next sweep. */ | ||
| 4494 | { | 4464 | { |
| 4495 | register struct buffer *nextb = all_buffers; | 4465 | register struct buffer *nextb = all_buffers; |
| 4496 | 4466 | ||
| 4497 | while (nextb) | 4467 | while (nextb) |
| 4498 | { | 4468 | { |
| 4499 | /* If a buffer's undo list is Qt, that means that undo is | 4469 | /* If a buffer's undo list is Qt, that means that undo is |
| 4500 | turned off in that buffer. */ | 4470 | turned off in that buffer. Calling truncate_undo_list on |
| 4471 | Qt tends to return NULL, which effectively turns undo back on. | ||
| 4472 | So don't call truncate_undo_list if undo_list is Qt. */ | ||
| 4501 | if (! EQ (nextb->undo_list, Qt)) | 4473 | if (! EQ (nextb->undo_list, Qt)) |
| 4502 | { | 4474 | { |
| 4503 | Lisp_Object tail, prev, elt, car; | 4475 | Lisp_Object tail, prev; |
| 4504 | tail = nextb->undo_list; | 4476 | tail = nextb->undo_list; |
| 4505 | prev = Qnil; | 4477 | prev = Qnil; |
| 4506 | while (CONSP (tail)) | 4478 | while (CONSP (tail)) |
| 4507 | { | 4479 | { |
| 4508 | if ((elt = XCAR (tail), GC_CONSP (elt)) | 4480 | if (GC_CONSP (XCAR (tail)) |
| 4509 | && (car = XCAR (elt), GC_MISCP (car)) | 4481 | && GC_MARKERP (XCAR (XCAR (tail))) |
| 4510 | && XMISCTYPE (car) == Lisp_Misc_Free) | 4482 | && !XMARKER (XCAR (XCAR (tail)))->gcmarkbit) |
| 4511 | { | 4483 | { |
| 4512 | Lisp_Object cdr = XCDR (tail); | ||
| 4513 | /* Do not use free_cons here, as we don't know if | ||
| 4514 | anybody else has a pointer to these conses. */ | ||
| 4515 | XSETCAR (elt, Qnil); | ||
| 4516 | XSETCDR (elt, Qnil); | ||
| 4517 | XSETCAR (tail, Qnil); | ||
| 4518 | XSETCDR (tail, Qnil); | ||
| 4519 | if (NILP (prev)) | 4484 | if (NILP (prev)) |
| 4520 | nextb->undo_list = tail = cdr; | 4485 | nextb->undo_list = tail = XCDR (tail); |
| 4521 | else | 4486 | else |
| 4522 | { | 4487 | { |
| 4523 | tail = cdr; | 4488 | tail = XCDR (tail); |
| 4524 | XSETCDR (prev, tail); | 4489 | XSETCDR (prev, tail); |
| 4525 | } | 4490 | } |
| 4526 | } | 4491 | } |
| @@ -4531,22 +4496,15 @@ returns nil, because real GC can't be done. */) | |||
| 4531 | } | 4496 | } |
| 4532 | } | 4497 | } |
| 4533 | } | 4498 | } |
| 4499 | /* Now that we have stripped the elements that need not be in the | ||
| 4500 | undo_list any more, we can finally mark the list. */ | ||
| 4501 | mark_object (nextb->undo_list); | ||
| 4534 | 4502 | ||
| 4535 | nextb = nextb->next; | 4503 | nextb = nextb->next; |
| 4536 | } | 4504 | } |
| 4537 | } | 4505 | } |
| 4538 | 4506 | ||
| 4539 | /* Undo lists have been cleaned up, so we can free marker blocks now. */ | 4507 | gc_sweep (); |
| 4540 | |||
| 4541 | { | ||
| 4542 | struct marker_block *mblk; | ||
| 4543 | |||
| 4544 | while ((mblk = marker_blocks_pending_free) != 0) | ||
| 4545 | { | ||
| 4546 | marker_blocks_pending_free = mblk->next; | ||
| 4547 | lisp_free (mblk); | ||
| 4548 | } | ||
| 4549 | } | ||
| 4550 | 4508 | ||
| 4551 | /* Clear the mark bits that we set in certain root slots. */ | 4509 | /* Clear the mark bits that we set in certain root slots. */ |
| 4552 | 4510 | ||
| @@ -5114,41 +5072,9 @@ mark_buffer (buf) | |||
| 5114 | 5072 | ||
| 5115 | MARK_INTERVAL_TREE (BUF_INTERVALS (buffer)); | 5073 | MARK_INTERVAL_TREE (BUF_INTERVALS (buffer)); |
| 5116 | 5074 | ||
| 5117 | if (CONSP (buffer->undo_list)) | 5075 | /* For now, we just don't mark the undo_list. It's done later in |
| 5118 | { | 5076 | a special way just before the sweep phase, and after stripping |
| 5119 | Lisp_Object tail; | 5077 | some of its elements that are not needed any more. */ |
| 5120 | tail = buffer->undo_list; | ||
| 5121 | |||
| 5122 | /* We mark the undo list specially because | ||
| 5123 | its pointers to markers should be weak. */ | ||
| 5124 | |||
| 5125 | while (CONSP (tail)) | ||
| 5126 | { | ||
| 5127 | register struct Lisp_Cons *ptr = XCONS (tail); | ||
| 5128 | |||
| 5129 | if (CONS_MARKED_P (ptr)) | ||
| 5130 | break; | ||
| 5131 | CONS_MARK (ptr); | ||
| 5132 | if (GC_CONSP (ptr->car) | ||
| 5133 | && !CONS_MARKED_P (XCONS (ptr->car)) | ||
| 5134 | && GC_MARKERP (XCAR (ptr->car))) | ||
| 5135 | { | ||
| 5136 | CONS_MARK (XCONS (ptr->car)); | ||
| 5137 | mark_object (XCDR (ptr->car)); | ||
| 5138 | } | ||
| 5139 | else | ||
| 5140 | mark_object (ptr->car); | ||
| 5141 | |||
| 5142 | if (CONSP (ptr->cdr)) | ||
| 5143 | tail = ptr->cdr; | ||
| 5144 | else | ||
| 5145 | break; | ||
| 5146 | } | ||
| 5147 | |||
| 5148 | mark_object (XCDR (tail)); | ||
| 5149 | } | ||
| 5150 | else | ||
| 5151 | mark_object (buffer->undo_list); | ||
| 5152 | 5078 | ||
| 5153 | if (buffer->overlays_before) | 5079 | if (buffer->overlays_before) |
| 5154 | { | 5080 | { |
| @@ -5228,6 +5154,16 @@ survives_gc_p (obj) | |||
| 5228 | static void | 5154 | static void |
| 5229 | gc_sweep () | 5155 | gc_sweep () |
| 5230 | { | 5156 | { |
| 5157 | /* Remove or mark entries in weak hash tables. | ||
| 5158 | This must be done before any object is unmarked. */ | ||
| 5159 | sweep_weak_hash_tables (); | ||
| 5160 | |||
| 5161 | sweep_strings (); | ||
| 5162 | #ifdef GC_CHECK_STRING_BYTES | ||
| 5163 | if (!noninteractive) | ||
| 5164 | check_string_bytes (1); | ||
| 5165 | #endif | ||
| 5166 | |||
| 5231 | /* Put all unmarked conses on free list */ | 5167 | /* Put all unmarked conses on free list */ |
| 5232 | { | 5168 | { |
| 5233 | register struct cons_block *cblk; | 5169 | register struct cons_block *cblk; |
| @@ -5278,16 +5214,6 @@ gc_sweep () | |||
| 5278 | total_free_conses = num_free; | 5214 | total_free_conses = num_free; |
| 5279 | } | 5215 | } |
| 5280 | 5216 | ||
| 5281 | /* Remove or mark entries in weak hash tables. | ||
| 5282 | This must be done before any object is unmarked. */ | ||
| 5283 | sweep_weak_hash_tables (); | ||
| 5284 | |||
| 5285 | sweep_strings (); | ||
| 5286 | #ifdef GC_CHECK_STRING_BYTES | ||
| 5287 | if (!noninteractive) | ||
| 5288 | check_string_bytes (1); | ||
| 5289 | #endif | ||
| 5290 | |||
| 5291 | /* Put all unmarked floats on free list */ | 5217 | /* Put all unmarked floats on free list */ |
| 5292 | { | 5218 | { |
| 5293 | register struct float_block *fblk; | 5219 | register struct float_block *fblk; |
| @@ -5456,7 +5382,6 @@ gc_sweep () | |||
| 5456 | register int num_free = 0, num_used = 0; | 5382 | register int num_free = 0, num_used = 0; |
| 5457 | 5383 | ||
| 5458 | marker_free_list = 0; | 5384 | marker_free_list = 0; |
| 5459 | marker_blocks_pending_free = 0; | ||
| 5460 | 5385 | ||
| 5461 | for (mblk = marker_block; mblk; mblk = *mprev) | 5386 | for (mblk = marker_block; mblk; mblk = *mprev) |
| 5462 | { | 5387 | { |
| @@ -5492,13 +5417,8 @@ gc_sweep () | |||
| 5492 | *mprev = mblk->next; | 5417 | *mprev = mblk->next; |
| 5493 | /* Unhook from the free list. */ | 5418 | /* Unhook from the free list. */ |
| 5494 | marker_free_list = mblk->markers[0].u_free.chain; | 5419 | marker_free_list = mblk->markers[0].u_free.chain; |
| 5420 | lisp_free (mblk); | ||
| 5495 | n_marker_blocks--; | 5421 | n_marker_blocks--; |
| 5496 | |||
| 5497 | /* It is not safe to free the marker block at this stage, | ||
| 5498 | since there may still be pointers to these markers from | ||
| 5499 | a buffer's undo list. KFS 2004-05-25. */ | ||
| 5500 | mblk->next = marker_blocks_pending_free; | ||
| 5501 | marker_blocks_pending_free = mblk; | ||
| 5502 | } | 5422 | } |
| 5503 | else | 5423 | else |
| 5504 | { | 5424 | { |
diff --git a/src/eval.c b/src/eval.c index 0326a828a81..921a7533a60 100644 --- a/src/eval.c +++ b/src/eval.c | |||
| @@ -3243,6 +3243,25 @@ If NFRAMES is more than the number of frames, the value is nil. */) | |||
| 3243 | 3243 | ||
| 3244 | 3244 | ||
| 3245 | void | 3245 | void |
| 3246 | mark_backtrace () | ||
| 3247 | { | ||
| 3248 | register struct backtrace *backlist; | ||
| 3249 | register int i; | ||
| 3250 | |||
| 3251 | for (backlist = backtrace_list; backlist; backlist = backlist->next) | ||
| 3252 | { | ||
| 3253 | mark_object (*backlist->function); | ||
| 3254 | |||
| 3255 | if (backlist->nargs == UNEVALLED || backlist->nargs == MANY) | ||
| 3256 | i = 0; | ||
| 3257 | else | ||
| 3258 | i = backlist->nargs - 1; | ||
| 3259 | for (; i >= 0; i--) | ||
| 3260 | mark_object (backlist->args[i]); | ||
| 3261 | } | ||
| 3262 | } | ||
| 3263 | |||
| 3264 | void | ||
| 3246 | syms_of_eval () | 3265 | syms_of_eval () |
| 3247 | { | 3266 | { |
| 3248 | DEFVAR_INT ("max-specpdl-size", &max_specpdl_size, | 3267 | DEFVAR_INT ("max-specpdl-size", &max_specpdl_size, |
diff --git a/src/minibuf.c b/src/minibuf.c index 1f5a114540d..8ed19516080 100644 --- a/src/minibuf.c +++ b/src/minibuf.c | |||
| @@ -1,5 +1,5 @@ | |||
| 1 | /* Minibuffer input and completion. | 1 | /* Minibuffer input and completion. |
| 2 | Copyright (C) 1985,86,93,94,95,96,97,98,99,2000,01,03 | 2 | Copyright (C) 1985,86,93,94,95,96,97,98,99,2000,01,03,04 |
| 3 | Free Software Foundation, Inc. | 3 | Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | This file is part of GNU Emacs. | 5 | This file is part of GNU Emacs. |
| @@ -210,6 +210,7 @@ without invoking the usual minibuffer commands. */) | |||
| 210 | /* Actual minibuffer invocation. */ | 210 | /* Actual minibuffer invocation. */ |
| 211 | 211 | ||
| 212 | static Lisp_Object read_minibuf_unwind P_ ((Lisp_Object)); | 212 | static Lisp_Object read_minibuf_unwind P_ ((Lisp_Object)); |
| 213 | static Lisp_Object run_exit_minibuf_hook P_ ((Lisp_Object)); | ||
| 213 | static Lisp_Object read_minibuf P_ ((Lisp_Object, Lisp_Object, | 214 | static Lisp_Object read_minibuf P_ ((Lisp_Object, Lisp_Object, |
| 214 | Lisp_Object, Lisp_Object, | 215 | Lisp_Object, Lisp_Object, |
| 215 | int, Lisp_Object, | 216 | int, Lisp_Object, |
| @@ -564,6 +565,12 @@ read_minibuf (map, initial, prompt, backup_n, expflag, | |||
| 564 | 565 | ||
| 565 | record_unwind_protect (read_minibuf_unwind, Qnil); | 566 | record_unwind_protect (read_minibuf_unwind, Qnil); |
| 566 | minibuf_level++; | 567 | minibuf_level++; |
| 568 | /* We are exiting the minibuffer one way or the other, so run the hook. | ||
| 569 | It should be run before unwinding the minibuf settings. Do it | ||
| 570 | separately from read_minibuf_unwind because we need to make sure that | ||
| 571 | read_minibuf_unwind is fully executed even if exit-minibuffer-hook | ||
| 572 | signals an error. --Stef */ | ||
| 573 | record_unwind_protect (run_exit_minibuf_hook, Qnil); | ||
| 567 | 574 | ||
| 568 | /* Now that we can restore all those variables, start changing them. */ | 575 | /* Now that we can restore all those variables, start changing them. */ |
| 569 | 576 | ||
| @@ -827,6 +834,17 @@ get_minibuffer (depth) | |||
| 827 | return buf; | 834 | return buf; |
| 828 | } | 835 | } |
| 829 | 836 | ||
| 837 | static Lisp_Object | ||
| 838 | run_exit_minibuf_hook (data) | ||
| 839 | Lisp_Object data; | ||
| 840 | { | ||
| 841 | if (!NILP (Vminibuffer_exit_hook) && !EQ (Vminibuffer_exit_hook, Qunbound) | ||
| 842 | && !NILP (Vrun_hooks)) | ||
| 843 | safe_run_hooks (Qminibuffer_exit_hook); | ||
| 844 | |||
| 845 | return Qnil; | ||
| 846 | } | ||
| 847 | |||
| 830 | /* This function is called on exiting minibuffer, whether normally or | 848 | /* This function is called on exiting minibuffer, whether normally or |
| 831 | not, and it restores the current window, buffer, etc. */ | 849 | not, and it restores the current window, buffer, etc. */ |
| 832 | 850 | ||
| @@ -837,12 +855,6 @@ read_minibuf_unwind (data) | |||
| 837 | Lisp_Object old_deactivate_mark; | 855 | Lisp_Object old_deactivate_mark; |
| 838 | Lisp_Object window; | 856 | Lisp_Object window; |
| 839 | 857 | ||
| 840 | /* We are exiting the minibuffer one way or the other, | ||
| 841 | so run the hook. */ | ||
| 842 | if (!NILP (Vminibuffer_exit_hook) && !EQ (Vminibuffer_exit_hook, Qunbound) | ||
| 843 | && !NILP (Vrun_hooks)) | ||
| 844 | safe_run_hooks (Qminibuffer_exit_hook); | ||
| 845 | |||
| 846 | /* If this was a recursive minibuffer, | 858 | /* If this was a recursive minibuffer, |
| 847 | tie the minibuffer window back to the outer level minibuffer buffer. */ | 859 | tie the minibuffer window back to the outer level minibuffer buffer. */ |
| 848 | minibuf_level--; | 860 | minibuf_level--; |
diff --git a/src/process.c b/src/process.c index 9d76b5bd1f9..c05bcbf88d5 100644 --- a/src/process.c +++ b/src/process.c | |||
| @@ -774,7 +774,18 @@ nil, indicating the current buffer's process. */) | |||
| 774 | XSETINT (XPROCESS (process)->tick, ++process_tick); | 774 | XSETINT (XPROCESS (process)->tick, ++process_tick); |
| 775 | status_notify (); | 775 | status_notify (); |
| 776 | } | 776 | } |
| 777 | remove_process (process); | 777 | /* Do not call remove_process here; either status_notify has already done |
| 778 | it, or will do so the next time emacs polls for input. Thus network | ||
| 779 | processes are not immediately removed, and their sentinel will be | ||
| 780 | called. | ||
| 781 | |||
| 782 | Since Fdelete_process is called by kill_buffer_processes, this also | ||
| 783 | means that a network process sentinel will run after the buffer is | ||
| 784 | dead, which would not be the case if status_notify() were called | ||
| 785 | unconditionally here. This way process sentinels observe consistent | ||
| 786 | behavior with regard to buffer-live-p. | ||
| 787 | */ | ||
| 788 | /* remove_process (process); */ | ||
| 778 | return Qnil; | 789 | return Qnil; |
| 779 | } | 790 | } |
| 780 | 791 | ||
diff --git a/src/regex.c b/src/regex.c index 0c1343bf584..db69275c312 100644 --- a/src/regex.c +++ b/src/regex.c | |||
| @@ -1096,13 +1096,14 @@ print_partial_compiled_pattern (start, end) | |||
| 1096 | 1096 | ||
| 1097 | case wordend: | 1097 | case wordend: |
| 1098 | fprintf (stderr, "/wordend"); | 1098 | fprintf (stderr, "/wordend"); |
| 1099 | break; | ||
| 1099 | 1100 | ||
| 1100 | case symbeg: | 1101 | case symbeg: |
| 1101 | printf ("/symbeg"); | 1102 | fprintf (stderr, "/symbeg"); |
| 1102 | break; | 1103 | break; |
| 1103 | 1104 | ||
| 1104 | case symend: | 1105 | case symend: |
| 1105 | printf ("/symend"); | 1106 | fprintf (stderr, "/symend"); |
| 1106 | break; | 1107 | break; |
| 1107 | 1108 | ||
| 1108 | case syntaxspec: | 1109 | case syntaxspec: |