diff options
Diffstat (limited to 'lisp')
61 files changed, 2173 insertions, 915 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3d3994cd24..2795cbf26d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,8 +1,441 @@ +2004-12-22 Kenichi Handa <[email protected]> + + * international/quail.el (quail-start-translation): Fix prompt + string for the case if input-method-use-echo-area being non-nil. + (quail-start-conversion): Likewise. + (quail-show-guidance): Don't show guidance if + input-method-use-echo-area is non-nil. + +2004-12-21 Richard M. Stallman <[email protected]> + + * textmodes/ispell.el (ispell-help): Bind resize-mini-windows. + +2004-12-21 Markus Rost <[email protected]> + + * calendar/diary-lib.el (mark-diary-entries): Set + mark-diary-entries-in-calendar only after checking for diary-file. + +2004-12-21 Richard M. Stallman <[email protected]> + + * faces.el (escape-glyph): Use blue against light foreground. + + * simple.el (undo-outer-limit-truncate): New function. + (undo-outer-limit-function): Use undo-outer-limit-truncate. + +2004-12-21 Eli Barzilay <[email protected]> + + * calculator.el: (calculator-radix-grouping-mode) + (calculator-radix-grouping-digits) + (calculator-radix-grouping-separator): + New defcustoms for the new radix grouping mode functionality. + (calculator-mode-hook): Now used in electric mode too. + (calculator-mode-map): Some new keys. + (calculator-message): New function. Some new calls. + (calculator-string-to-number): New function, + (calculator-curnum-value): Use it. + (calculator-rotate-displayer, calculator-rotate-displayer-back) + (calculator-displayer-prev, calculator-displayer-next): + Change digit group size when in radix mode. + (calculator-number-to-string): Renamed from calculator-num-to-string. + Now deals with digit grouping in radix mode. + +2004-12-20 Glenn Morris <[email protected]> + + * calendar/calendar.el (view-other-diary-entries): Add autoload. + * calendar/diary-lib.el (view-other-diary-entries): Use + current-prefix-arg in interactive spec. + +2004-12-19 Jay Belanger <[email protected]> + + * calc/calc-aent.el (calcAlg-blank-matching-open): + Temporarily adjust the syntax of both delimiters of half-open + intervals. + +2004-12-19 Kim F. Storm <[email protected]> + + * mouse.el (mouse-1-click-follows-link): Doc fix. + +2004-12-18 YAMAMOTO Mitsuharu <[email protected]> + + * term/mac-win.el (encoding-vector, mac-font-encoder-list) + (ccl-encode-mac-centraleurroman-font): Use centraleurroman + instead of centraleuropean as the name + +2004-12-17 Michael Albinus <[email protected]> + + Sync with Tramp 2.0.46. + + * net/tramp.el (tramp-maybe-send-perl-script): Change order of + parameters wrt Tramp convention. + (tramp-handle-file-attributes-with-perl) + (tramp-handle-directory-files-and-attributes): Apply it. + (tramp-do-copy-or-rename-file-out-of-band): Check for existence of + `copy-program'. Reported by Zack Weinberg + <[email protected]>. + (top): Set `edebug-form-spec' property directly rather than + calling `def-edebug-spec'. + + * net/tramp-smb.el (tramp-smb-advice-PC-do-completion): Make the + advice less fragile. Surround temporary redefinition of + `substitute-in-file-name' with `unwind-protect'. Suggested by + Matt Hodges <[email protected]>. + +2004-12-17 Juri Linkov <[email protected]> + + * replace.el (occur-accumulate-lines, occur-engine): + Make forcing deferred font-lock fontification jit-specific. + +2004-12-17 Kim F. Storm <[email protected]> + + * mouse.el (mouse-1-click-follows-link): New defcustom. + (mouse-on-link-p): New function. + (mouse-drag-region-1): Implement mouse-1-click-follows-link + functionality. Map a mouse-1 click event into a mouse-2 (or + other) event when position is inside a link. + + * tooltip.el (tooltip-show-help-function): Replace "mouse-2" + prefix in tooltip text with "mouse-1" when this is a link + recognized by mouse-1-click-follows-link functionality. + + * help.el (describe-key): Report effective and original binding + for mouse-1 when clicked on a link. + (describe-mode): Add follow-link property to "minor-mode" button. + + * help-fns.el (describe-variable): Add follow-link property to + "below" button. + + * help-mode.el (help-xref): Add follow-link property. + + * apropos.el (apropos-symbol, apropos-function, apropos-macro) + (apropos-command, apropos-variable, apropos-face, apropos-group) + (apropos-widget, apropos-plist): Add follow-link property. + + * pcvs-defs.el (cvs-mode-map): Map follow-link to a function which + checks if position is in a filename, rather than some other + clickable item. Function looks for cvs-filename-face at position. + + * wid-edit.el (widget-specify-field, widget-specify-button): + Map a :follow-link keyword into a follow-link property. + (link): Add :follow-link keyword, map to RET binding. + + * dired.el (dired-mode-map): Map follow-link to mouse-face. + + * progmodes/compile.el (compilation-minor-mode-map) + (compilation-button-map, compilation-mode-map): Likewise. + +2004-12-17 Thien-Thi Nguyen <[email protected]> + + * play/zone.el (zone): Init `line-spacing' from orig buffer. + (zone-replace-char): Take `count' and `del-count' + instead of `direction'. Update callers. When `del-count' is + non-nil, delete that many characters, otherwise `count' characters + backwards. Insert the newly-replaced string `count' times. + (zone-fret): Handle chars w/ width greater than one. + (zone-fall-through-ws): No longer take window width `ww'. + Update callers. Add handling for `char-width' greater than one. + (zone-pgm-drip): Update var holding window-end position every cycle. + +2004-12-17 Andre Spiegel <[email protected]> + + * vc.el (vc-default-update-changelog): Use insert-file-contents, + rather than insert-file. + +2004-12-16 Jay Belanger <[email protected]> + + * calc/calc-comb.el (var-RandSeed): Don't initially bind it. + (math-init-random-base, math-random-digit): Check to see if + var-RandSeed is bound. + (math-random-last): Declare it. + (math-random-digit): Don't make math-random-last local. + +2004-12-16 Thien-Thi Nguyen <[email protected]> + + * play/zone.el (zone): Fix omission bug: Use a self-disabling + one-shot thunk for uniform (error, quit, normal) recovery. + Reported by John Paul Wallington. + (zone-pgm-random-life): Fix bug: + Recognize empty initial field by lack of "@" chars. + +2004-12-16 Juri Linkov <[email protected]> + + * help.el (function-called-at-point): + * help-fns.el (variable-at-point): As a last resort try striping + non-word prefixes and suffixes. + + * descr-text.el (describe-property-list): Don't treat syntax-table + specially. Use describe-text-sexp which inserts [show] button + for large objects and handles printing errors. Sort properties + by names in alphabetical order instead of by value sizes. + Add `mouse-face' to list of properties for `describe-face' widget. + (describe-char): Mask out face-id from 19 bits of character. + Print face-id separately. + + * replace.el (occur-accumulate-lines, occur-engine): + Fontify unfontified matching lines in the source buffer + before copying them. + (occur-engine): Don't put mouse-face on context lines. + (occur-next-error): Set point to line beginning/end + before searching for prev/next property to skip multiple + matches on a line (not supported by occur engine). + Remove redundant prefix-numeric-value. + +2004-12-15 Juri Linkov <[email protected]> + + * replace.el (match): New face. + (list-matching-lines-face): Change default from `bold' to `match'. + + * progmodes/grep.el (grep-match-face): New defvar. + (grep-mode-font-lock-keywords): Use grep-match-face instead of + compilation-column-face to highlight grep matches. + + * apropos.el (apropos-match-face): Change default from + `secondary-selection' to `match'. + + * info-look.el (info-lookup-highlight-face): Change default from + `highlight' to `match'. + +2004-12-15 Daniel Pfeiffer <[email protected]> + + * progmodes/executable.el (executable-interpret): Eliminate + obsolete compile-internal, and switch to comint for interaction. + +2004-12-15 J.D. Smith <[email protected]> + + * progmodes/idlwave.el (idlwave-skip-multi-commands): Don't match + `&&' when skipping multiple statements on a line. + +2004-12-15 Thien-Thi Nguyen <[email protected]> + + * play/zone.el (zone): Set `truncate-lines'. + Also, init `tab-width' with value from original buffer. + (zone-shift-up): Rewrite for speed. + (zone-shift-down, zone-shift-left, zone-shift-right): Likewise. + (zone-pgm-jitter): Remove redundant entries from ops vector. + (zone-exploding-remove): Reduce iteration count. + (zone-cpos): Convert to defsubst. + (zone-replace-char): New defsubst. + (zone-park/sit-for): Likewise. + (zone-fret): Take window-start arg. + Update callers. Use `zone-park/sit-for'. + (zone-fill-out-screen): Rewrite. + (zone-fall-through-ws): Likewise. Update callers. + (zone-pgm-drip): Use `zone-replace-char'. + Move var inits before while-loop. Use `zone-park/sit-for'. + (zone-pgm-random-life): Handle empty initial field. + Use `zone-replace-char' and `zone-park/sit-for'. + +2004-12-15 Juri Linkov <[email protected]> + + * isearch.el (isearch-update): Test isearch-lazy-highlight + before calling isearch-lazy-highlight-new-loop. + (isearch-lazy-highlight-new-loop): + Don't test isearch-lazy-highlight. + + * replace.el (perform-replace): Add isearch-case-fold-search. + Use delimited-flag for isearch-regexp. + Reset isearch-lazy-highlight-last-string to force lazy + highlighting when called from isearch mode. + (query-replace-highlight): Revert defcustom type to boolean. + (query-replace-lazy-highlight): New defcustom. + (query-replace): New face. + (perform-replace, replace-highlight, replace-dehighlight): + Test query-replace-lazy-highlight instead of special value + `isearch' of query-replace-highlight. + (replace-dehighlight): Don't call isearch-dehighlight. + (replace-highlight): Don't call isearch-highlight. + Use face `query-replace' unconditionally. + +2004-12-14 Kim F. Storm <[email protected]> + + * simple.el (inhibit-mark-movement): Remove defvar. + (beginning-of-buffer, end-of-buffer): Don't use it. + + * emacs-lisp/lisp.el (beginning-of-defun, end-of-defun): Don't + use inhibit-mark-movement. + + * emulation/cua-base.el (cua--preserve-mark-commands): Remove. + (cua--undo-push-mark): Remove. + (cua--pre-command-handler, cua--post-command-handler): Don't + fiddle with inhibit-mark-movement. + +2004-12-14 Juri Linkov <[email protected]> + + * buff-menu.el (list-buffers-noselect): Collect internal info + for every buffer in BUFFER-LIST arg too. + (Buffer-menu-switch-other-window): Bind pop-up-windows to t. + (Buffer-menu-switch-other-window, Buffer-menu-2-window): + Bind same-window-buffer-names and same-window-regexps to nil. + +2004-12-13 Juri Linkov <[email protected]> + + * simple.el (next-error-buffer-p, next-error-find-buffer): + Doc fix. + + * mail/supercite.el (sc-cite-frame-alist): Doc fix. + (sc-cite-region, sc-uncite-region, sc-recite-region): + Fix previous change to handle not alist as a symbol, but + a citation frame as a symbol that represents a variable name. + +2004-12-13 Richard M. Stallman <[email protected]> + + * filecache.el (file-cache-add-directory-using-find): + Only set up file-cache-find-command-posix-flag if we will use it. + + * bindings.el (mode-line-buffer-identification-keymap): + Don't cancel the mode-line's usual down-mouse-1 binding. + + * cus-edit.el (custom-face-selected): Handle `default' specs. + (custom-face-edit): Increase extra-offset. + (custom-display): Handle `default' specs. + + * xml.el (xml-name-re, xml-entity-value-re): Add defvars. + + * emacs-lisp/elint.el (elint-standard-variables) + (elint-unknown-builtin-args): Move definitions up. + + * net/browse-url.el (browse-url-url-at-point): Add autoload. + + * info.el (info-xref-visited): Use `default' instead of t. + (Info-try-follow-nearest-node): Don't explicitly load browse-url. + + * faces.el (header-line, mode-line-inactive, tool-bar): + Use `default' instead of t for setting the defaults. + (face-spec-choose): Separate `t' from `default'. + + * subr.el (while-no-input): New macro. + +2004-12-13 Frederik Fouvry <[email protected]> (tiny change) + + * filecache.el (file-cache-add-directory-using-find): + Only test file-cache-find-command-posix-flag on some systems. + +2004-12-13 Stefan Monnier <[email protected]> + + * vc-svn.el (vc-svn-repository-hostname): Adjust to new format. + Reported by Ville Skytt,Ad(B <[email protected]>. + (vc-svn-annotate-current-time, vc-svn-annotate-time-of-rev) + (vc-svn-annotate-time, vc-svn-annotate-extract-revision-at-line) + (vc-svn-annotate-command, vc-svn-annotate-re): Support for svn annotate. + +2004-12-12 Juri Linkov <[email protected]> + + * files.el (find-file-other-window, find-file-other-frame): + Add the first buffer to the returned value to return the complete + list of all visited buffers. + (find-file-read-only, find-file-read-only-other-window) + (find-file-read-only-other-frame): Use nil for `mustmatch' arg of + `find-file-read-args'. Signal an error about non-existent file + only if file name doesn't contain wildcards. Toggle read-only in + all visited buffers. + (find-alternate-file, find-alternate-file-other-window): + Add optional arg `wildcards'. Doc fix. Set `wildcards' to t when + called interactively. Pass arg `wildcards' to other functions. + (find-file-noselect): Doc fix. + + * ffap.el (ffap-dired-wildcards): Set default to "[*?][^/]*\\'". + Doc fix. + (ffap-directory-finder): New variable. + (ffap-string-at-point-mode-alist): Add * and ? to `file'. + (ffap-file-at-point): Add /* to immediately rejected names. + Return absolute file names matching ffap-dired-wildcards. + (ffap-read-file-or-url): Set default value for `completing-read' + to `buffer-file-name'. + (find-file-at-point): When filename matches ffap-dired-wildcards, + call ffap-file-finder with t arg `wildcards', instead of dired. + (ffap-other-window, ffap-other-frame): Return visited buffers. + (ffap-read-only, ffap-read-only-other-window) + (ffap-read-only-other-frame, ffap-alternate-file): New commands. + (dired-at-point): Call ffap-directory-finder instead of dired. + (ffap-dired-other-window, ffap-dired-other-frame) + (ffap-list-directory): New commands. + (ffap-bindings): New keybindings for new commands. + +2004-12-12 Juri Linkov <[email protected]> + + * simple.el (beginning-of-buffer, end-of-buffer): + * emacs-lisp/lisp.el (beginning-of-defun, end-of-defun): + Do not push mark when mark is active in transient-mark-mode. + + * simple.el (mark-word): + * emacs-lisp/lisp.el (mark-sexp, mark-defun): + * textmodes/paragraphs.el (mark-paragraph): + Extend the region when mark is active in transient-mark-mode, + regardless of the last command. Doc fix. + + * simple.el (mark-word): Preserve direction when repeating. + Make arg optional. Interactive "p" -> "P". + (transient-mark-mode, inhibit-mark-movement): Doc fix. + + * emacs-lisp/lisp.el (mark-sexp): Reverse the condition for + preserving direction, to mark forward instead of backward when mark + is equal to point (e.g. when C-SPC C-M-SPC is typed in t-m-m). + +2004-12-12 Juri Linkov <[email protected]> + + * isearch.el (isearch-edit-string): Set 7th arg of + `read-from-minibuffer' to `t' to inherit the current input + method (whose name is indicated by [IM] in the minibuffer prompt) + from the current buffer to the minibuffer. + (isearch-lazy-highlight-update): Put body to `with-local-quit' + to allow C-g quitting for lazy highlighting looping inside the + search with nested repetition operators. Add overlay to the list + before setting its face and other properties to avoid the case of + code quitting after placing the new overlay but before it's + recorded on the list. Select the window where isearch was + activated, to highlight matches in the right window when isearch + switches the current window to the minibuffer. + + * international/isearch-x.el + (isearch-process-search-multibyte-characters): + Use `isearch-message' as initial input for `read-string' instead + of adding it to the minibuffer prompt. After reading a string + remove the initial value of `isearch-message' from the string. + + * replace.el (replace-match-maybe-edit): Doc fix. + (perform-replace): Don't call `replace-highlight' when automatic + replacement is requested in literal mode, since it is intended + only to highlight words during entering a new replacement string + for \? in non-literal mode. + + * replace.el (query-replace-highlight): Add new value `isearch' + that allows query replacement to use isearch highlighting. + Change type from `boolean' to `choice'. Doc fix. + (replace-highlight, replace-dehighlight, perform-replace): + Use isearch highlighting if query-replace-highlight eq `isearch'. + +2004-12-11 Stefan Monnier <[email protected]> + + * emacs-lisp/checkdoc.el (checkdoc-continue, checkdoc-comments) + (checkdoc-message-text, checkdoc-defun): Fix format messages for `error'. + + * textmodes/tex-mode.el (latex-backward-sexp-1): Handle the special + case of \end{verbatim}. + +2004-12-11 Dan Nicolaescu <[email protected]> + + * term.el (term-termcap-format): Synchronyze with terminfo. + (term-emulate-terminal): Handle reset. + (term-reset-terminal): New function. + +2004-12-11 Thien-Thi Nguyen <[email protected]> + + * play/zone.el (zone-programs): Add `zone-pgm-random-life'. + (zone-fill-out-screen): New func. + (zone-pgm-drip): Use `zone-fill-out-screen'. + Also, no longer go to point-min on every cycle. + (zone-pgm-paragraph-spaz): Allow spazzing for texinfo-mode. + (zone-pgm-random-life-wait): New user var. + (zone-pgm-random-life): New func. + +2004-12-10 Thien-Thi Nguyen <[email protected]> + + * files.el (auto-mode-alist): Map .com to DCL mode. + 2004-12-09 Richard M. Stallman <[email protected]> * isearch.el (isearch-mode-map): Treat S-SPC like SPC. -2004-12-10 Nick Roberts <[email protected]> +2004-12-09 Nick Roberts <[email protected]> * xt-mouse.el (xterm-mouse-event): Correct cursor position in a buffer with a display margin. @@ -41,10 +474,9 @@ * edmacro.el: `edit-kbd-macro' is now bound to `C-x C-k e'. (edmacro-finish-edit): Further update for keyboard macros that are lambda forms. - (edmacro-sanitize-for-string): Correctly remove Meta modifier - (as suggested by Kim Storm). + (edmacro-sanitize-for-string): Correctly remove Meta modifier. -2004-12-06 Stefan Monnier <[email protected]> +2004-12-07 Stefan Monnier <[email protected]> * font-lock.el (font-lock-unfontify-region): Save buffer state. (font-lock-default-unfontify-region): Don't save buffer state any more. @@ -7889,7 +8321,115 @@ (compilation-forget-errors): Don't localize already local compilation-locs and remove FIXME about refontifying. -2004-04-14 +2004-04-14 Kim F. Storm <[email protected]> + + * startup.el (emacs-quick-startup): New defvar (set by -Q). + (command-line): New option -Q. Like -q --no-site-file, but + in addition it also disables menu-bar, tool-bar, scroll-bars, + tool-tips, and the blinking cursor. + (command-line-1): Skip startup screen if -Q. + (fancy-splash-head): Use ":align-to center" prop to center splash image. + + * emulation/cua-base.el (cua-read-only-cursor-color) + (cua-overwrite-cursor-color, cua-global-mark-cursor-color): Doc fix. + +2004-04-13 Dave Love <[email protected]> + + * progmodes/python.el: Doc fixes. Changes for compiler warnings. + (syntax): Don't require. + (python) <defgroup>: Add :version. + (python-quote-syntax): Re-written. + (inferior-python-mode): Move stuff here from run-python and add + some more. + (python-preoutput-continuation, python-preoutput-result) + (python-dotty-syntax-table): New. + (python-describe-symbol): Use them. + (run-python): Move stuff to inferior-python-mode. Modify code + loaded into Python. + (python-send-region): Use python-proc, python-send-string. + (python-send-string): Send newlines too. Callers changed. + (python-load-file): Re-written. + (python-eldoc-function): New. + (info-look): Don't require. + (python-after-info-look): New. A modified version of former + top-level code for use with eval-after-load. + (python-maybe-jython, python-guess-indent): Use widened buffer. + (python-fill-paragraph): Re-written. + (python-mode): Fix outline-regexp. Set outline-heading-end-regexp, + eldoc-print-current-symbol-info-function. Add to eldoc-mode-hook. + +2004-04-13 Stefan Monnier <[email protected]> + + * progmodes/python.el (run-python): Use compilation-shell-minor-mode. + Set compilation-error-regexp-alist earlier. + + * progmodes/compile.el (compilation-minor-mode-map) + (compilation-shell-minor-mode-map, compile-mouse-goto-error) + (compile-goto-error): Re-merge the mouse and non-mouse commands. + +2004-04-12 Stefan Monnier <[email protected]> + + * progmodes/compile.el (compile-goto-error): Select the buffer/window + corresponding to the event. + +2004-04-12 Joe Buehler <[email protected]> + + * loadup.el: Add cygwin to system-type list, for unexec() support. + +2004-04-12 John Paul Wallington <[email protected]> + + * ibuffer.el (ibuffer-delete-window-on-quit): Remove. + (ibuffer-restore-window-config-on-quit): New variable to replace + `ibuffer-delete-window-on-quit'. Update all references. + (ibuffer-prev-window-config): New variable. + (ibuffer-quit): Restore previous window configuration instead of + deleting window. + (ibuffer): Save window configuration before showing Ibuffer buffer. + + * help.el (describe-mode): Doc fix. + +2004-04-12 Stefan Monnier <[email protected]> + + * progmodes/compile.el (compilation-mode-font-lock-keywords): Fix test + not to treat nil as a function. + + * vc-arch.el (vc-arch-root): Be a bit more careful. + (vc-arch-register): Save the buffer if we modified it. + (vc-arch-delete-rej-if-obsolete): Save excursion. + (vc-arch-find-file-hook): Use the simpler after-save-hook. + (vc-arch-responsible-p, vc-arch-init-version): New functions. + + * net/ldap.el (ldap-search): Use list*. + +2004-04-12 Juri Linkov <[email protected]> + + * info.el (Info-follow-reference): Allow multiline reference name. + +2004-04-11 Dave Love <[email protected]> + + * emacs-lisp/bytecomp.el (byte-compile-cond): Fix last change. + + * progmodes/python.el: New file. + +2004-04-11 Andre Spiegel <[email protected]> + + * vc-hooks.el (vc-arg-list): Function removed. + (vc-default-workfile-unchanged-p): Use condition-case to check for + backward compatibility. + + * vc.el (vc-print-log): Use condition-case to check for backward + compatibility. + +2004-04-11 Juri Linkov <[email protected]> + + * dired.el (dired-faces): New defgroup. + (dired-header, dired-mark, dired-marked, dired-flagged) + (dired-warning, dired-directory, dired-symlink, dired-ignored): + New faces. + (dired-header-face, dired-mark-face, dired-marked-face) + (dired-flagged-face, dired-warning-face, dired-directory-face) + (dired-symlink-face, dired-ignored-face): New face variables. + (dired-font-lock-keywords): Use them instead of font-lock faces. Split the rule for dired marks into 3 separate rules: for marks, marked file names and flagged file names. diff --git a/lisp/apropos.el b/lisp/apropos.el index 8bfaa3ad59..1befefe881 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -96,7 +96,7 @@ turns off mouse highlighting." :group 'apropos :type 'face) -(defcustom apropos-match-face 'secondary-selection +(defcustom apropos-match-face 'match "*Face for matching text in Apropos documentation/value, or nil for none. This applies when you look for matches in the documentation or variable value for the regexp; the part that matches gets displayed in this font." @@ -163,6 +163,7 @@ term, and the rest of the words are alternative terms.") (define-button-type 'apropos-symbol 'face apropos-symbol-face 'help-echo "mouse-2, RET: Display more help on this symbol" + 'follow-link t 'action #'apropos-symbol-button-display-help 'skip t) @@ -174,19 +175,24 @@ term, and the rest of the words are alternative terms.") (define-button-type 'apropos-function 'apropos-label "Function" + 'help-echo "mouse-2, RET: Display more help on this function" + 'follow-link t 'action (lambda (button) - (describe-function (button-get button 'apropos-symbol))) - 'help-echo "mouse-2, RET: Display more help on this function") + (describe-function (button-get button 'apropos-symbol)))) + (define-button-type 'apropos-macro 'apropos-label "Macro" + 'help-echo "mouse-2, RET: Display more help on this macro" + 'follow-link t 'action (lambda (button) - (describe-function (button-get button 'apropos-symbol))) - 'help-echo "mouse-2, RET: Display more help on this macro") + (describe-function (button-get button 'apropos-symbol)))) + (define-button-type 'apropos-command 'apropos-label "Command" + 'help-echo "mouse-2, RET: Display more help on this command" + 'follow-link t 'action (lambda (button) - (describe-function (button-get button 'apropos-symbol))) - 'help-echo "mouse-2, RET: Display more help on this command") + (describe-function (button-get button 'apropos-symbol)))) ;; We used to use `customize-variable-other-window' instead for a ;; customizable variable, but that is slow. It is better to show an @@ -196,18 +202,21 @@ term, and the rest of the words are alternative terms.") (define-button-type 'apropos-variable 'apropos-label "Variable" 'help-echo "mouse-2, RET: Display more help on this variable" + 'follow-link t 'action (lambda (button) (describe-variable (button-get button 'apropos-symbol)))) (define-button-type 'apropos-face 'apropos-label "Face" 'help-echo "mouse-2, RET: Display more help on this face" + 'follow-link t 'action (lambda (button) (describe-face (button-get button 'apropos-symbol)))) (define-button-type 'apropos-group 'apropos-label "Group" 'help-echo "mouse-2, RET: Display more help on this group" + 'follow-link t 'action (lambda (button) (customize-group-other-window (button-get button 'apropos-symbol)))) @@ -215,12 +224,14 @@ term, and the rest of the words are alternative terms.") (define-button-type 'apropos-widget 'apropos-label "Widget" 'help-echo "mouse-2, RET: Display more help on this widget" + 'follow-link t 'action (lambda (button) (widget-browse-other-window (button-get button 'apropos-symbol)))) (define-button-type 'apropos-plist 'apropos-label "Plist" 'help-echo "mouse-2, RET: Display more help on this plist" + 'follow-link t 'action (lambda (button) (apropos-describe-plist (button-get button 'apropos-symbol)))) diff --git a/lisp/bindings.el b/lisp/bindings.el index a85c0948f6..fb5f1125d9 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -448,7 +448,6 @@ Menu of mode operations in the mode line.") (let ((map (make-sparse-keymap))) ;; Bind down- events so that the global keymap won't ``shine ;; through''. - (define-key map [mode-line down-mouse-1] 'ignore) (define-key map [mode-line mouse-1] 'mode-line-unbury-buffer) (define-key map [header-line down-mouse-1] 'ignore) (define-key map [header-line mouse-1] 'mode-line-unbury-buffer) diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 990ab32c9a..1c3fa70404 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -484,14 +484,19 @@ in the selected frame." "Make the other window select this line's buffer. The current window remains selected." (interactive) - (display-buffer (Buffer-menu-buffer t))) + (let ((pop-up-windows t) + same-window-buffer-names + same-window-regexps) + (display-buffer (Buffer-menu-buffer t)))) (defun Buffer-menu-2-window () "Select this line's buffer, with previous buffer in second window." (interactive) (let ((buff (Buffer-menu-buffer t)) (menu (current-buffer)) - (pop-up-windows t)) + (pop-up-windows t) + same-window-buffer-names + same-window-regexps) (delete-other-windows) (switch-to-buffer (other-buffer)) (pop-to-buffer buff) @@ -671,8 +676,7 @@ For more information, see the function `buffer-menu'." ;; line with the beginning of the text (rather than with the left ;; scrollbar or the left fringe). –-Stef (setq header (concat (propertize " " 'display '(space :align-to 0)) - header)) - ) + header))) (with-current-buffer (get-buffer-create "*Buffer List*") (setq buffer-read-only nil) (erase-buffer) @@ -684,47 +688,45 @@ For more information, see the function `buffer-menu'." (mapcar (lambda (c) (if (memq c '(?\n ?\ )) c underline)) header))))) - (if buffer-list - (setq list buffer-list) - ;; Collect info for every buffer we're interested in. - (dolist (buffer (buffer-list)) - (with-current-buffer buffer - (let ((name (buffer-name)) - (file buffer-file-name)) - (cond - ;; Don't mention internal buffers. - ((and (string= (substring name 0 1) " ") (null file))) - ;; Maybe don't mention buffers without files. - ((and files-only (not file))) - ((string= name "*Buffer List*")) - ;; Otherwise output info. - (t - (let ((mode (concat (format-mode-line mode-name nil nil buffer) - (if mode-line-process - (format-mode-line mode-line-process - nil nil buffer)))) - (bits (string - (if (eq buffer old-buffer) ?. ?\ ) - ;; Handle readonly status. The output buffer - ;; is special cased to appear readonly; it is - ;; actually made so at a later date. - (if (or (eq buffer standard-output) - buffer-read-only) - ?% ?\ ) - ;; Identify modified buffers. - (if (buffer-modified-p) ?* ?\ ) - ;; Space separator. - ?\ ))) - (unless file - ;; No visited file. Check local value of - ;; list-buffers-directory. - (when (and (boundp 'list-buffers-directory) - list-buffers-directory) - (setq file list-buffers-directory))) - (push (list buffer bits name (buffer-size) mode file) - list))))))) - ;; Preserve the original buffer-list ordering, just in case. - (setq list (nreverse list))) + ;; Collect info for every buffer we're interested in. + (dolist (buffer (or buffer-list (buffer-list))) + (with-current-buffer buffer + (let ((name (buffer-name)) + (file buffer-file-name)) + (unless (and (not buffer-list) + (or + ;; Don't mention internal buffers. + (and (string= (substring name 0 1) " ") (null file)) + ;; Maybe don't mention buffers without files. + (and files-only (not file)) + (string= name "*Buffer List*"))) + ;; Otherwise output info. + (let ((mode (concat (format-mode-line mode-name nil nil buffer) + (if mode-line-process + (format-mode-line mode-line-process + nil nil buffer)))) + (bits (string + (if (eq buffer old-buffer) ?. ?\ ) + ;; Handle readonly status. The output buffer + ;; is special cased to appear readonly; it is + ;; actually made so at a later date. + (if (or (eq buffer standard-output) + buffer-read-only) + ?% ?\ ) + ;; Identify modified buffers. + (if (buffer-modified-p) ?* ?\ ) + ;; Space separator. + ?\ ))) + (unless file + ;; No visited file. Check local value of + ;; list-buffers-directory. + (when (and (boundp 'list-buffers-directory) + list-buffers-directory) + (setq file list-buffers-directory))) + (push (list buffer bits name (buffer-size) mode file) + list)))))) + ;; Preserve the original buffer-list ordering, just in case. + (setq list (nreverse list)) ;; Place the buffers's info in the output buffer, sorted if necessary. (dolist (buffer (if Buffer-menu-sort-column diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el index c062a822e8..2210435036 100644 --- a/lisp/calc/calc-aent.el +++ b/lisp/calc/calc-aent.el @@ -410,32 +410,40 @@ T means abort and give an error message.") (exit-minibuffer)))) (defun calcAlg-blink-matching-open () - (let ((oldpos (point)) - (blinkpos nil)) + (let ((rightpt (point)) + (leftpt nil) + (rightchar (preceding-char)) + leftchar + rightsyntax + leftsyntax) (save-excursion (condition-case () - (setq blinkpos (scan-sexps oldpos -1)) - (error nil))) - (if (and blinkpos - (> oldpos (1+ (point-min))) - (or (and (= (char-after (1- oldpos)) ?\)) - (= (char-after blinkpos) ?\[)) - (and (= (char-after (1- oldpos)) ?\]) - (= (char-after blinkpos) ?\())) - (save-excursion - (goto-char blinkpos) - (looking-at ".+\\(\\.\\.\\|\\\\dots\\|\\\\ldots\\)"))) - (let ((saved (aref (syntax-table) (char-after blinkpos)))) - (unwind-protect - (progn - (aset (syntax-table) (char-after blinkpos) - (+ (logand saved 255) - (lsh (char-after (1- oldpos)) 8))) - (blink-matching-open)) - (aset (syntax-table) (char-after blinkpos) saved))) + (setq leftpt (scan-sexps rightpt -1) + leftchar (char-after leftpt)) + (error nil))) + (if (and leftpt + (or (and (= rightchar ?\)) + (= leftchar ?\[)) + (and (= rightchar ?\]) + (= leftchar ?\())) + (save-excursion + (goto-char leftpt) + (looking-at ".+\\(\\.\\.\\|\\\\dots\\|\\\\ldots\\)"))) + (let ((leftsaved (aref (syntax-table) leftchar)) + (rightsaved (aref (syntax-table) rightchar))) + (unwind-protect + (progn + (cond ((= leftchar ?\[) + (aset (syntax-table) leftchar (cons 4 ?\))) + (aset (syntax-table) rightchar (cons 5 ?\[))) + (t + (aset (syntax-table) leftchar (cons 4 ?\])) + (aset (syntax-table) rightchar (cons 5 ?\()))) + (blink-matching-open)) + (aset (syntax-table) leftchar leftsaved) + (aset (syntax-table) rightchar rightsaved))) (blink-matching-open)))) - (defun calc-alg-digit-entry () (calc-alg-entry (cond ((eq last-command-char ?e) diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el index 24e3e5f182..adb8fcecce 100644 --- a/lisp/calc/calc-comb.el +++ b/lisp/calc/calc-comb.el @@ -540,12 +540,12 @@ ;;; Produce a random 10-bit integer, with (random) if no seed provided, ;;; or else with Numerical Recipes algorithm ran3 / Knuth 3.2.2-A. -(defvar var-RandSeed nil) +(defvar var-RandSeed) (defvar math-random-cache nil) (defvar math-gaussian-cache nil) (defun math-init-random-base () - (if var-RandSeed + (if (and (boundp 'var-RandSeed) var-RandSeed) (if (eq (car-safe var-RandSeed) 'vec) nil (if (Math-integerp var-RandSeed) @@ -599,9 +599,10 @@ ;;; Produce a random digit in the range 0..999. ;;; Avoid various pitfalls that may lurk in the built-in (random) function! ;;; Shuffling algorithm from Numerical Recipes, section 7.1. +(defvar math-random-last) (defun math-random-digit () - (let (i math-random-last) - (or (eq var-RandSeed math-last-RandSeed) + (let (i) + (or (and (boundp 'var-RandSeed) (eq var-RandSeed math-last-RandSeed)) (math-init-random-base)) (or math-random-cache (progn diff --git a/lisp/calculator.el b/lisp/calculator.el index a9410ae961..76ff4053c7 100644 --- a/lisp/calculator.el +++ b/lisp/calculator.el @@ -4,6 +4,7 @@ ;; Author: Eli Barzilay <[email protected]> ;; Keywords: tools, convenience +;; Time-stamp: <2002-07-13 01:14:35 eli> ;; This file is part of GNU Emacs. @@ -100,6 +101,20 @@ at runtime." :type 'integer :group 'calculator) +(defcustom calculator-radix-grouping-mode t + "*Use digit grouping in radix output mode. +If this is set, chunks of `calculator-radix-grouping-digits' characters +will be separated by `calculator-radix-grouping-separator' when in radix +output mode is active (determined by `calculator-output-radix').") + +(defcustom calculator-radix-grouping-digits 4 + "*The number of digits used for grouping display in radix modes. +See `calculator-radix-grouping-mode'.") + +(defcustom calculator-radix-grouping-separator "'" + "*The separator used in radix grouping display. +See `calculator-radix-grouping-mode'.") + (defcustom calculator-remove-zeros t "*Non-nil value means delete all redundant zero decimal digits. If this value is not t, and not nil, redundant zeros are removed except @@ -163,7 +178,11 @@ Otherwise show as a negative number." :group 'calculator) (defcustom calculator-mode-hook nil - "*List of hook functions for `calculator-mode' to run." + "*List of hook functions for `calculator-mode' to run. +Note: if `calculator-electric-mode' is on, then this hook will get +activated in the minibuffer - in that case it should not do much more +than local key settings and other effects that will change things +outside the scope of calculator related code." :type 'hook :group 'calculator) @@ -387,7 +406,7 @@ Used for repeating operations in calculator-repR/L.") "oD" "oH" "oX" "oO" "oB") (calculator-rotate-displayer "'") (calculator-rotate-displayer-back "\"") - (calculator-displayer-pref "{") + (calculator-displayer-prev "{") (calculator-displayer-next "}") (calculator-saved-up [up] [?\C-p]) (calculator-saved-down [down] [?\C-n]) @@ -399,10 +418,10 @@ Used for repeating operations in calculator-repR/L.") (calculator-save-and-quit [(control return)] [(control kp-enter)]) (calculator-paste [insert] [(shift insert)] - [mouse-2]) + [paste] [mouse-2] [?\C-y]) (calculator-clear [delete] [?\C-?] [?\C-d]) (calculator-help [?h] [??] [f1] [help]) - (calculator-copy [(control insert)]) + (calculator-copy [(control insert)] [copy]) (calculator-backspace [backspace]) ))) (while p @@ -536,7 +555,7 @@ Used for repeating operations in calculator-repR/L.") ,@(mapcar (lambda (x) (nth 1 x)) radix-selectors) "---" ,@(mapcar (lambda (x) (nth 2 x)) radix-selectors))) - ("Decimal Dislpay" + ("Decimal Display" ,@(mapcar (lambda (d) (vector (cadr d) ;; Note: inserts actual object here @@ -611,10 +630,11 @@ The prompt indicates the current modes: * \"=?\": (? is B/O/H) the display radix (when input is decimal); * \"??\": (? is D/B/O/H) 1st char for input radix, 2nd for display. -Also, the quote character can be used to switch display modes for -decimal numbers (double-quote rotates back), and the two brace -characters (\"{\" and \"}\" change display parameters that these -displayers use (if they handle such). +Also, the quote key can be used to switch display modes for decimal +numbers (double-quote rotates back), and the two brace characters +\(\"{\" and \"}\" change display parameters that these displayers use (if +they handle such). If output is using any radix mode, then these keys +toggle digit grouping mode and the chunk size. Values can be saved for future reference in either a list of saved values, or in registers. @@ -683,6 +703,7 @@ See the documentation for `calculator-mode' for more information." (setq calculator-saved-global-map (current-global-map)) (use-local-map nil) (use-global-map calculator-mode-map) + (run-hooks 'calculator-mode-hook) (unwind-protect (catch 'calculator-done (Electric-command-loop @@ -717,6 +738,12 @@ See the documentation for `calculator-mode' for more information." (if (and calculator-restart-other-mode calculator-electric-mode) (calculator))) +(defun calculator-message (string &rest arguments) + "Same as `message', but special handle of electric mode." + (apply 'message string arguments) + (if calculator-electric-mode + (progn (sit-for 1) (message nil)))) + ;;;--------------------------------------------------------------------- ;;; Operators @@ -818,82 +845,116 @@ The string is set not to exceed the screen width." (concat calculator-prompt (substring prompt (+ trim (length calculator-prompt))))))) -(defun calculator-curnum-value () - "Get the numeric value of the displayed number string as a float." +(defun calculator-string-to-number (str) + "Convert the given STR to a number, according to the value of +`calculator-input-radix'." (if calculator-input-radix (let ((radix (cdr (assq calculator-input-radix '((bin . 2) (oct . 8) (hex . 16))))) - (i -1) (value 0)) - ;; assume valid input (upcased & characters in range) - (while (< (setq i (1+ i)) (length calculator-curnum)) - (setq value - (+ (let ((ch (aref calculator-curnum i))) - (- ch (if (<= ch ?9) ?0 (- ?A 10)))) - (* radix value)))) + (i -1) (value 0) (new-value 0)) + ;; assume mostly valid input (e.g., characters in range) + (while (< (setq i (1+ i)) (length str)) + (setq new-value + (let* ((ch (upcase (aref str i))) + (n (cond ((< ch ?0) nil) + ((<= ch ?9) (- ch ?0)) + ((< ch ?A) nil) + ((<= ch ?Z) (- ch (- ?A 10))) + (t nil)))) + (if (and n (<= 0 n) (< n radix)) + (+ n (* radix value)) + (progn + (calculator-message + "Warning: Ignoring bad input character `%c'." ch) + (sit-for 1) + value)))) + (if (if (< new-value 0) (> value 0) (< value 0)) + (calculator-message "Warning: Overflow in input.")) + (setq value new-value)) value) - (car - (read-from-string - (cond - ((equal "." calculator-curnum) - "0.0") - ((string-match "[eE][+-]?$" calculator-curnum) - (concat calculator-curnum "0")) - ((string-match "\\.[0-9]\\|[eE]" calculator-curnum) - calculator-curnum) - ((string-match "\\." calculator-curnum) - ;; do this because Emacs reads "23." as an integer - (concat calculator-curnum "0")) - ((stringp calculator-curnum) - (concat calculator-curnum ".0")) - (t "0.0")))))) + (car (read-from-string + (cond ((equal "." str) "0.0") + ((string-match "[eE][+-]?$" str) (concat str "0")) + ((string-match "\\.[0-9]\\|[eE]" str) str) + ((string-match "\\." str) + ;; do this because Emacs reads "23." as an integer + (concat str "0")) + ((stringp str) (concat str ".0")) + (t "0.0")))))) + +(defun calculator-curnum-value () + "Get the numeric value of the displayed number string as a float." + (calculator-string-to-number calculator-curnum)) (defun calculator-rotate-displayer (&optional new-disp) "Switch to the next displayer on the `calculator-displayers' list. Can be called with an optional argument NEW-DISP to force rotation to -that argument." +that argument. +If radix output mode is active, toggle digit grouping." (interactive) - (setq calculator-displayers - (if (and new-disp (memq new-disp calculator-displayers)) - (let ((tmp nil)) - (while (not (eq (car calculator-displayers) new-disp)) - (setq tmp (cons (car calculator-displayers) tmp)) - (setq calculator-displayers (cdr calculator-displayers))) - (setq calculator-displayers - (nconc calculator-displayers (nreverse tmp)))) - (nconc (cdr calculator-displayers) - (list (car calculator-displayers))))) - (message "Using %s." (cadr (car calculator-displayers))) - (if calculator-electric-mode - (progn (sit-for 1) (message nil))) + (cond + (calculator-output-radix + (setq calculator-radix-grouping-mode + (not calculator-radix-grouping-mode)) + (calculator-message + "Digit grouping mode %s." + (if calculator-radix-grouping-mode "ON" "OFF"))) + (t + (setq calculator-displayers + (if (and new-disp (memq new-disp calculator-displayers)) + (let ((tmp nil)) + (while (not (eq (car calculator-displayers) new-disp)) + (setq tmp (cons (car calculator-displayers) tmp)) + (setq calculator-displayers + (cdr calculator-displayers))) + (setq calculator-displayers + (nconc calculator-displayers (nreverse tmp)))) + (nconc (cdr calculator-displayers) + (list (car calculator-displayers))))) + (calculator-message + "Using %s." (cadr (car calculator-displayers))))) (calculator-enter)) (defun calculator-rotate-displayer-back () - "Like `calculator-rotate-displayer', but rotates modes back." + "Like `calculator-rotate-displayer', but rotates modes back. +If radix output mode is active, toggle digit grouping." (interactive) (calculator-rotate-displayer (car (last calculator-displayers)))) (defun calculator-displayer-prev () "Send the current displayer function a 'left argument. This is used to modify display arguments (if the current displayer -function supports this)." +function supports this). +If radix output mode is active, increase the grouping size." (interactive) - (and (car calculator-displayers) - (let ((disp (caar calculator-displayers))) - (cond ((symbolp disp) (funcall disp 'left)) - ((and (consp disp) (eq 'std (car disp))) - (calculator-standard-displayer 'left (cadr disp))))))) + (if calculator-output-radix + (progn (setq calculator-radix-grouping-digits + (1+ calculator-radix-grouping-digits)) + (calculator-enter)) + (and (car calculator-displayers) + (let ((disp (caar calculator-displayers))) + (cond + ((symbolp disp) (funcall disp 'left)) + ((and (consp disp) (eq 'std (car disp))) + (calculator-standard-displayer 'left (cadr disp)))))))) (defun calculator-displayer-next () "Send the current displayer function a 'right argument. This is used to modify display arguments (if the current displayer -function supports this)." +function supports this). +If radix output mode is active, decrease the grouping size." (interactive) - (and (car calculator-displayers) - (let ((disp (caar calculator-displayers))) - (cond ((symbolp disp) (funcall disp 'right)) - ((and (consp disp) (eq 'std (car disp))) - (calculator-standard-displayer 'right (cadr disp))))))) + (if calculator-output-radix + (progn (setq calculator-radix-grouping-digits + (max 2 (1- calculator-radix-grouping-digits))) + (calculator-enter)) + (and (car calculator-displayers) + (let ((disp (caar calculator-displayers))) + (cond + ((symbolp disp) (funcall disp 'right)) + ((and (consp disp) (eq 'std (car disp))) + (calculator-standard-displayer 'right (cadr disp)))))))) (defun calculator-remove-zeros (numstr) "Get a number string NUMSTR and remove unnecessary zeroes. @@ -995,7 +1056,7 @@ the 'left or 'right when one of the standard modes is used." (calculator-remove-zeros str)) "e" (number-to-string exp)))))) -(defun calculator-num-to-string (num) +(defun calculator-number-to-string (num) "Convert NUM to a displayable string." (cond ((and (numberp num) calculator-output-radix) @@ -1015,6 +1076,14 @@ the 'left or 'right when one of the standard modes is used." (?6 . "110") (?7 . "111"))))))) (string-match "^0*\\(.+\\)" s) (setq str (match-string 1 s)))) + (if calculator-radix-grouping-mode + (let ((d (/ (length str) calculator-radix-grouping-digits)) + (r (% (length str) calculator-radix-grouping-digits))) + (while (>= (setq d (1- d)) (if (zerop r) 1 0)) + (let ((i (+ r (* d calculator-radix-grouping-digits)))) + (setq str (concat (substring str 0 i) + calculator-radix-grouping-separator + (substring str i))))))) (upcase (if (and (not calculator-2s-complement) (< num 0)) (concat "-" str) @@ -1051,7 +1120,7 @@ If optional argument FORCE is non-nil, don't use the cached string." ;; customizable display for a single value (caar calculator-displayers) calculator-displayer))) - (mapconcat 'calculator-num-to-string + (mapconcat 'calculator-number-to-string (reverse calculator-stack) " ")) " " @@ -1319,9 +1388,8 @@ Optional string argument KEYS will force using it as the keys entered." (if (not (and op (= -1 (calculator-op-arity op)))) ;;(error "Binary operator without a first operand") (progn - (message "Binary operator without a first operand") - (if calculator-electric-mode - (progn (sit-for 1) (message nil))) + (calculator-message + "Binary operator without a first operand") (throw 'op-error nil))))) (calculator-reduce-stack (cond ((eq (nth 1 op) '\() 10) @@ -1334,9 +1402,7 @@ Optional string argument KEYS will force using it as the keys entered." (not (numberp (car calculator-stack))))) ;;(error "Unterminated expression") (progn - (message "Unterminated expression") - (if calculator-electric-mode - (progn (sit-for 1) (message nil))) + (calculator-message "Unterminated expression") (throw 'op-error nil))) (setq calculator-stack (cons op calculator-stack)) (calculator-reduce-stack (calculator-op-prec op)) @@ -1540,7 +1606,7 @@ Optional string argument KEYS will force using it as the keys entered." (setcdr as val) (setq calculator-registers (cons (cons reg val) calculator-registers))) - (message (format "[%c] := %S" reg val)))) + (calculator-message "[%c] := %S" reg val))) (defun calculator-put-value (val) "Paste VAL as if entered. @@ -1552,24 +1618,26 @@ Used by `calculator-paste' and `get-register'." (progn (calculator-clear-fragile) (setq calculator-curnum (let ((calculator-displayer "%S")) - (calculator-num-to-string val))) + (calculator-number-to-string val))) (calculator-update-display)))) (defun calculator-paste () "Paste a value from the `kill-ring'." (interactive) (calculator-put-value - (let ((str (current-kill 0))) - (and calculator-paste-decimals + (let ((str (replace-regexp-in-string + "^ *\\(.+[^ ]\\) *$" "\\1" (current-kill 0)))) + (and (not calculator-input-radix) + calculator-paste-decimals (string-match "\\([0-9]+\\)\\(\\.[0-9]+\\)?\\(e[0-9]+\\)?" str) (or (match-string 1 str) (match-string 2 str) (match-string 3 str)) - (setq str (concat (match-string 1 str) + (setq str (concat (or (match-string 1 str) "0") (or (match-string 2 str) ".0") - (match-string 3 str)))) - (condition-case nil (car (read-from-string str)) + (or (match-string 3 str) "")))) + (condition-case nil (calculator-string-to-number str) (error nil))))) (defun calculator-get-register (reg) @@ -1678,7 +1746,7 @@ To use this, apply a binary operator (evaluate it), then call this." (while (> x 0) (setq r (* r (truncate x))) (setq x (1- x))) - r)) + (+ 0.0 r))) (defun calculator-truncate (n) "Truncate N, return 0 in case of overflow." diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index aa0b3005fa..88d6aee513 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -1660,6 +1660,13 @@ the date indicated by the cursor position in the displayed three-month calendar." t) +(autoload 'view-other-diary-entries "diary-lib" + "Prepare and display buffer of diary entries from an alternative diary file. +Searches for entries that match ARG days, starting with the date indicated +by the cursor position in the displayed three-month calendar. +D-FILE specifies the file to use as the diary file." + t) + (autoload 'calendar-sunrise-sunset "solar" "Local time of sunrise and sunset for date under cursor." t) diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index 679c4b991b..511f82f8f2 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -80,7 +80,7 @@ Searches for entries that match ARG days, starting with the date indicated by the cursor position in the displayed three-month calendar. D-FILE specifies the file to use as the diary file." (interactive - (list (if arg (prefix-numeric-value arg) 1) + (list (prefix-numeric-value current-prefix-arg) (read-file-name "Enter diary file name: " default-directory nil t))) (let ((diary-file d-file)) (view-diary-entries arg))) @@ -841,11 +841,11 @@ Each entry in the diary file visible in the calendar window is marked. After the entries are marked, the hooks `nongregorian-diary-marking-hook' and `mark-diary-entries-hook' are run." (interactive) - (setq mark-diary-entries-in-calendar t) (let ((marking-diary-entries t) file-glob-attrs marks) (save-excursion (set-buffer (find-file-noselect (diary-check-diary-file) t)) + (setq mark-diary-entries-in-calendar t) (message "Marking diary entries...") (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) (let ((d diary-date-forms) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 046c1bebcf..5f3ffc6f8b 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1561,9 +1561,9 @@ item in another window.\n\n")) :group 'custom-magic-faces) (defface custom-set-face '((((class color)) - (:foreground "blue" :background "white")) - (t - (:slant italic))) + (:foreground "blue" :background "white")) + (t + (:slant italic))) "Face used when the customize item has been set." :group 'custom-magic-faces) @@ -1578,31 +1578,32 @@ item in another window.\n\n")) "Face used when the customize item has been saved." :group 'custom-magic-faces) -(defconst custom-magic-alist '((nil "#" underline "\ +(defconst custom-magic-alist + '((nil "#" underline "\ uninitialized, you should not see this.") - (unknown "?" italic "\ + (unknown "?" italic "\ unknown, you should not see this.") - (hidden "-" default "\ + (hidden "-" default "\ hidden, invoke \"Show\" in the previous line to show." "\ group now hidden, invoke \"Show\", above, to show contents.") - (invalid "x" custom-invalid-face "\ + (invalid "x" custom-invalid-face "\ the value displayed for this %c is invalid and cannot be set.") - (modified "*" custom-modified-face "\ + (modified "*" custom-modified-face "\ you have edited the value as text, but you have not set the %c." "\ you have edited something in this group, but not set it.") - (set "+" custom-set-face "\ + (set "+" custom-set-face "\ you have set this %c, but not saved it for future sessions." "\ something in this group has been set, but not saved.") - (changed ":" custom-changed-face "\ + (changed ":" custom-changed-face "\ this %c has been changed outside the customize buffer." "\ something in this group has been changed outside customize.") - (saved "!" custom-saved-face "\ + (saved "!" custom-saved-face "\ this %c has been set and saved." "\ something in this group has been set and saved.") - (rogue "@" custom-rogue-face "\ + (rogue "@" custom-rogue-face "\ this %c has not been changed with customize." "\ something in this group is not prepared for customization.") - (standard " " nil "\ + (standard " " nil "\ this %c is unchanged from its standard setting." "\ visible group members are all at standard settings.")) "Alist of customize option states. @@ -2576,7 +2577,7 @@ to switch between two values." "Edit face attributes." :format "%t: %v" :tag "Attributes" - :extra-offset 12 + :extra-offset 13 :button-args '(:help-echo "Control whether this attribute has any effect.") :value-to-internal 'custom-face-edit-fix-value :match (lambda (widget value) @@ -2689,6 +2690,7 @@ Also change :reverse-video to :inverse-video." :value t :help-echo "Specify frames where the face attributes should be used." :args '((const :tag "all" t) + (const :tag "defaults" default) (checklist :offset 0 :extra-offset 9 @@ -2817,13 +2819,29 @@ Only match frames that support the specified face attributes.") (define-widget 'custom-face-selected 'group "Edit the attributes of the selected display in a face specification." - :args '((repeat :format "" - :inline t - (group custom-display-unselected sexp)) - (group (sexp :format "") custom-face-edit) - (repeat :format "" - :inline t - sexp))) + :args '((choice :inline t + (group :tag "With Defaults" :inline t + (group (const :tag "" default) + (custom-face-edit :tag " Default\n Attributes")) + (repeat :format "" + :inline t + (group custom-display-unselected sexp)) + (group (sexp :format "") + (custom-face-edit :tag " Overriding\n Attributes")) + (repeat :format "" + :inline t + sexp)) + (group :tag "No Defaults" :inline t + (repeat :format "" + :inline t + (group custom-display-unselected sexp)) + (group (sexp :format "") + (custom-face-edit :tag "\n Attributes")) + (repeat :format "" + :inline t + sexp))))) + + (defconst custom-face-selected (widget-convert 'custom-face-selected) "Converted version of the `custom-face-selected' widget.") diff --git a/lisp/descr-text.el b/lisp/descr-text.el index 49b9b12154..726d3e6e5d 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -104,24 +104,11 @@ The `category', `face' and `font-lock-face' properties are made into widget buttons that call `describe-text-category' or `describe-face' when pushed." ;; Sort the properties by the size of their value. - (dolist (elt (sort (let ((ret nil) - (key nil) - (val nil) - (len nil)) + (dolist (elt (sort (let (ret) (while properties - (setq key (pop properties) - val (pop properties) - len 0) - (unless (or (memq key '(category face font-lock-face - syntax-table)) - (widgetp val)) - (setq val (pp-to-string val) - len (length val))) - (push (list key val len) ret)) + (push (list (pop properties) (pop properties)) ret)) ret) - (lambda (a b) - (< (nth 2 a) - (nth 2 b))))) + (lambda (a b) (string< (nth 0 a) (nth 0 b))))) (let ((key (nth 0 elt)) (value (nth 1 elt))) (widget-insert (propertize (format " %-20s " key) @@ -131,23 +118,15 @@ into widget buttons that call `describe-text-category' or :notify `(lambda (&rest ignore) (describe-text-category ',value)) (format "%S" value))) - ((memq key '(face font-lock-face)) + ((memq key '(face font-lock-face mouse-face)) (widget-create 'link :notify `(lambda (&rest ignore) (describe-face ',value)) (format "%S" value))) - ((eq key 'syntax-table) - (widget-create 'push-button - :tag "show" - :action (lambda (widget &optional event) - (with-output-to-temp-buffer - "*Pp Eval Output*" - (pp (widget-get widget :value)))) - value)) ((widgetp value) (describe-text-widget value)) (t - (widget-insert value)))) + (describe-text-sexp value)))) (widget-insert "\n"))) ;;; Describe-Text Commands. @@ -552,10 +531,17 @@ as well as widgets, buttons, overlays, and text properties." (dotimes (i (length disp-vector)) (setq char (aref disp-vector i)) (aset disp-vector i - (cons char (describe-char-display pos char)))) + (cons char (describe-char-display + pos (logand char #x7ffff))))) (format "by display table entry [%s] (see below)" - (mapconcat #'(lambda (x) (format "?%c" (car x))) - disp-vector " "))) + (mapconcat + #'(lambda (x) + (if (> (car x) #x7ffff) + (format "?%c<face-id=%s>" + (logand (car x) #x7ffff) + (lsh (car x) -19)) + (format "?%c" (car x)))) + disp-vector " "))) (composition (let ((from (car composition)) (to (nth 1 composition)) @@ -627,7 +613,7 @@ as well as widgets, buttons, overlays, and text properties." (progn (insert "these fonts (glyph codes):\n") (dotimes (i (length disp-vector)) - (insert (car (aref disp-vector i)) ?: + (insert (logand (car (aref disp-vector i)) #x7ffff) ?: (propertize " " 'display '(space :align-to 5)) (if (cdr (aref disp-vector i)) (format "%s (0x%02X)" (cadr (aref disp-vector i)) diff --git a/lisp/dired.el b/lisp/dired.el index 19ea0768e2..037bf282ed 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1104,6 +1104,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (let ((map (make-keymap))) (suppress-keymap map) (define-key map [mouse-2] 'dired-mouse-find-file-other-window) + (define-key map [follow-link] 'mouse-face) ;; Commands to mark or flag certain categories of files (define-key map "#" 'dired-flag-auto-save-files) (define-key map "." 'dired-clean-directory) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 2048bd6212..a11831f944 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2178,7 +2178,7 @@ list that represents a doc string reference. (let ((old-load-list current-load-list) (args (mapcar 'eval (cdr form)))) (apply 'require args) - ;; Detech (require 'cl) in a way that works even if cl is already loaded. + ;; Detect (require 'cl) in a way that works even if cl is already loaded. (if (member (car args) '("cl" cl)) (setq byte-compile-warnings (remq 'cl-functions byte-compile-warnings)))) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index cc2be89065..7b022e9f11 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -919,7 +919,7 @@ is the starting location. If this is nil, `point-min' is used instead." (progn (goto-char wrong) (if (not take-notes) - (error (checkdoc-error-text msg))))) + (error "%s" (checkdoc-error-text msg))))) (checkdoc-show-diagnostics) (if (interactive-p) (message "No style warnings.")))) @@ -952,7 +952,7 @@ if there is one." (e (checkdoc-file-comments-engine)) (checkdoc-generate-compile-warnings-flag (or take-notes checkdoc-generate-compile-warnings-flag))) - (if e (error (checkdoc-error-text e))) + (if e (error "%s" (checkdoc-error-text e))) (checkdoc-show-diagnostics) e)) @@ -990,7 +990,7 @@ Optional argument TAKE-NOTES causes all errors to be logged." (if (not (interactive-p)) e (if e - (error (checkdoc-error-text e)) + (error "%s" (checkdoc-error-text e)) (checkdoc-show-diagnostics))) (goto-char p)) (if (interactive-p) (message "Checking interactive message text...done."))) @@ -1033,15 +1033,15 @@ space at the end of each line." (msg (checkdoc-this-string-valid))) (if msg (if no-error (message (checkdoc-error-text msg)) - (error (checkdoc-error-text msg))) + (error "%s" (checkdoc-error-text msg))) (setq msg (checkdoc-message-text-search beg end)) (if msg (if no-error (message (checkdoc-error-text msg)) - (error (checkdoc-error-text msg))) + (error "%s" (checkdoc-error-text msg))) (setq msg (checkdoc-rogue-space-check-engine beg end)) (if msg (if no-error (message (checkdoc-error-text msg)) - (error (checkdoc-error-text msg)))))) + (error "%s" (checkdoc-error-text msg)))))) (if (interactive-p) (message "Checkdoc: done.")))))) ;;; Ispell interface for forcing a spell check diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el index bf9c1d39f9..9454bfc9da 100644 --- a/lisp/emacs-lisp/elint.el +++ b/lisp/emacs-lisp/elint.el @@ -50,6 +50,85 @@ "*The buffer to insert lint messages in.") ;;; +;;; Data +;;; + +(defconst elint-standard-variables + '(abbrev-mode auto-fill-function buffer-auto-save-file-name + buffer-backed-up buffer-display-count buffer-display-table buffer-display-time buffer-file-coding-system buffer-file-format + buffer-file-name buffer-file-number buffer-file-truename + buffer-file-type buffer-invisibility-spec buffer-offer-save + buffer-read-only buffer-saved-size buffer-undo-list + cache-long-line-scans case-fold-search ctl-arrow cursor-type comment-column + default-directory defun-prompt-regexp desktop-save-buffer enable-multibyte-characters fill-column fringes-outside-margins goal-column + header-line-format indicate-buffer-boundaries indicate-empty-lines + left-fringe-width + left-margin left-margin-width line-spacing local-abbrev-table local-write-file-hooks major-mode + mark-active mark-ring mode-line-buffer-identification + mode-line-format mode-line-modified mode-line-process mode-name + overwrite-mode + point-before-scroll right-fringe-width right-margin-width + scroll-bar-width scroll-down-aggressively scroll-up-aggressively selective-display + selective-display-ellipses tab-width truncate-lines vc-mode vertical-scroll-bar) + "Standard buffer local vars.") + +(defconst elint-unknown-builtin-args + '((while test &rest forms) + (insert-before-markers-and-inherit &rest text) + (catch tag &rest body) + (and &rest args) + (funcall func &rest args) + (insert &rest args) + (vconcat &rest args) + (run-hook-with-args hook &rest args) + (message-or-box string &rest args) + (save-window-excursion &rest body) + (append &rest args) + (logior &rest args) + (progn &rest body) + (insert-and-inherit &rest args) + (message-box string &rest args) + (prog2 x y &rest body) + (prog1 first &rest body) + (insert-before-markers &rest args) + (call-process-region start end program &optional delete + destination display &rest args) + (concat &rest args) + (vector &rest args) + (run-hook-with-args-until-success hook &rest args) + (track-mouse &rest body) + (unwind-protect bodyform &rest unwindforms) + (save-restriction &rest body) + (quote arg) + (make-byte-code &rest args) + (or &rest args) + (cond &rest clauses) + (start-process name buffer program &rest args) + (run-hook-with-args-until-failure hook &rest args) + (if cond then &rest else) + (apply function &rest args) + (format string &rest args) + (encode-time second minute hour day month year zone &rest args) + (min &rest args) + (logand &rest args) + (logxor &rest args) + (max &rest args) + (list &rest args) + (message string &rest args) + (defvar symbol init doc) + (call-process program &optional infile destination display &rest args) + (with-output-to-temp-buffer bufname &rest body) + (nconc &rest args) + (save-excursion &rest body) + (run-hooks &rest hooks) + (/ x y &rest zs) + (- x &rest y) + (+ &rest args) + (* &rest args) + (interactive &optional args)) + "Those built-ins for which we can't find arguments.") + +;;; ;;; ADT: top-form ;;; @@ -724,85 +803,6 @@ If no documentation could be found args will be `unknown'." (if list list (elint-find-builtins)))) -;;; -;;; Data -;;; - -(defconst elint-standard-variables - '(abbrev-mode auto-fill-function buffer-auto-save-file-name - buffer-backed-up buffer-display-count buffer-display-table buffer-display-time buffer-file-coding-system buffer-file-format - buffer-file-name buffer-file-number buffer-file-truename - buffer-file-type buffer-invisibility-spec buffer-offer-save - buffer-read-only buffer-saved-size buffer-undo-list - cache-long-line-scans case-fold-search ctl-arrow cursor-type comment-column - default-directory defun-prompt-regexp desktop-save-buffer enable-multibyte-characters fill-column fringes-outside-margins goal-column - header-line-format indicate-buffer-boundaries indicate-empty-lines - left-fringe-width - left-margin left-margin-width line-spacing local-abbrev-table local-write-file-hooks major-mode - mark-active mark-ring mode-line-buffer-identification - mode-line-format mode-line-modified mode-line-process mode-name - overwrite-mode - point-before-scroll right-fringe-width right-margin-width - scroll-bar-width scroll-down-aggressively scroll-up-aggressively selective-display - selective-display-ellipses tab-width truncate-lines vc-mode vertical-scroll-bar) - "Standard buffer local vars.") - -(defconst elint-unknown-builtin-args - '((while test &rest forms) - (insert-before-markers-and-inherit &rest text) - (catch tag &rest body) - (and &rest args) - (funcall func &rest args) - (insert &rest args) - (vconcat &rest args) - (run-hook-with-args hook &rest args) - (message-or-box string &rest args) - (save-window-excursion &rest body) - (append &rest args) - (logior &rest args) - (progn &rest body) - (insert-and-inherit &rest args) - (message-box string &rest args) - (prog2 x y &rest body) - (prog1 first &rest body) - (insert-before-markers &rest args) - (call-process-region start end program &optional delete - destination display &rest args) - (concat &rest args) - (vector &rest args) - (run-hook-with-args-until-success hook &rest args) - (track-mouse &rest body) - (unwind-protect bodyform &rest unwindforms) - (save-restriction &rest body) - (quote arg) - (make-byte-code &rest args) - (or &rest args) - (cond &rest clauses) - (start-process name buffer program &rest args) - (run-hook-with-args-until-failure hook &rest args) - (if cond then &rest else) - (apply function &rest args) - (format string &rest args) - (encode-time second minute hour day month year zone &rest args) - (min &rest args) - (logand &rest args) - (logxor &rest args) - (max &rest args) - (list &rest args) - (message string &rest args) - (defvar symbol init doc) - (call-process program &optional infile destination display &rest args) - (with-output-to-temp-buffer bufname &rest body) - (nconc &rest args) - (save-excursion &rest body) - (run-hooks &rest hooks) - (/ x y &rest zs) - (- x &rest y) - (+ &rest args) - (* &rest args) - (interactive &optional args)) - "Those built-ins for which we can't find arguments.") - (provide 'elint) ;;; arch-tag: b2f061e2-af84-4ddc-8e39-f5e969ac228f diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 87b3fcff96..82882d6c2b 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -73,17 +73,18 @@ move forward across N balanced expressions." "Set mark ARG sexps from point. The place mark goes is the same place \\[forward-sexp] would move to with the same argument. -If this command is repeated, it marks the next ARG sexps after the ones -already marked." +If this command is repeated or mark is active in Transient Mark mode, +it marks the next ARG sexps after the ones already marked." (interactive "P") - (cond ((and (eq last-command this-command) (mark t)) + (cond ((or (and (eq last-command this-command) (mark t)) + (and transient-mark-mode mark-active)) (setq arg (if arg (prefix-numeric-value arg) - (if (> (mark) (point)) 1 -1))) + (if (< (mark) (point)) -1 1))) (set-mark (save-excursion - (goto-char (mark)) - (forward-sexp arg) - (point)))) + (goto-char (mark)) + (forward-sexp arg) + (point)))) (t (push-mark (save-excursion @@ -191,9 +192,10 @@ open-parenthesis, and point ends up at the beginning of the line. If variable `beginning-of-defun-function' is non-nil, its value is called as a function to find the defun's beginning." (interactive "p") - (and (eq this-command 'beginning-of-defun) - (or inhibit-mark-movement (eq last-command 'beginning-of-defun) - (push-mark))) + (or (not (eq this-command 'beginning-of-defun)) + (eq last-command 'beginning-of-defun) + (and transient-mark-mode mark-active) + (push-mark)) (and (beginning-of-defun-raw arg) (progn (beginning-of-line) t))) @@ -242,9 +244,10 @@ matches the open-parenthesis that starts a defun; see function If variable `end-of-defun-function' is non-nil, its value is called as a function to find the defun's end." (interactive "p") - (and (eq this-command 'end-of-defun) - (or inhibit-mark-movement (eq last-command 'end-of-defun) - (push-mark))) + (or (not (eq this-command 'end-of-defun)) + (eq last-command 'end-of-defun) + (and transient-mark-mode mark-active) + (push-mark)) (if (or (null arg) (= arg 0)) (setq arg 1)) (if end-of-defun-function (if (> arg 0) @@ -289,10 +292,11 @@ is called as a function to find the defun's end." (defun mark-defun () "Put mark at end of this defun, point at beginning. The defun marked is the one that contains point or follows point. -If this command is repeated, marks more defuns after the ones -already marked." +If this command is repeated or mark is active in Transient Mark mode, +it marks more defuns after the ones already marked." (interactive) - (cond ((and (eq last-command this-command) (mark t)) + (cond ((or (and (eq last-command this-command) (mark t)) + (and transient-mark-mode mark-active)) (set-mark (save-excursion (goto-char (mark)) diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index 523a07d26d..24adae3004 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -1003,14 +1003,6 @@ Extra commands should be added to `cua-movement-commands'") (defvar cua-movement-commands nil "User may add additional movement commands to this list.") -(defvar cua--preserve-mark-commands - '(end-of-buffer beginning-of-buffer) - "List of movement commands that move the mark. -CUA will preserve the previous mark position if a mark is already -active before one of these commands is executed.") - -(defvar cua--undo-push-mark nil) - ;;; Scrolling commands which does not signal errors at top/bottom ;;; of buffer at first key-press (instead moves to top/bottom ;;; of buffer). @@ -1100,11 +1092,7 @@ If ARG is the atom `-', scroll upward by nearly full screen." (aref (if window-system (this-single-command-raw-keys) (this-single-command-keys)) 0))) - (if mark-active - (if (and (memq this-command cua--preserve-mark-commands) - (not inhibit-mark-movement)) - (setq cua--undo-push-mark t - inhibit-mark-movement t)) + (unless mark-active (push-mark-command nil t)) (setq cua--last-region-shifted t) (setq cua--explicit-region-start nil)) @@ -1151,9 +1139,6 @@ If ARG is the atom `-', scroll upward by nearly full screen." (defun cua--post-command-handler () (condition-case nil (progn - (when cua--undo-push-mark - (setq cua--undo-push-mark nil - inhibit-mark-movement nil)) (when cua--global-mark-active (cua--global-mark-post-command)) (when (fboundp 'cua--rectangle-post-command) diff --git a/lisp/faces.el b/lisp/faces.el index 7be6f7f55c..a9189d5f8f 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1334,21 +1334,29 @@ If SPEC is nil, return nil." (unless frame (setq frame (selected-frame))) (let ((tail spec) - result all) + result defaults) (while tail (let* ((entry (pop tail)) (display (car entry)) - (attrs (cdr entry))) - (when (face-spec-set-match-display display frame) - (setq result (if (null (cdr attrs)) ;; was (listp (car attrs)) - ;; Old-style entry, the attribute list is the - ;; first element. - (car attrs) - attrs)) - (if (eq display t) - (setq all result result nil) + (attrs (cdr entry)) + thisval) + ;; Get the attributes as actually specified by this alternative. + (setq thisval + (if (null (cdr attrs)) ;; was (listp (car attrs)) + ;; Old-style entry, the attribute list is the + ;; first element. + (car attrs) + attrs)) + + ;; If the condition is `default', that sets the default + ;; for following conditions. + (if (eq display 'default) + (setq defaults thisval) + ;; Otherwise, if it matches, use it. + (when (face-spec-set-match-display display frame) + (setq result thisval) (setq tail nil))))) - (if all (append result all) result))) + (if defaults (append result defaults) result))) (defun face-spec-reset-face (face &optional frame) @@ -1816,7 +1824,7 @@ created." :group 'basic-faces) (defface mode-line-inactive - '((t + '((default :inherit mode-line) (((type x w32 mac) (background light) (class color)) :weight light @@ -1836,7 +1844,7 @@ created." (put 'modeline-inactive 'face-alias 'mode-line-inactive) (defface header-line - '((t + '((default :inherit mode-line) (((type tty)) ;; This used to be `:inverse-video t', but that doesn't look very @@ -1872,7 +1880,7 @@ created." (defface tool-bar - '((t + '((default :box (:line-width 1 :style released-button) :foreground "black") (((type x w32 mac) (class color)) @@ -2053,8 +2061,8 @@ Note: Other faces cannot inherit from the cursor face." (defface escape-glyph '((((background dark)) :foreground "cyan") (((type pc)) :foreground "magenta") - (t :foreground "dark blue")) - "Face for displaying \\ and ^ in multichar glyphs." + (t :foreground "blue")) + "Face for characters displayed as ^-sequences or \-sequences." :group 'basic-faces) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/lisp/ffap.el b/lisp/ffap.el index dc78bd355b..ab9d223256 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -42,10 +42,21 @@ ;; ;; ffap-bindings makes the following global key bindings: ;; -;; C-x C-f find-file-at-point (abbreviated as ffap) -;; C-x d dired-at-point -;; C-x 4 f ffap-other-window -;; C-x 5 f ffap-other-frame +;; C-x C-f find-file-at-point (abbreviated as ffap) +;; C-x C-r ffap-read-only +;; C-x C-v ffap-alternate-file +;; +;; C-x d dired-at-point +;; C-x C-d ffap-list-directory +;; +;; C-x 4 f ffap-other-window +;; C-x 4 r ffap-read-only-other-window +;; C-x 4 d ffap-dired-other-window +;; +;; C-x 5 f ffap-other-frame +;; C-x 5 r ffap-read-only-other-frame +;; C-x 5 d ffap-dired-other-frame +;; ;; S-mouse-3 ffap-at-mouse ;; C-S-mouse-3 ffap-menu ;; @@ -202,13 +213,17 @@ Sensible values are nil, \"news\", or \"mailto\"." ;; through this section for features that you like, put an appropriate ;; enabler in your .emacs file. -(defcustom ffap-dired-wildcards nil - ;; Suggestion from RHOGEE, 07 Jul 1994. Disabled, dired is still - ;; available by "C-x C-d <pattern>", and valid filenames may - ;; sometimes contain wildcard characters. +(defcustom ffap-dired-wildcards "[*?][^/]*\\'" "*A regexp matching filename wildcard characters, or nil. + If `find-file-at-point' gets a filename matching this pattern, -it passes it on to `dired' instead of `find-file'." +it passes it on to `find-file' with non-nil WILDCARDS argument, +which expands wildcards and visits multiple files. To visit +a file whose name contains wildcard characters you can suppress +wildcard expansion by setting `find-file-wildcards'. + +If `dired-at-point' gets a filename matching this pattern, +it passes it on to `dired'." :type '(choice (const :tag "Disable" nil) (const :tag "Enable" "[*?][^/]*\\'") ;; regexp -- probably not useful @@ -236,6 +251,12 @@ ffap most of the time." :group 'ffap) (put 'ffap-file-finder 'risky-local-variable t) +(defcustom ffap-directory-finder 'dired + "*The command called by `dired-at-point' to find a directory." + :type 'function + :group 'ffap) +(put 'ffap-directory-finder 'risky-local-variable t) + (defcustom ffap-url-fetcher (if (fboundp 'browse-url) 'browse-url ; rely on browse-url-browser-function @@ -939,7 +960,7 @@ If t, `ffap-tex-init' will initialize this when needed.") ;; Slightly controversial decisions: ;; * strip trailing "@" and ":" ;; * no commas (good for latex) - (file "--:$+<>@-Z_a-z~" "<@" "@>;.,!?:") + (file "--:$+<>@-Z_a-z~*?" "<@" "@>;.,!:") ;; An url, or maybe a email/news message-id: (url "--:=&?$+@-Z_a-z~#,%;" "^A-Za-z0-9" ":;.,!?") ;; Find a string that does *not* contain a colon: @@ -1120,8 +1141,8 @@ which may actually result in an url rather than a filename." (default-directory default-directory)) (unwind-protect (cond - ;; Immediate rejects (/ and // are too common in C++): - ((member name '("" "/" "//" ".")) nil) + ;; Immediate rejects (/ and // and /* are too common in C/C++): + ((member name '("" "/" "//" "/*" ".")) nil) ;; Immediately test local filenames. If default-directory is ;; remote, you probably already have a connection. ((and (not abs) (ffap-file-exists-string name))) @@ -1187,6 +1208,12 @@ which may actually result in an url rather than a filename." remote-dir (substring name (match-end 1))))) (ffap-file-exists-string (ffap-replace-file-component remote-dir name)))))) + ((and ffap-dired-wildcards + (string-match ffap-dired-wildcards name) + abs + (ffap-file-exists-string (file-name-directory + (directory-file-name name))) + name)) ;; Try all parent directories by deleting the trailing directory ;; name until existing directory is found or name stops changing ((let ((dir name)) @@ -1227,7 +1254,9 @@ which may actually result in an url rather than a filename." dir nil (if dir (cons guess (length dir)) guess) - (list 'file-name-history)))) + (list 'file-name-history) + (and buffer-file-name + (abbreviate-file-name buffer-file-name))))) ;; Do file substitution like (interactive "F"), suggested by MCOOK. (or (ffap-url-p guess) (setq guess (substitute-in-file-name guess))) ;; Should not do it on url's, where $ is a common (VMS?) character. @@ -1357,10 +1386,12 @@ See <ftp://ftp.mathcs.emory.edu/pub/mic/emacs/> for latest version." ((ffap-url-p filename) (let (current-prefix-arg) ; w3 2.3.25 bug, reported by KPC (funcall ffap-url-fetcher filename))) - ;; This junk more properly belongs in a modified ffap-file-finder: ((and ffap-dired-wildcards - (string-match ffap-dired-wildcards filename)) - (dired filename)) + (string-match ffap-dired-wildcards filename) + find-file-wildcards + ;; Check if it's find-file that supports wildcards arg + (memq ffap-file-finder '(find-file find-alternate-file))) + (funcall ffap-file-finder (expand-file-name filename) t)) ((or (not ffap-newfile-prompt) (file-exists-p filename) (y-or-n-p "File does not exist, create buffer? ")) @@ -1556,9 +1587,7 @@ Return value: ))) -;;; ffap-other-* commands: -;; -;; Requested by KPC. +;;; ffap-other-*, ffap-read-only-*, ffap-alternate-* commands: ;; There could be a real `ffap-noselect' function, but we would need ;; at least two new user variables, and there is no w3-fetch-noselect. @@ -1568,23 +1597,70 @@ Return value: "Like `ffap', but put buffer in another window. Only intended for interactive use." (interactive) - (switch-to-buffer-other-window - (save-window-excursion (call-interactively 'ffap) (current-buffer)))) + (let (value) + (switch-to-buffer-other-window + (save-window-excursion + (setq value (call-interactively 'ffap)) + (unless (or (bufferp value) (bufferp (car-safe value))) + (setq value (current-buffer))) + (current-buffer))) + value)) (defun ffap-other-frame nil "Like `ffap', but put buffer in another frame. Only intended for interactive use." (interactive) ;; Extra code works around dedicated windows (noted by JENS, 7/96): - (let* ((win (selected-window)) (wdp (window-dedicated-p win))) + (let* ((win (selected-window)) + (wdp (window-dedicated-p win)) + value) (unwind-protect (progn (set-window-dedicated-p win nil) (switch-to-buffer-other-frame (save-window-excursion - (call-interactively 'ffap) + (setq value (call-interactively 'ffap)) + (unless (or (bufferp value) (bufferp (car-safe value))) + (setq value (current-buffer))) (current-buffer)))) - (set-window-dedicated-p win wdp)))) + (set-window-dedicated-p win wdp)) + value)) + +(defun ffap-read-only () + "Like `ffap', but mark buffer as read-only. +Only intended for interactive use." + (interactive) + (let ((value (call-interactively 'ffap))) + (unless (or (bufferp value) (bufferp (car-safe value))) + (setq value (current-buffer))) + (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) + (if (listp value) value (list value))) + value)) + +(defun ffap-read-only-other-window () + "Like `ffap', but put buffer in another window and mark as read-only. +Only intended for interactive use." + (interactive) + (let ((value (ffap-other-window))) + (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) + (if (listp value) value (list value))) + value)) + +(defun ffap-read-only-other-frame () + "Like `ffap', but put buffer in another frame and mark as read-only. +Only intended for interactive use." + (interactive) + (let ((value (ffap-other-frame))) + (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) + (if (listp value) value (list value))) + value)) + +(defun ffap-alternate-file () + "Like `ffap' and `find-alternate-file'. +Only intended for interactive use." + (interactive) + (let ((ffap-file-finder 'find-alternate-file)) + (call-interactively 'ffap))) ;;; Bug Reporter: @@ -1665,24 +1741,26 @@ ffap most of the time." (not current-prefix-arg) current-prefix-arg)) (let (current-prefix-arg) ; already interpreted - (call-interactively 'dired)) + (call-interactively ffap-directory-finder)) (or filename (setq filename (dired-at-point-prompter))) (cond ((ffap-url-p filename) (funcall ffap-url-fetcher filename)) ((and ffap-dired-wildcards (string-match ffap-dired-wildcards filename)) - (dired filename)) + (funcall ffap-directory-finder filename)) ((file-exists-p filename) (if (file-directory-p filename) - (dired (expand-file-name filename)) - (dired (concat (expand-file-name filename) "*")))) + (funcall ffap-directory-finder + (expand-file-name filename)) + (funcall ffap-directory-finder + (concat (expand-file-name filename) "*")))) ((and (file-writable-p (or (file-name-directory (directory-file-name filename)) filename)) (y-or-n-p "Directory does not exist, create it? ")) (make-directory filename) - (dired filename)) + (funcall ffap-directory-finder filename)) ((error "No such file or directory `%s'" filename))))) (defun dired-at-point-prompter (&optional guess) @@ -1712,16 +1790,66 @@ ffap most of the time." (and guess (ffap-highlight)))) (ffap-highlight t))) +;;; ffap-dired-other-*, ffap-list-directory commands: + +(defun ffap-dired-other-window () + "Like `dired-at-point', but put buffer in another window. +Only intended for interactive use." + (interactive) + (let (value) + (switch-to-buffer-other-window + (save-window-excursion + (setq value (call-interactively 'dired-at-point)) + (current-buffer))) + value)) + +(defun ffap-dired-other-frame () + "Like `dired-at-point', but put buffer in another frame. +Only intended for interactive use." + (interactive) + ;; Extra code works around dedicated windows (noted by JENS, 7/96): + (let* ((win (selected-window)) + (wdp (window-dedicated-p win)) + value) + (unwind-protect + (progn + (set-window-dedicated-p win nil) + (switch-to-buffer-other-frame + (save-window-excursion + (setq value (call-interactively 'dired-at-point)) + (current-buffer)))) + (set-window-dedicated-p win wdp)) + value)) + +(defun ffap-list-directory () + "Like `dired-at-point' and `list-directory'. +Only intended for interactive use." + (interactive) + (let ((ffap-directory-finder 'list-directory)) + (call-interactively 'dired-at-point))) + + ;;; Offer default global bindings (`ffap-bindings'): (defvar ffap-bindings '( (global-set-key [S-mouse-3] 'ffap-at-mouse) (global-set-key [C-S-mouse-3] 'ffap-menu) + (global-set-key "\C-x\C-f" 'find-file-at-point) + (global-set-key "\C-x\C-r" 'ffap-read-only) + (global-set-key "\C-x\C-v" 'ffap-alternate-file) + (global-set-key "\C-x4f" 'ffap-other-window) (global-set-key "\C-x5f" 'ffap-other-frame) + (global-set-key "\C-x4r" 'ffap-read-only-other-window) + (global-set-key "\C-x5r" 'ffap-read-only-other-frame) + (global-set-key "\C-xd" 'dired-at-point) + (global-set-key "\C-x4d" 'ffap-dired-other-window) + (global-set-key "\C-x5d" 'ffap-dired-other-frame) + (global-set-key "\C-x\C-d" 'ffap-list-directory) + (add-hook 'gnus-summary-mode-hook 'ffap-gnus-hook) (add-hook 'gnus-article-mode-hook 'ffap-gnus-hook) (add-hook 'vm-mode-hook 'ffap-ro-mode-hook) diff --git a/lisp/filecache.el b/lisp/filecache.el index bd0b0f7778..90287ba5ee 100644 --- a/lisp/filecache.el +++ b/lisp/filecache.el @@ -337,21 +337,20 @@ in each directory, not to the directory list itself." Find is run in DIRECTORY." (interactive "DAdd files under directory: ") (let ((dir (expand-file-name directory))) - (if (eq file-cache-find-command-posix-flag 'not-defined) - (setq file-cache-find-command-posix-flag - (executable-command-find-posix-p file-cache-find-command))) + (when (memq system-type '(windows-nt cygwin)) + (if (eq file-cache-find-command-posix-flag 'not-defined) + (setq file-cache-find-command-posix-flag + (executable-command-find-posix-p file-cache-find-command)))) (set-buffer (get-buffer-create file-cache-buffer)) (erase-buffer) (call-process file-cache-find-command nil (get-buffer file-cache-buffer) nil dir "-name" - (cond - (file-cache-find-command-posix-flag - "\\*") - ((eq system-type 'windows-nt) - "'*'") - (t - "*")) + (if (memq system-type '(windows-nt cygwin)) + (if file-cache-find-command-posix-flag + "\\*" + "'*'") + "*") "-print") (file-cache-add-from-file-cache-buffer))) diff --git a/lisp/files.el b/lisp/files.el index 62068b2f21..0c7a6fff51 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -932,8 +932,7 @@ suppress wildcard expansion by setting `find-file-wildcards'. To visit a file without any kind of conversion and without automatically choosing a major mode, use \\[find-file-literally]." - (interactive - (find-file-read-args "Find file: " nil)) + (interactive (find-file-read-args "Find file: " nil)) (let ((value (find-file-noselect filename nil nil wildcards))) (if (listp value) (mapcar 'switch-to-buffer (nreverse value)) @@ -955,8 +954,8 @@ expand wildcards (if any) and visit multiple files." (if (listp value) (progn (setq value (nreverse value)) - (switch-to-buffer-other-window (car value)) - (mapcar 'switch-to-buffer (cdr value))) + (cons (switch-to-buffer-other-window (car value)) + (mapcar 'switch-to-buffer (cdr value)))) (switch-to-buffer-other-window value)))) (defun find-file-other-frame (filename &optional wildcards) @@ -975,8 +974,8 @@ expand wildcards (if any) and visit multiple files." (if (listp value) (progn (setq value (nreverse value)) - (switch-to-buffer-other-frame (car value)) - (mapcar 'switch-to-buffer (cdr value))) + (cons (switch-to-buffer-other-frame (car value)) + (mapcar 'switch-to-buffer (cdr value)))) (switch-to-buffer-other-frame value)))) (defun find-file-existing (filename &optional wildcards) @@ -991,35 +990,53 @@ Like \\[find-file] but only allow files that exists." "Edit file FILENAME but don't allow changes. Like \\[find-file] but marks buffer as read-only. Use \\[toggle-read-only] to permit editing." - (interactive (find-file-read-args "Find file read-only: " t)) - (unless (file-exists-p filename) (error "%s does not exist" filename)) - (find-file filename wildcards) - (toggle-read-only 1) - (current-buffer)) + (interactive (find-file-read-args "Find file read-only: " nil)) + (unless (or (and wildcards find-file-wildcards + (not (string-match "\\`/:" filename)) + (string-match "[[*?]" filename)) + (file-exists-p filename)) + (error "%s does not exist" filename)) + (let ((value (find-file filename wildcards))) + (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) + (if (listp value) value (list value))) + value)) (defun find-file-read-only-other-window (filename &optional wildcards) "Edit file FILENAME in another window but don't allow changes. Like \\[find-file-other-window] but marks buffer as read-only. Use \\[toggle-read-only] to permit editing." - (interactive (find-file-read-args "Find file read-only other window: " t)) - (unless (file-exists-p filename) (error "%s does not exist" filename)) - (find-file-other-window filename wildcards) - (toggle-read-only 1) - (current-buffer)) + (interactive (find-file-read-args "Find file read-only other window: " nil)) + (unless (or (and wildcards find-file-wildcards + (not (string-match "\\`/:" filename)) + (string-match "[[*?]" filename)) + (file-exists-p filename)) + (error "%s does not exist" filename)) + (let ((value (find-file-other-window filename wildcards))) + (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) + (if (listp value) value (list value))) + value)) (defun find-file-read-only-other-frame (filename &optional wildcards) "Edit file FILENAME in another frame but don't allow changes. Like \\[find-file-other-frame] but marks buffer as read-only. Use \\[toggle-read-only] to permit editing." - (interactive (find-file-read-args "Find file read-only other frame: " t)) - (unless (file-exists-p filename) (error "%s does not exist" filename)) - (find-file-other-frame filename wildcards) - (toggle-read-only 1) - (current-buffer)) - -(defun find-alternate-file-other-window (filename) + (interactive (find-file-read-args "Find file read-only other frame: " nil)) + (unless (or (and wildcards find-file-wildcards + (not (string-match "\\`/:" filename)) + (string-match "[[*?]" filename)) + (file-exists-p filename)) + (error "%s does not exist" filename)) + (let ((value (find-file-other-frame filename wildcards))) + (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) + (if (listp value) value (list value))) + value)) + +(defun find-alternate-file-other-window (filename &optional wildcards) "Find file FILENAME as a replacement for the file in the next window. -This command does not select that window." +This command does not select that window. + +Interactively, or if WILDCARDS is non-nil in a call from Lisp, +expand wildcards (if any) and replace the file with multiple files." (interactive (save-selected-window (other-window 1) @@ -1030,17 +1047,21 @@ This command does not select that window." (setq file-name (file-name-nondirectory file) file-dir (file-name-directory file))) (list (read-file-name - "Find alternate file: " file-dir nil nil file-name))))) + "Find alternate file: " file-dir nil nil file-name) + t)))) (if (one-window-p) - (find-file-other-window filename) + (find-file-other-window filename wildcards) (save-selected-window (other-window 1) - (find-alternate-file filename)))) + (find-alternate-file filename wildcards)))) -(defun find-alternate-file (filename) +(defun find-alternate-file (filename &optional wildcards) "Find file FILENAME, select its buffer, kill previous buffer. If the current buffer now contains an empty file that you just visited -\(presumably by mistake), use this command to visit the file you really want." +\(presumably by mistake), use this command to visit the file you really want. + +Interactively, or if WILDCARDS is non-nil in a call from Lisp, +expand wildcards (if any) and replace the file with multiple files." (interactive (let ((file buffer-file-name) (file-name nil) @@ -1049,7 +1070,8 @@ If the current buffer now contains an empty file that you just visited (setq file-name (file-name-nondirectory file) file-dir (file-name-directory file))) (list (read-file-name - "Find alternate file: " file-dir nil nil file-name)))) + "Find alternate file: " file-dir nil nil file-name) + t))) (unless (run-hook-with-args-until-failure 'kill-buffer-query-functions) (error "Aborted")) (when (and (buffer-modified-p) (buffer-file-name)) @@ -1077,7 +1099,7 @@ If the current buffer now contains an empty file that you just visited (setq buffer-file-truename nil) ;; Likewise for dired buffers. (setq dired-directory nil) - (find-file filename)) + (find-file filename wildcards)) (when (eq obuf (current-buffer)) ;; This executes if find-file gets an error ;; and does not really find anything. @@ -1247,8 +1269,8 @@ Optional first arg NOWARN non-nil means suppress any warning messages. Optional second arg RAWFILE non-nil means the file is read literally. Optional third arg WILDCARDS non-nil means do wildcard processing and visit all the matching files. When wildcards are actually -used and expanded, the value is a list of buffers -that are visiting the various files." +used and expanded, return a list of buffers that are visiting +the various files." (setq filename (abbreviate-file-name (expand-file-name filename))) @@ -1757,6 +1779,7 @@ in that case, this function acts as if `enable-local-variables' were t." ("\\.ses\\'" . ses-mode) ("\\.\\(soa\\|zone\\)\\'" . dns-mode) ("\\.docbook\\'" . sgml-mode) + ("\\.com\\'" . dcl-mode) ("/config\\.\\(?:bat\\|log\\)\\'" . fundamental-mode) ;; Windows candidates may be opened case sensitively on Unix ("\\.\\(?:[iI][nN][iI]\\|[lL][sS][tT]\\|[rR][eE][gG]\\|[sS][yY][sS]\\)\\'" . conf-mode) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 47945169a5..bb7b8337f4 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,7 +1,22 @@ +2004-12-17 Kim F. Storm <[email protected]> + + * gnus-group.el (gnus-group-mode-map): Map follow-link to mouse-face. + + * gnus-sum.el (gnus-summary-mode-map): Likewise. + 2004-12-08 Stefan Monnier <[email protected]> * gnus-art.el (gnus-narrow-to-page): Don't hardcode point-min. +2004-12-13 Katsumi Yamaoka <[email protected]> + + * gnus-group.el (gnus-group-make-rss-group): Use + gnus-group-make-group instead of gnus-group-unsubscribe-group. + + * gnus-start.el (gnus-setup-news): Honor user's setting to + gnus-message-archive-method. Suggested by Lute Kamstra + <[email protected]>. + 2004-12-02 Katsumi Yamaoka <[email protected]> * message.el (message-forward-make-body-mml): Remove headers @@ -896,7 +911,7 @@ * gnus-delay.el (gnus-delay-default-hour): Add :version. * gnus-cite.el (gnus-cite-blank-line-after-header) - (gnus-article-boring-faces): + (gnus-article-boring-faces): * gnus-art.el (gnus-buttonized-mime-types) (gnus-inhibit-mime-unbuttonizing) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index c55264b22d..336b635a6a 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -591,6 +591,7 @@ simple manner.") "\M-e" gnus-group-edit-group-method "^" gnus-group-enter-server-mode gnus-mouse-2 gnus-mouse-pick-group + [follow-link] mouse-face "<" beginning-of-buffer ">" end-of-buffer "\C-c\C-b" gnus-bug @@ -2592,8 +2593,7 @@ If there is, use Gnus to create an nnrss group" (href (cdr (assoc 'href feedinfo)))) (push (list title href desc) nnrss-group-alist) - (gnus-group-unsubscribe-group - (concat "nnrss:" title)) + (gnus-group-make-group title '(nnrss "")) (nnrss-save-server-data nil)) (error "No feeds found for %s" url)))) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 17b0f1d687..e1985c5db5 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -952,16 +952,28 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." ;; Make sure the archive server is available to all and sundry. (when gnus-message-archive-method (unless (assoc "archive" gnus-server-alist) - (push `("archive" - nnfolder - "archive" - (nnfolder-directory - ,(nnheader-concat message-directory "archive")) - (nnfolder-active-file - ,(nnheader-concat message-directory "archive/active")) - (nnfolder-get-new-mail nil) - (nnfolder-inhibit-expiry t)) - gnus-server-alist))) + (let ((method (or (and (stringp gnus-message-archive-method) + (gnus-server-to-method + gnus-message-archive-method)) + gnus-message-archive-method))) + ;; Check whether the archive method is writable. + (unless (or (stringp method) + (memq 'respool (assoc (format "%s" (car method)) + gnus-valid-select-methods))) + (setq method "archive")) ;; The default. + (push (if (stringp method) + `("archive" + nnfolder + ,method + (nnfolder-directory + ,(nnheader-concat message-directory method)) + (nnfolder-active-file + ,(nnheader-concat message-directory + (concat method "/active"))) + (nnfolder-get-new-mail nil) + (nnfolder-inhibit-expiry t)) + (cons "archive" method)) + gnus-server-alist)))) ;; If we don't read the complete active file, we fill in the ;; hashtb here. diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 03e1624237..c4f320e888 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -1703,6 +1703,7 @@ increase the score of each group you read." "Q" gnus-summary-exit-no-update "\C-c\C-i" gnus-info-find-node gnus-mouse-2 gnus-mouse-pick-article + [follow-link] mouse-face "m" gnus-summary-mail-other-window "a" gnus-summary-post-news "i" gnus-summary-news-other-window @@ -5096,7 +5097,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (when gnus-agent (gnus-agent-possibly-alter-active group (gnus-active group) info) - + (setq gnus-summary-use-undownloaded-faces (gnus-agent-find-parameter group @@ -7044,7 +7045,7 @@ If optional argument UNREAD is non-nil, only unread article is selected." (gnus-summary-goto-subject article t))) (gnus-summary-limit (append articles gnus-newsgroup-limit)) (gnus-summary-position-point)) - + (defun gnus-summary-goto-subject (article &optional force silent) "Go the subject line of ARTICLE. If FORCE, also allow jumping to articles not currently shown." @@ -9140,7 +9141,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." ;;;!!!Why is this necessary? (set-buffer gnus-summary-buffer) - + (gnus-summary-goto-subject article) (when (eq action 'move) (gnus-summary-mark-article article gnus-canceled-mark)))) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index c06a7b1ee7..f799fbd9be 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -478,8 +478,13 @@ Return 0 if there is no such symbol." (and (symbolp obj) (boundp obj) obj)))) (error nil)) (let* ((str (find-tag-default)) - (obj (if str (intern str)))) - (and (symbolp obj) (boundp obj) obj)) + (sym (if str (intern-soft str)))) + (if (and sym (boundp sym)) + sym + (save-match-data + (when (and str (string-match "\\`\\W*\\(.*?\\)\\W*\\'" str)) + (setq sym (intern-soft (match-string 1 str))) + (and (boundp sym) sym))))) 0)) ;;;###autoload @@ -564,6 +569,7 @@ it is displayed along with the global value." (insert " value is shown ") (insert-button "below" 'action help-button-cache + 'follow-link t 'help-echo "mouse-2, RET: show value") (insert ".\n\n"))) ;; Add a note for variables that have been make-var-buffer-local. diff --git a/lisp/help-mode.el b/lisp/help-mode.el index a2dcdf91ed..e9d3561d25 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -68,6 +68,7 @@ The format is (FUNCTION ARGS...).") ;; Button types used by help (define-button-type 'help-xref + 'follow-link t 'action #'help-button-action) (defun help-button-action (button) diff --git a/lisp/help.el b/lisp/help.el index 5ec9b1f529..f5831c9ab3 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -267,8 +267,13 @@ If that doesn't give a function, return nil." (and (symbolp obj) (fboundp obj) obj)))) (error nil)))) (let* ((str (find-tag-default)) - (obj (if str (intern str)))) - (and (symbolp obj) (fboundp obj) obj)))) + (sym (if str (intern-soft str)))) + (if (and sym (fboundp sym)) + sym + (save-match-data + (when (and str (string-match "\\`\\W*\\(.*?\\)\\W*\\'" str)) + (setq sym (intern-soft (match-string 1 str))) + (and (fboundp sym) sym))))))) ;;; `User' help functions @@ -609,17 +614,58 @@ the last key hit are used." (princ "\n which is ") (describe-function-1 defn) (when up-event - (let ((defn (or (string-key-binding up-event) (key-binding up-event)))) + (let ((ev (aref up-event 0)) + (descr (key-description up-event)) + (hdr "\n\n-------------- up event ---------------\n\n") + defn + mouse-1-tricky mouse-1-remapped) + (when (and (consp ev) + (eq (car ev) 'mouse-1) + (windowp window) + mouse-1-click-follows-link + (not (eq mouse-1-click-follows-link 'double)) + (with-current-buffer (window-buffer window) + (mouse-on-link-p (posn-point (event-start ev))))) + (setq mouse-1-tricky (integerp mouse-1-click-follows-link) + mouse-1-remapped (or (not mouse-1-tricky) + (> mouse-1-click-follows-link 0))) + (if mouse-1-remapped + (setcar ev 'mouse-2))) + (setq defn (or (string-key-binding up-event) (key-binding up-event))) (unless (or (null defn) (integerp defn) (equal defn 'undefined)) - (princ "\n\n-------------- up event ---------------\n\n") - (princ (key-description up-event)) + (princ (if mouse-1-tricky + "\n\n----------------- up-event (short click) ----------------\n\n" + hdr)) + (setq hdr nil) + (princ descr) (if (windowp window) (princ " at that spot")) + (if mouse-1-remapped + (princ " is remapped to <mouse-2>\n which" )) (princ " runs the command ") (prin1 defn) (princ "\n which is ") - (describe-function-1 defn)))) - (print-help-return-message))))))) + (describe-function-1 defn)) + (when mouse-1-tricky + (setcar ev + (if (> mouse-1-click-follows-link 0) 'mouse-1 'mouse-2)) + (setq defn (or (string-key-binding up-event) (key-binding up-event))) + (unless (or (null defn) (integerp defn) (equal defn 'undefined)) + (princ (or hdr + "\n\n----------------- up-event (long click) ----------------\n\n")) + (princ "Pressing ") + (princ descr) + (if (windowp window) + (princ " at that spot")) + (princ (format " for longer than %d milli-seconds\n" + (abs mouse-1-click-follows-link))) + (if (not mouse-1-remapped) + (princ " remaps it to <mouse-2> which" )) + (princ " runs the command ") + (prin1 defn) + (princ "\n which is ") + (describe-function-1 defn)))) + (print-help-return-message)))))))) (defun describe-mode (&optional buffer) @@ -692,6 +738,7 @@ whose documentation describes the minor mode." (princ " ") (insert-button pretty-minor-mode 'action (car help-button-cache) + 'follow-link t 'help-echo "mouse-2, RET: show full information") (princ (format " minor mode (%s):\n" (if indicator diff --git a/lisp/info-look.el b/lisp/info-look.el index 388415ec8c..bc886f0320 100644 --- a/lisp/info-look.el +++ b/lisp/info-look.el @@ -47,7 +47,7 @@ Automatically becomes buffer local when set in any fashion.") "Non-nil means pop up the Info buffer in another window." :group 'info-lookup :type 'boolean) -(defcustom info-lookup-highlight-face 'highlight +(defcustom info-lookup-highlight-face 'match "Face for highlighting looked up help items. Setting this variable to nil disables highlighting." :group 'info-lookup :type 'face) diff --git a/lisp/info.el b/lisp/info.el index ef4225e5a3..750f302d42 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -86,7 +86,7 @@ The Lisp code is executed when the node is selected.") :group 'info) (defface info-xref-visited - '((t :inherit info-xref) + '((default :inherit info-xref) (((class color) (background light)) :foreground "magenta4") (((class color) (background dark)) :foreground "magenta3")) ;"violet"? "Face for visited Info cross-references." @@ -2834,8 +2834,7 @@ if point is in a menu item description, follow that menu item." "Follow a node reference near point. Return non-nil if successful." (let (node) (cond - ((and (Info-get-token (point) "[hf]t?tp://" "[hf]t?tp://\\([^ \t\n\"`({<>})']+\\)") - (or (featurep 'browse-url) (require 'browse-url nil t))) + ((Info-get-token (point) "[hf]t?tp://" "[hf]t?tp://\\([^ \t\n\"`({<>})']+\\)") (setq node t) (browse-url (browse-url-url-at-point))) ((setq node (Info-get-token (point) "\\*note[ \n\t]+" diff --git a/lisp/international/isearch-x.el b/lisp/international/isearch-x.el index 60736277b9..aad6b6e745 100644 --- a/lisp/international/isearch-x.el +++ b/lisp/international/isearch-x.el @@ -97,7 +97,7 @@ (defun isearch-process-search-multibyte-characters (last-char) (if (eq this-command 'isearch-printing-char) (let ((overriding-terminal-local-map nil) - (prompt (concat (isearch-message-prefix) isearch-message)) + (prompt (concat (isearch-message-prefix))) (minibuffer-local-map isearch-minibuffer-local-map) str) (if isearch-input-method-function @@ -107,11 +107,12 @@ (cons 'with-input-method (cons last-char unread-command-events)) ;; Inherit current-input-method in a minibuffer. - str (read-string prompt nil nil nil t)) + str (read-string prompt isearch-message nil nil t)) (if (not str) ;; All inputs were deleted while the input method ;; was working. (setq str "") + (setq str (substring str (length isearch-message))) (if (and (= (length str) 1) (= (aref str 0) last-char) (>= last-char 128)) diff --git a/lisp/international/quail.el b/lisp/international/quail.el index d10e215881..992f7ed56a 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -1371,11 +1371,12 @@ Return the input string." (while quail-translating (set-buffer-modified-p modified-p) (quail-show-guidance) - (let* ((keyseq (read-key-sequence - (and input-method-use-echo-area - (concat input-method-previous-message - quail-current-str)) - nil nil t)) + (let* ((prompt (if input-method-use-echo-area + (format "%s%s %s" + (or input-method-previous-message "") + quail-current-str + quail-guidance-str))) + (keyseq (read-key-sequence prompt nil nil t)) (cmd (lookup-key (quail-translation-keymap) keyseq))) (if (if key (and (commandp cmd) (not (eq cmd 'quail-other-command))) @@ -1436,12 +1437,13 @@ Return the input string." quail-translating t) (quail-setup-overlays nil))) (quail-show-guidance) - (let* ((keyseq (read-key-sequence - (and input-method-use-echo-area - (concat input-method-previous-message - quail-conversion-str - quail-current-str)) - nil nil t)) + (let* ((prompt (if input-method-use-echo-area + (format "%s%s%s %s" + (or input-method-previous-message "") + quail-conversion-str + quail-current-str + quail-guidance-str))) + (keyseq (read-key-sequence prompt nil nil t)) (cmd (lookup-key (quail-conversion-keymap) keyseq))) (if (if key (commandp cmd) (eq cmd 'quail-self-insert-command)) (progn @@ -1950,10 +1952,10 @@ minibuffer and the selected frame has no other windows)." ;; Then, show the guidance. (when (and (quail-require-guidance-buf) + (not input-method-use-echo-area) (null unread-command-events) (null unread-post-input-method-events)) - (if (or (eq (selected-window) (minibuffer-window)) - input-method-use-echo-area) + (if (eq (selected-window) (minibuffer-window)) (if (eq (minibuffer-window) (frame-root-window)) ;; Use another frame. It is sure that we are using some ;; window system. diff --git a/lisp/isearch.el b/lisp/isearch.el index 77139988bb..f94590ded2 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -229,7 +229,6 @@ Default value, nil, means edit the string instead." (while (< i 256) (define-key map (vector i) 'isearch-printing-char) (setq i (1+ i))) - (define-key map (vector i) 'isearch-printing-char) ;; To handle local bindings with meta char prefix keys, define ;; another full keymap. This must be done for any other prefix @@ -654,7 +653,7 @@ is treated as a regexp. See \\[isearch-forward] for more info." (setq ;; quit-flag nil not for isearch-mode isearch-adjusted nil isearch-yank-flag nil) - (isearch-lazy-highlight-new-loop) + (if isearch-lazy-highlight (isearch-lazy-highlight-new-loop)) ;; We must prevent the point moving to the end of composition when a ;; part of the composition has just been searched. (setq disable-point-adjustment t)) @@ -944,7 +943,7 @@ If first char entered is \\[isearch-yank-word-or-char], then do word search inst (isearch-message-prefix nil nil isearch-nonincremental) isearch-string minibuffer-local-isearch-map nil - 'junk-ring)) + 'junk-ring nil t)) isearch-new-message (mapconcat 'isearch-text-char-description isearch-new-string ""))) @@ -2334,8 +2333,7 @@ is nil. This function is called when exiting an incremental search if "Cleanup any previous `isearch-lazy-highlight' loop and begin a new one. This happens when `isearch-update' is invoked (which can cause the search string to change or the window to scroll)." - (when (and isearch-lazy-highlight - (null executing-kbd-macro) + (when (and (null executing-kbd-macro) (sit-for 0) ;make sure (window-start) is credible (or (not (equal isearch-string isearch-lazy-highlight-last-string)) @@ -2387,59 +2385,64 @@ Attempt to do the search exactly the way the pending isearch would." (let ((max isearch-lazy-highlight-max-at-a-time) (looping t) nomore) - (save-excursion - (save-match-data - (goto-char (if isearch-forward - isearch-lazy-highlight-end - isearch-lazy-highlight-start)) - (while looping - (let ((found (isearch-lazy-highlight-search))) - (when max - (setq max (1- max)) - (if (<= max 0) - (setq looping nil))) - (if found - (let ((mb (match-beginning 0)) - (me (match-end 0))) - (if (= mb me) ;zero-length match + (with-local-quit + (save-selected-window + (if (and (window-live-p isearch-lazy-highlight-window) + (not (eq (selected-window) isearch-lazy-highlight-window))) + (select-window isearch-lazy-highlight-window)) + (save-excursion + (save-match-data + (goto-char (if isearch-forward + isearch-lazy-highlight-end + isearch-lazy-highlight-start)) + (while looping + (let ((found (isearch-lazy-highlight-search))) + (when max + (setq max (1- max)) + (if (<= max 0) + (setq looping nil))) + (if found + (let ((mb (match-beginning 0)) + (me (match-end 0))) + (if (= mb me) ;zero-length match + (if isearch-forward + (if (= mb (if isearch-lazy-highlight-wrapped + isearch-lazy-highlight-start + (window-end))) + (setq found nil) + (forward-char 1)) + (if (= mb (if isearch-lazy-highlight-wrapped + isearch-lazy-highlight-end + (window-start))) + (setq found nil) + (forward-char -1))) + + ;; non-zero-length match + (let ((ov (make-overlay mb me))) + (push ov isearch-lazy-highlight-overlays) + (overlay-put ov 'face isearch-lazy-highlight-face) + (overlay-put ov 'priority 0) ;lower than main overlay + (overlay-put ov 'window (selected-window)))) + (if isearch-forward + (setq isearch-lazy-highlight-end (point)) + (setq isearch-lazy-highlight-start (point))))) + + ;; not found or zero-length match at the search bound + (if (not found) + (if isearch-lazy-highlight-wrapped + (setq looping nil + nomore t) + (setq isearch-lazy-highlight-wrapped t) (if isearch-forward - (if (= mb (if isearch-lazy-highlight-wrapped - isearch-lazy-highlight-start - (window-end))) - (setq found nil) - (forward-char 1)) - (if (= mb (if isearch-lazy-highlight-wrapped - isearch-lazy-highlight-end - (window-start))) - (setq found nil) - (forward-char -1))) - - ;; non-zero-length match - (let ((ov (make-overlay mb me))) - (overlay-put ov 'face isearch-lazy-highlight-face) - (overlay-put ov 'priority 0) ;lower than main overlay - (overlay-put ov 'window (selected-window)) - (push ov isearch-lazy-highlight-overlays))) - (if isearch-forward - (setq isearch-lazy-highlight-end (point)) - (setq isearch-lazy-highlight-start (point))))) - - ;; not found or zero-length match at the search bound - (if (not found) - (if isearch-lazy-highlight-wrapped - (setq looping nil - nomore t) - (setq isearch-lazy-highlight-wrapped t) - (if isearch-forward - (progn - (setq isearch-lazy-highlight-end (window-start)) - (goto-char (window-start))) - (setq isearch-lazy-highlight-start (window-end)) - (goto-char (window-end))))))) - (unless nomore - (setq isearch-lazy-highlight-timer - (run-at-time isearch-lazy-highlight-interval nil - 'isearch-lazy-highlight-update))))))) + (progn + (setq isearch-lazy-highlight-end (window-start)) + (goto-char (window-start))) + (setq isearch-lazy-highlight-start (window-end)) + (goto-char (window-end))))))) + (unless nomore + (setq isearch-lazy-highlight-timer + (run-at-time isearch-lazy-highlight-interval nil + 'isearch-lazy-highlight-update))))))))) (defun isearch-resume (search regexp word forward message case-fold) "Resume an incremental search. diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el index c1f4b6f017..06282c430f 100644 --- a/lisp/mail/supercite.el +++ b/lisp/mail/supercite.el @@ -146,8 +146,9 @@ Each element of this list has the following form: (...))) Where INFOKEY is a key for `sc-mail-field', REGEXP is a regular -expression to match against the INFOKEY's value. FRAME is a citation -frame, or a variable containing a citation frame." +expression to match against the INFOKEY's value. FRAME is +a citation frame, or a symbol that represents the name of +a variable whose value is a citation frame." :type '(repeat (list symbol (repeat (cons regexp (choice (repeat (repeat sexp)) symbol))))) @@ -1434,12 +1435,11 @@ When called interactively, the optional arg INTERACTIVE is non-nil, and that means call `sc-select-attribution' too." (interactive "r\nP\np") (undo-boundary) - (let ((frame (or (sc-scan-info-alist - (if (symbolp sc-cite-frame-alist) - (symbol-value sc-cite-frame-alist) - sc-cite-frame-alist)) - sc-default-cite-frame)) + (let ((frame (sc-scan-info-alist sc-cite-frame-alist)) (sc-confirm-always-p (if confirm-p t sc-confirm-always-p))) + (if (and frame (symbolp frame)) + (setq frame (symbol-value frame))) + (or frame (setq frame sc-default-cite-frame)) (run-hooks 'sc-pre-cite-hook) (if interactive (sc-select-attribution)) @@ -1450,11 +1450,10 @@ and that means call `sc-select-attribution' too." First runs `sc-pre-uncite-hook'." (interactive "r") (undo-boundary) - (let ((frame (or (sc-scan-info-alist - (if (symbolp sc-uncite-frame-alist) - (symbol-value sc-uncite-frame-alist) - sc-uncite-frame-alist)) - sc-default-uncite-frame))) + (let ((frame (sc-scan-info-alist sc-uncite-frame-alist))) + (if (and frame (symbolp frame)) + (setq frame (symbol-value frame))) + (or frame (setq frame sc-default-uncite-frame)) (run-hooks 'sc-pre-uncite-hook) (regi-interpret frame start end))) @@ -1465,11 +1464,10 @@ First runs `sc-pre-recite-hook'." (let ((sc-confirm-always-p t)) (sc-select-attribution)) (undo-boundary) - (let ((frame (or (sc-scan-info-alist - (if (symbolp sc-recite-frame-alist) - (symbol-value sc-recite-frame-alist) - sc-recite-frame-alist)) - sc-default-recite-frame))) + (let ((frame (sc-scan-info-alist sc-recite-frame-alist))) + (if (and frame (symbolp frame)) + (setq frame (symbol-value frame))) + (or frame (setq frame sc-default-recite-frame)) (run-hooks 'sc-pre-recite-hook) (regi-interpret frame start end))) diff --git a/lisp/mouse.el b/lisp/mouse.el index b2fa71dde2..91e2e4ae5c 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -49,6 +49,39 @@ :version "21.4" :group 'mouse) +(defcustom mouse-1-click-follows-link 350 + "Non-nil means that clicking Mouse-1 on a link follows the link. + +With the default setting, an ordinary Mouse-1 click on a link +performs the same action as Mouse-2 on that link, while a longer +Mouse-1 click \(hold down the Mouse-1 button for more than 350 +milliseconds) performs the original Mouse-1 binding \(which +typically sets point where you click the mouse). + +If value is an integer, the time elapsed between pressing and +releasing the mouse button determines whether to follow the link +or perform the normal Mouse-1 action (typically set point). +The absolute numeric value specifices the maximum duration of a +\"short click\" in milliseconds. A positive value means that a +short click follows the link, and a longer click performs the +normal action. A negative value gives the opposite behaviour. + +If value is `double', a double click follows the link. + +Otherwise, a single Mouse-1 click unconditionally follows the link. + +Note that dragging the mouse never follows the link. + +This feature only works in modes that specifically identify +clickable text as links, so it may not work with some external +packages. See `mouse-on-link-p' for details." + :version "21.4" + :type '(choice (const :tag "Disabled" nil) + (const :tag "Double click" double) + (number :tag "Single click time limit" :value 350) + (other :tag "Single click" t)) + :group 'mouse) + ;; Provide a mode-specific menu on a mouse button. @@ -733,6 +766,51 @@ If the click is in the echo area, display the `*Messages*' buffer." (run-hooks 'mouse-leave-buffer-hook) (mouse-drag-region-1 start-event)))) + +(defun mouse-on-link-p (pos) + "Return non-nil if POS is on a link in the current buffer. + +A clickable link is identified by one of the following methods: + +1) If the character at POS has a non-nil `follow-link' text or +overlay property, the value of that property is returned. + +2) If there is a local key-binding or a keybinding at position +POS for the `follow-link' event, the binding of that event +determines whether POS is inside a link: + +- If the binding is `mouse-face', POS is inside a link if there +is a non-nil `mouse-face' property at POS. Return t in this case. + +- If the binding is a function, FUNC, POS is inside a link if +the call \(FUNC POS) returns non-nil. Return the return value +from that call. + +- Otherwise, return the binding of the `follow-link' binding. + +The return value is interpreted as follows: + +- If it is a string, the mouse-1 event is translated into the +first character of the string, i.e. the action of the mouse-1 +click is the local or global binding of that character. + +- If it is a vector, the mouse-1 event is translated into the +first element of that vector, i.e. the action of the mouse-1 +click is the local or global binding of that event. + +- Otherwise, the mouse-1 event is translated into a mouse-2 event +at the same position." + (or (get-char-property pos 'follow-link) + (save-excursion + (goto-char pos) + (let ((b (key-binding [follow-link] nil t))) + (cond + ((eq b 'mouse-face) + (and (get-char-property pos 'mouse-face) t)) + ((functionp b) + (funcall b pos)) + (t b)))))) + (defun mouse-drag-region-1 (start-event) (mouse-minibuffer-check start-event) (let* ((echo-keystrokes 0) @@ -749,6 +827,7 @@ If the click is in the echo area, display the `*Messages*' buffer." (nth 3 bounds) ;; Don't count the mode line. (1- (nth 3 bounds)))) + on-link remap-double-click (click-count (1- (event-click-count start-event)))) (setq mouse-selection-click-count click-count) (setq mouse-selection-click-count-buffer (current-buffer)) @@ -758,6 +837,13 @@ If the click is in the echo area, display the `*Messages*' buffer." (if (< (point) start-point) (goto-char start-point)) (setq start-point (point)) + (setq on-link (and mouse-1-click-follows-link + (mouse-on-link-p start-point))) + (setq remap-double-click (and on-link + (eq mouse-1-click-follows-link 'double) + (= click-count 1))) + (if remap-double-click ;; Don't expand mouse overlay in links + (setq click-count 0)) (let ((range (mouse-start-end start-point start-point click-count))) (move-overlay mouse-drag-overlay (car range) (nth 1 range) (window-buffer start-window)) @@ -880,6 +966,28 @@ If the click is in the echo area, display the `*Messages*' buffer." (or end-point (= (window-start start-window) start-window-start))) + (if (and on-link + (not end-point) + (consp event) + (or remap-double-click + (and + (not (eq mouse-1-click-follows-link 'double)) + (= click-count 0) + (= (event-click-count event) 1) + (not (input-pending-p)) + (or (not (integerp mouse-1-click-follows-link)) + (let ((t0 (posn-timestamp (event-start start-event))) + (t1 (posn-timestamp (event-end event)))) + (and (integerp t0) (integerp t1) + (if (> mouse-1-click-follows-link 0) + (<= (- t1 t0) mouse-1-click-follows-link) + (< (- t0 t1) mouse-1-click-follows-link))))) + (or (not double-click-time) + (sit-for 0 (if (integerp double-click-time) + double-click-time 500) t))))) + (if (or (vectorp on-link) (stringp on-link)) + (setq event (aref on-link 0)) + (setcar event 'mouse-2))) (setq unread-command-events (cons event unread-command-events))))) (delete-overlay mouse-drag-overlay))))) diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 098f2988f1..6e679876ee 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -575,6 +575,7 @@ down (this *won't* always work)." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; URL input +;;;###autoload (defun browse-url-url-at-point () (let ((url (thing-at-point 'url))) (set-text-properties 0 (length url) nil url) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 4628af8817..d0a7cf7b65 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1105,9 +1105,11 @@ Return the difference in the format of a time value." ;; Do `PC-do-completion' without substitution (let* (save) (fset 'save (symbol-function 'substitute-in-file-name)) - (fset 'substitute-in-file-name (symbol-function 'identity)) - ad-do-it - (fset 'substitute-in-file-name (symbol-function 'save))) + (unwind-protect + (progn + (fset 'substitute-in-file-name (symbol-function 'identity)) + ad-do-it) + (fset 'substitute-in-file-name (symbol-function 'save)))) ;; Expand "$" (let* ((beg (or (and (functionp 'minibuffer-prompt-end) ; Emacs 21 diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index b0448fd25e..34572e9867 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -34,7 +34,7 @@ ;; ;; Notes: ;; ----- -;; +;; ;; This package only works for Emacs 20 and higher, and for XEmacs 21 ;; and higher. (XEmacs 20 is missing the `with-timeout' macro. Emacs ;; 19 is reported to have other problems. For XEmacs 21, you need the @@ -205,7 +205,7 @@ file name, the backup directory is prepended with Tramp file name prefix gives the same backup policy for Tramp files on their hosts like the policy for local files." - :type '(repeat + :type '(repeat (list (regexp :tag "File regexp") (string :tag "Backup Dir") (set :inline t @@ -506,7 +506,7 @@ This variable defaults to the value of `tramp-encoding-shell'." (tramp-copy-args nil) (tramp-copy-keep-date-arg "-p") (tramp-password-end-of-line "xy")) ;see docstring for "xy" - ("fcp" + ("fcp" (tramp-connection-function tramp-open-connection-rsh) (tramp-login-program "fsh") (tramp-copy-program "fcp") @@ -633,7 +633,7 @@ variable `tramp-methods'." ("rsh" tramp-multi-connect-rlogin "rsh %h -l %u%n") ("remsh" tramp-multi-connect-rlogin "remsh %h -l %u%n") ("ssh" tramp-multi-connect-rlogin "ssh %h -l %u%n") - ("ssht" tramp-multi-connect-rlogin "ssh %h -e none -t -t -l %u%n") + ("ssht" tramp-multi-connect-rlogin "ssh %h -e none -t -t -l %u%n") ("su" tramp-multi-connect-su "su - %u%n") ("sudo" tramp-multi-connect-su "sudo -u %u -s -p Password:%n")) "*List of connection functions for multi-hop methods. @@ -777,7 +777,7 @@ the info pages.") "sudo" tramp-completion-function-alist-su) (tramp-set-completion-function "multi" nil) - (tramp-set-completion-function + (tramp-set-completion-function "scpx" tramp-completion-function-alist-ssh) (tramp-set-completion-function "sshx" tramp-completion-function-alist-ssh) @@ -1536,9 +1536,9 @@ cat /tmp/tramp.$$ rm -f /tmp/tramp.$$ }" "Shell function to implement `uudecode' to standard output. -Many systems support `uudecode -o /dev/stdout' for this or -`uudecode -o -' or `uudecode -p', but some systems don't, and for -them we have this shell function.") +Many systems support `uudecode -o /dev/stdout' or `uudecode -o -' +for this or `uudecode -p', but some systems don't, and for them +we have this shell function.") ;; Perl script to implement `file-attributes' in a Lisp `read'able ;; output. If you are hacking on this, note that you get *no* output @@ -1960,10 +1960,9 @@ If VAR is nil, then we bind `v' to the structure and `multi-method', (put 'with-parsed-tramp-file-name 'lisp-indent-function 2) ;; To be activated for debugging containing this macro ;; It works only when VAR is nil. Otherwise, it can be deactivated by -;; (def-edebug-spec with-parsed-tramp-file-name 0) +;; (put 'with-parsed-tramp-file-name 'edebug-form-spec 0) ;; I'm too stupid to write a precise SPEC for it. -(if (functionp 'def-edebug-spec) - (def-edebug-spec with-parsed-tramp-file-name t)) +(put 'with-parsed-tramp-file-name 'edebug-form-spec t) (defmacro tramp-let-maybe (variable value &rest body) "Let-bind VARIABLE to VALUE in BODY, but only if VARIABLE is not obsolete. @@ -2056,7 +2055,7 @@ target of the symlink differ." (setq filename (tramp-file-name-localname (tramp-dissect-file-name (expand-file-name filename))))) - + ;; Right, they are on the same host, regardless of user, method, etc. ;; We now make the link on the remote machine. This will occur as the user ;; that FILENAME belongs to. @@ -2065,7 +2064,7 @@ target of the symlink differ." l-multi-method l-method l-user l-host (format "cd %s && %s -sf %s %s" cwd ln - filename + filename l-localname) t))))) @@ -2347,9 +2346,9 @@ target of the symlink differ." "file attributes with perl: %s" (tramp-make-tramp-file-name multi-method method user host localname)) - (tramp-maybe-send-perl-script tramp-perl-file-attributes - "tramp_file_attributes" - multi-method method user host) + (tramp-maybe-send-perl-script multi-method method user host + tramp-perl-file-attributes + "tramp_file_attributes") (tramp-send-command multi-method method user host (format "tramp_file_attributes %s %s" (tramp-shell-quote-argument localname) id-format)) @@ -2394,7 +2393,12 @@ target of the symlink differ." ;; This function makes the same assumption as ;; `tramp-handle-set-visited-file-modtime'. (defun tramp-handle-verify-visited-file-modtime (buf) - "Like `verify-visited-file-modtime' for tramp files." + "Like `verify-visited-file-modtime' for tramp files. +At the time `verify-visited-file-modtime' calls this function, we +already know that the buffer is visiting a file and that +`visited-file-modtime' does not return 0. Do not call this +function directly, unless those two cases are already taken care +of." (with-current-buffer buf ;; There is no file visiting the buffer, or the buffer has no ;; recorded last modification time. @@ -2406,7 +2410,7 @@ target of the symlink differ." (let* ((attr (file-attributes f)) (modtime (nth 5 attr)) (mt (visited-file-modtime))) - + (cond ;; file exists, and has a known modtime. ((and attr (not (equal modtime '(0 0)))) @@ -2689,9 +2693,9 @@ if the remote host can't provide the modtime." (save-excursion (setq directory (tramp-handle-expand-file-name directory)) (with-parsed-tramp-file-name directory nil - (tramp-maybe-send-perl-script tramp-perl-directory-files-and-attributes - "tramp_directory_files_and_attributes" - multi-method method user host) + (tramp-maybe-send-perl-script multi-method method user host + tramp-perl-directory-files-and-attributes + "tramp_directory_files_and_attributes") (tramp-send-command multi-method method user host (format "tramp_directory_files_and_attributes %s %s" (tramp-shell-quote-argument localname) @@ -2753,7 +2757,7 @@ if the remote host can't provide the modtime." (push (buffer-substring (point) (tramp-line-end-position)) result)) - + (tramp-send-command multi-method method user host "cd") (tramp-wait-for-output) @@ -3096,6 +3100,12 @@ be a local filename. The method used must be an out-of-band method." ;; Use an asynchronous process. By this, password can be handled. (save-excursion + + ;; Check for program. + (when (and (fboundp 'executable-find) + (not (executable-find copy-program))) + (error "Cannot find copy program: %s" copy-program)) + (set-buffer trampbuf) (setq tramp-current-multi-method multi-method tramp-current-method method @@ -3170,15 +3180,15 @@ This is like `dired-recursive-delete-directory' for tramp files." 'file-error (list "Removing old file name" "no such directory" filename))) ;; Which is better, -r or -R? (-r works for me <[email protected]>) - (tramp-send-command multi-method method user host + (tramp-send-command multi-method method user host (format "rm -r %s" (tramp-shell-quote-argument localname))) ;; Wait for the remote system to return to us... ;; This might take a while, allow it plenty of time. (tramp-wait-for-output 120) ;; Make sure that it worked... (and (file-exists-p filename) - (error "Failed to recusively delete %s" filename)))) - + (error "Failed to recursively delete %s" filename)))) + (defun tramp-handle-dired-call-process (program discard &rest arguments) "Like `dired-call-process' for tramp files." (with-parsed-tramp-file-name default-directory nil @@ -3200,7 +3210,7 @@ This is like `dired-recursive-delete-directory' for tramp files." (tramp-send-command-and-check multi-method method user host nil) (tramp-send-command multi-method method user host "cd") (tramp-wait-for-output))))) - + (defun tramp-handle-dired-compress-file (file &rest ok-flag) "Like `dired-compress-file' for tramp files." ;; OK-FLAG is valid for XEmacs only, but not implemented. @@ -3568,7 +3578,7 @@ This will break if COMMAND prints a newline, followed by the value of (when (and (numberp buffer) (zerop buffer)) (error "Implementation does not handle immediate return")) (when (consp buffer) (error "Implementation does not handle error files")) - (shell-command + (shell-command (mapconcat 'tramp-shell-quote-argument (cons program args) " ") @@ -4250,7 +4260,7 @@ necessary anymore." ;; `tramp-completion-file-name-regexp-unified' aren't different. ;; If nil, `tramp-completion-run-real-handler' is called (i.e. forwarding to ;; `tramp-file-name-handler'). Otherwise, it takes `tramp-run-real-handler'. -;; Using `last-input-event' is a little bit risky, because completing a file +;; Using `last-input-event' is a little bit risky, because completing a file ;; might require loading other files, like "~/.netrc", and for them it ;; shouldn't be decided based on that variable. On the other hand, those files ;; shouldn't have partial tramp file name syntax. Maybe another variable should @@ -4354,7 +4364,7 @@ necessary anymore." (funcall (nth 0 x) (nth 1 x))))) (tramp-get-completion-function m)) - (setq result (append result + (setq result (append result (mapcar (lambda (x) (tramp-get-completion-user-host @@ -4395,7 +4405,7 @@ necessary anymore." ;; [nil nil "x" nil nil] ;; [nil "x" nil nil nil] -;; "/x:" "/x:y" "/x:y:" +;; "/x:" "/x:y" "/x:y:" ;; [nil nil nil "x" ""] [nil nil nil "x" "y"] [nil "x" nil "y" ""] ;; "/[x/" "/[x/y" ;; [nil "x" nil "" nil] [nil "x" nil "y" nil] @@ -4769,7 +4779,7 @@ User may be nil." ;;; Internal Functions: -(defun tramp-maybe-send-perl-script (script name multi-method method user host) +(defun tramp-maybe-send-perl-script (multi-method method user host script name) "Define in remote shell function NAME implemented as perl SCRIPT. Only send the definition if it has not already been done. Function may have 0-3 parameters." @@ -4864,7 +4874,7 @@ TIME is an Emacs internal time value as returned by `current-time'." "touch" nil (current-buffer) nil "-t" touch-time file)) (pop-to-buffer (current-buffer)) (error "tramp-touch: touch failed")))))) - + (defun tramp-buffer-name (multi-method method user host) "A name for the connection buffer for USER at HOST using METHOD." (if multi-method @@ -5022,7 +5032,7 @@ file exists and nonzero exit status otherwise." (file-exists-p existing) (not (file-exists-p nonexisting)))) (error "Couldn't find command to check if file exists.")))) - + ;; CCC test ksh or bash found for tilde expansion? (defun tramp-find-shell (multi-method method user host) @@ -5121,9 +5131,9 @@ Returns nil if none was found, else the command is returned." (tramp-check-ls-commands multi-method method user host "gnuls" tramp-remote-path) (tramp-check-ls-commands multi-method method user host "gls" tramp-remote-path))) -;; ------------------------------------------------------------ -;; -- Functions for establishing connection -- -;; ------------------------------------------------------------ +;; ------------------------------------------------------------ +;; -- Functions for establishing connection -- +;; ------------------------------------------------------------ ;; The following functions are actions to be taken when seeing certain ;; prompts from the remote host. See the variable @@ -5364,7 +5374,7 @@ Maybe the different regular expressions need to be tuned. (when multi-method (error "Cannot multi-connect using telnet connection method")) (tramp-pre-connection multi-method method user host) - (tramp-message 7 "Opening connection for %s@%s using %s..." + (tramp-message 7 "Opening connection for %s@%s using %s..." (or user (user-login-name)) host method) (let ((process-environment (copy-sequence process-environment))) (setenv "TERM" tramp-terminal-type) @@ -5398,7 +5408,7 @@ Maybe the different regular expressions need to be tuned. p multi-method method user host) (tramp-post-connection multi-method method user host))))) - + (defun tramp-open-connection-rsh (multi-method method user host) "Open a connection using an rsh METHOD. This starts the command `rsh HOST -l USER'[*], then waits for a remote @@ -5423,7 +5433,7 @@ arguments, and xx will be used as the host name to connect to. (error "Cannot multi-connect using rsh connection method")) (tramp-pre-connection multi-method method user host) (if (and user (not (string= user ""))) - (tramp-message 7 "Opening connection for %s@%s using %s..." + (tramp-message 7 "Opening connection for %s@%s using %s..." user host method) (tramp-message 7 "Opening connection at %s using %s..." host method)) (let ((process-environment (copy-sequence process-environment)) @@ -5452,9 +5462,9 @@ arguments, and xx will be used as the host name to connect to. (> emacs-major-version 20)) tramp-dos-coding-system)) (p (if (and user (not (string= user ""))) - (apply #'start-process bufnam buf login-program + (apply #'start-process bufnam buf login-program real-host "-l" user login-args) - (apply #'start-process bufnam buf login-program + (apply #'start-process bufnam buf login-program real-host login-args))) (found nil)) (tramp-set-process-query-on-exit-flag p nil) @@ -5524,10 +5534,10 @@ prompt than you do, so it is not at all unlikely that the variable tramp-actions-before-shell) (tramp-open-connection-setup-interactive-shell p multi-method method user host) - (tramp-post-connection multi-method method + (tramp-post-connection multi-method method user host))))) -;; HHH: Not Changed. Multi method. It is not clear to me how this can +;; HHH: Not Changed. Multi method. It is not clear to me how this can ;; handle not giving a user name in the "file name". ;; ;; This is more difficult than for the single-hop method. In the @@ -5597,7 +5607,7 @@ log in as u2 to h2." (tramp-post-connection multi-method method user host))))) ;; HHH: Changed. Multi method. Don't know how to handle this in the case -;; of no user name provided. Hack to make it work as it did before: +;; of no user name provided. Hack to make it work as it did before: ;; changed `user' to `(or user (user-login-name))' in the places where ;; the value is actually used. (defun tramp-multi-connect-telnet (p method user host command) @@ -5619,8 +5629,8 @@ If USER is nil, uses the return value of (user-login-name) instead." (tramp-process-multi-actions p method user host tramp-multi-actions))) -;; HHH: Changed. Multi method. Don't know how to handle this in the case -;; of no user name provided. Hack to make it work as it did before: +;; HHH: Changed. Multi method. Don't know how to handle this in the case +;; of no user name provided. Hack to make it work as it did before: ;; changed `user' to `(or user (user-login-name))' in the places where ;; the value is actually used. (defun tramp-multi-connect-rlogin (p method user host command) @@ -5645,8 +5655,8 @@ If USER is nil, uses the return value of (user-login-name) instead." (tramp-process-multi-actions p method user host tramp-multi-actions))) -;; HHH: Changed. Multi method. Don't know how to handle this in the case -;; of no user name provided. Hack to make it work as it did before: +;; HHH: Changed. Multi method. Don't know how to handle this in the case +;; of no user name provided. Hack to make it work as it did before: ;; changed `user' to `(or user (user-login-name))' in the places where ;; the value is actually used. (defun tramp-multi-connect-su (p method user host command) @@ -6276,7 +6286,7 @@ Sends COMMAND, then waits 30 seconds for shell prompt." (tramp-barf-if-no-shell-prompt nil 30 "Couldn't `%s', see buffer `%s'" command (buffer-name))) - + (defun tramp-wait-for-output (&optional timeout) "Wait for output from remote rsh command." (let ((proc (get-buffer-process (current-buffer))) @@ -6609,9 +6619,9 @@ Not actually used. Use `(format \"%o\" i)' instead?" "")) -;; ------------------------------------------------------------ -;; -- TRAMP file names -- -;; ------------------------------------------------------------ +;; ------------------------------------------------------------ +;; -- TRAMP file names -- +;; ------------------------------------------------------------ ;; Conversion functions between external representation and ;; internal data structure. Convenience functions for internal ;; data structure. @@ -6622,7 +6632,7 @@ Not actually used. Use `(format \"%o\" i)' instead?" "Return t iff NAME is a tramp file." (save-match-data (string-match tramp-file-name-regexp name))) - + ;; HHH: Changed. Used to assign the return value of (user-login-name) ;; to the `user' part of the structure if a user name was not ;; provided, now it assigns nil. @@ -6675,7 +6685,7 @@ This is MULTI-METHOD, if non-nil. Otherwise, it is METHOD, if non-nil. If both MULTI-METHOD and METHOD are nil, do a lookup in `tramp-default-method-alist'." (or multi-method method (tramp-find-default-method user host))) - + ;; HHH: Not Changed. Multi method. Will probably not handle the case where ;; a user name is not provided in the "file name" very well. (defun tramp-dissect-multi-file-name (name) @@ -6847,7 +6857,7 @@ as default." (if entry (second entry) (symbol-value param)))) - + ;; Auto saving to a special directory. @@ -7039,9 +7049,9 @@ exiting if process is running." process flag))) -;; ------------------------------------------------------------ -;; -- Kludges section -- -;; ------------------------------------------------------------ +;; ------------------------------------------------------------ +;; -- Kludges section -- +;; ------------------------------------------------------------ ;; Currently (as of Emacs 20.5), the function `shell-quote-argument' ;; does not deal well with newline characters. Newline is replaced by @@ -7304,7 +7314,7 @@ report. ;; strange when doing zerop, we should kill the process and start ;; again. (Greg Stark) ;; * Add caching for filename completion. (Greg Stark) -;; Of course, this has issues with usability (stale cache bites) +;; Of course, this has issues with usability (stale cache bites) ;; -- <[email protected]> ;; * Provide a local cache of old versions of remote files for the rsync ;; transfer method to use. (Greg Stark) diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 7456bc1660..866d6e5647 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -30,7 +30,7 @@ ;; are auto-frobbed from configure.ac, so you should edit that file and run ;; "autoconf && ./configure" to change them. -(defconst tramp-version "2.0.45" +(defconst tramp-version "2.0.46" "This version of Tramp.") (defconst tramp-bug-report-address "[email protected]" diff --git a/lisp/pcvs-defs.el b/lisp/pcvs-defs.el index 6bdd6bb6dd..27629c5ddc 100644 --- a/lisp/pcvs-defs.el +++ b/lisp/pcvs-defs.el @@ -380,6 +380,8 @@ This variable is buffer local and only used in the *cvs* buffer.") ("+" . cvs-mode-tree) ;; mouse bindings ([mouse-2] . cvs-mode-find-file) + ([follow-link] . (lambda (pos) + (if (eq (get-char-property pos 'face) 'cvs-filename-face) t))) ([(down-mouse-3)] . cvs-menu) ;; dired-like bindings ("\C-o" . cvs-mode-display-file) diff --git a/lisp/play/zone.el b/lisp/play/zone.el index abe9657a9d..80d0760bed 100644 --- a/lisp/play/zone.el +++ b/lisp/play/zone.el @@ -33,10 +33,11 @@ ;; `zone-programs'. See `zone-call' for higher-ordered zoning. ;; WARNING: Not appropriate for Emacs sessions over modems or -;; computers as slow as mine. +;; computers as slow as mine. -;; THANKS: Christopher Mayer, Scott Flinchbaugh, Rachel Kalmar, -;; Max Froumentin. +;; THANKS: Christopher Mayer, Scott Flinchbaugh, +;; Rachel Kalmar, Max Froumentin, Juri Linkov, +;; Luigi Panzeri, John Paul Wallington. ;;; Code: @@ -75,6 +76,7 @@ If nil, don't interrupt for about 1^26 seconds.") zone-pgm-paragraph-spaz zone-pgm-stress zone-pgm-stress-destress + zone-pgm-random-life ]) (defmacro zone-orig (&rest body) @@ -139,19 +141,28 @@ If the element is a function or a list of a function and a number, (window-start))))) (put 'zone 'orig-buffer (current-buffer)) (put 'zone 'modeline-hidden-level 0) - (set-buffer outbuf) + (switch-to-buffer outbuf) (setq mode-name "Zone") (erase-buffer) + (setq buffer-undo-list t + truncate-lines t + tab-width (zone-orig tab-width) + line-spacing (zone-orig line-spacing)) (insert text) - (switch-to-buffer outbuf) - (setq buffer-undo-list t) (untabify (point-min) (point-max)) (set-window-start (selected-window) (point-min)) (set-window-point (selected-window) wp) (sit-for 0 500) (let ((pgm (elt zone-programs (random (length zone-programs)))) - (ct (and f (frame-parameter f 'cursor-type)))) - (when ct (modify-frame-parameters f '((cursor-type . (bar . 0))))) + (ct (and f (frame-parameter f 'cursor-type))) + (restore (list '(kill-buffer outbuf)))) + (when ct + (modify-frame-parameters f '((cursor-type . (bar . 0)))) + (setq restore (cons '(modify-frame-parameters + f (list (cons 'cursor-type ct))) + restore))) + ;; Make `restore' a self-disabling one-shot thunk. + (setq restore `(lambda () ,@restore (setq restore nil))) (condition-case nil (progn (message "Zoning... (%s)" pgm) @@ -165,14 +176,17 @@ If the element is a function or a list of a function and a number, (zone-call pgm) (message "Zoning...sorry")) (error + (funcall restore) (while (not (input-pending-p)) (message (format "We were zoning when we wrote %s..." pgm)) (sit-for 3) (message "...here's hoping we didn't hose your buffer!") (sit-for 3))) - (quit (ding) (message "Zoning...sorry"))) - (when ct (modify-frame-parameters f (list (cons 'cursor-type ct))))) - (kill-buffer outbuf))) + (quit + (funcall restore) + (ding) + (message "Zoning...sorry"))) + (when restore (funcall restore))))) ;;;; Zone when idle, or not. @@ -194,13 +208,11 @@ If the element is a function or a list of a function and a number, (message "I won't zone out any more")) -;;;; zone-pgm-jitter +;;;; jittering (defun zone-shift-up () (let* ((b (point)) - (e (progn - (end-of-line) - (if (looking-at "\n") (1+ (point)) (point)))) + (e (progn (forward-line 1) (point))) (s (buffer-substring b e))) (delete-region b e) (goto-char (point-max)) @@ -208,48 +220,40 @@ If the element is a function or a list of a function and a number, (defun zone-shift-down () (goto-char (point-max)) - (forward-line -1) - (beginning-of-line) (let* ((b (point)) - (e (progn - (end-of-line) - (if (looking-at "\n") (1+ (point)) (point)))) + (e (progn (forward-line -1) (point))) (s (buffer-substring b e))) (delete-region b e) (goto-char (point-min)) (insert s))) (defun zone-shift-left () - (while (not (eobp)) - (or (eolp) - (let ((c (following-char))) - (delete-char 1) - (end-of-line) - (insert c))) - (forward-line 1))) + (let (s) + (while (not (eobp)) + (unless (eolp) + (setq s (buffer-substring (point) (1+ (point)))) + (delete-char 1) + (end-of-line) + (insert s)) + (forward-char 1)))) (defun zone-shift-right () - (while (not (eobp)) - (end-of-line) - (or (bolp) - (let ((c (preceding-char))) - (delete-backward-char 1) - (beginning-of-line) - (insert c))) - (forward-line 1))) + (goto-char (point-max)) + (end-of-line) + (let (s) + (while (not (bobp)) + (unless (bolp) + (setq s (buffer-substring (1- (point)) (point))) + (delete-char -1) + (beginning-of-line) + (insert s)) + (end-of-line 0)))) (defun zone-pgm-jitter () (let ((ops [ zone-shift-left - zone-shift-left - zone-shift-left - zone-shift-left zone-shift-right zone-shift-down - zone-shift-down - zone-shift-down - zone-shift-down - zone-shift-down zone-shift-up ])) (goto-char (point-min)) @@ -259,7 +263,7 @@ If the element is a function or a list of a function and a number, (sit-for 0 10)))) -;;;; zone-pgm-whack-chars +;;;; whacking chars (defun zone-pgm-whack-chars () (let ((tbl (copy-sequence (get 'zone-pgm-whack-chars 'wc-tbl)))) @@ -279,7 +283,7 @@ If the element is a function or a list of a function and a number, (setq i (1+ i))) tbl)) -;;;; zone-pgm-dissolve +;;;; dissolving (defun zone-remove-text () (let ((working t)) @@ -304,11 +308,11 @@ If the element is a function or a list of a function and a number, (zone-pgm-jitter)) -;;;; zone-pgm-explode +;;;; exploding (defun zone-exploding-remove () (let ((i 0)) - (while (< i 20) + (while (< i 5) (save-excursion (goto-char (point-min)) (while (not (eobp)) @@ -327,7 +331,7 @@ If the element is a function or a list of a function and a number, (zone-pgm-jitter)) -;;;; zone-pgm-putz-with-case +;;;; putzing w/ case ;; Faster than `zone-pgm-putz-with-case', but not as good: all ;; instances of the same letter have the same case, which produces a @@ -376,7 +380,7 @@ If the element is a function or a list of a function and a number, (sit-for 0 2))) -;;;; zone-pgm-rotate +;;;; rotating (defun zone-line-specs () (let (ret) @@ -438,46 +442,84 @@ If the element is a function or a list of a function and a number, (zone-pgm-rotate (lambda () (1- (- (random 3)))))) -;;;; zone-pgm-drip +;;;; dripping -(defun zone-cpos (pos) +(defsubst zone-cpos (pos) (buffer-substring pos (1+ pos))) -(defun zone-fret (pos) +(defsubst zone-replace-char (count del-count char-as-string new-value) + (delete-char (or del-count (- count))) + (aset char-as-string 0 new-value) + (dotimes (i count) (insert char-as-string))) + +(defsubst zone-park/sit-for (pos seconds) + (let ((p (point))) + (goto-char pos) + (prog1 (sit-for seconds) + (goto-char p)))) + +(defun zone-fret (wbeg pos) (let* ((case-fold-search nil) (c-string (zone-cpos pos)) + (cw-ceil (ceiling (char-width (aref c-string 0)))) (hmm (cond ((string-match "[a-z]" c-string) (upcase c-string)) ((string-match "[A-Z]" c-string) (downcase c-string)) - (t " ")))) + (t (propertize " " 'display `(space :width ,cw-ceil)))))) (do ((i 0 (1+ i)) (wait 0.5 (* wait 0.8))) ((= i 20)) (goto-char pos) (delete-char 1) (insert (if (= 0 (% i 2)) hmm c-string)) - (sit-for wait)) + (zone-park/sit-for wbeg wait)) (delete-char -1) (insert c-string))) -(defun zone-fall-through-ws (c col wend) - (let ((fall-p nil) ; todo: move outward - (wait 0.15) - (o (point)) ; for terminals w/o cursor hiding - (p (point))) - (while (progn - (forward-line 1) - (move-to-column col) - (looking-at " ")) - (setq fall-p t) - (delete-char 1) - (insert (if (< (point) wend) c " ")) - (save-excursion - (goto-char p) - (delete-char 1) - (insert " ") - (goto-char o) - (sit-for (setq wait (* wait 0.8)))) - (setq p (1- (point)))) +(defun zone-fill-out-screen (width height) + (let ((start (window-start)) + (line (make-string width 32))) + (goto-char start) + ;; fill out rectangular ws block + (while (progn (end-of-line) + (let ((cc (current-column))) + (if (< cc width) + (insert (substring line cc)) + (delete-char (- width cc))) + (cond ((eobp) (insert "\n") nil) + (t (forward-char 1) t))))) + ;; pad ws past bottom of screen + (let ((nl (- height (count-lines (point-min) (point))))) + (when (> nl 0) + (setq line (concat line "\n")) + (do ((i 0 (1+ i))) + ((= i nl)) + (insert line)))) + (goto-char start) + (recenter 0) + (sit-for 0))) + +(defun zone-fall-through-ws (c wbeg wend) + (let* ((cw-ceil (ceiling (char-width (aref c 0)))) + (spaces (make-string cw-ceil 32)) + (col (current-column)) + (wait 0.15) + newpos fall-p) + (while (when (save-excursion + (next-line 1) + (and (= col (current-column)) + (setq newpos (point)) + (string= spaces (buffer-substring-no-properties + newpos (+ newpos cw-ceil))) + (setq newpos (+ newpos (1- cw-ceil))))) + (setq fall-p t) + (delete-char 1) + (insert spaces) + (goto-char newpos) + (when (< (point) wend) + (delete-char cw-ceil) + (insert c) + (forward-char -1) + (zone-park/sit-for wbeg (setq wait (* wait 0.8)))))) fall-p)) (defun zone-pgm-drip (&optional fret-p pancake-p) @@ -485,59 +527,35 @@ If the element is a function or a list of a function and a number, (wh (window-height)) (mc 0) ; miss count (total (* ww wh)) - (fall-p nil)) - (goto-char (point-min)) - ;; fill out rectangular ws block - (while (not (eobp)) - (end-of-line) - (let ((cc (current-column))) - (if (< cc ww) - (insert (make-string (- ww cc) ? )) - (delete-char (- ww cc)))) - (unless (eobp) - (forward-char 1))) - ;; pad ws past bottom of screen - (let ((nl (- wh (count-lines (point-min) (point))))) - (when (> nl 0) - (let ((line (concat (make-string (1- ww) ? ) "\n"))) - (do ((i 0 (1+ i))) - ((= i nl)) - (insert line))))) + (fall-p nil) + wbeg wend c) + (zone-fill-out-screen ww wh) + (setq wbeg (window-start) + wend (window-end)) (catch 'done (while (not (input-pending-p)) - (goto-char (point-min)) - (sit-for 0) - (let ((wbeg (window-start)) - (wend (window-end))) - (setq mc 0) - ;; select non-ws character, but don't miss too much - (goto-char (+ wbeg (random (- wend wbeg)))) - (while (looking-at "[ \n\f]") - (if (= total (setq mc (1+ mc))) - (throw 'done 'sel) - (goto-char (+ wbeg (random (- wend wbeg)))))) - ;; character animation sequence - (let ((p (point))) - (when fret-p (zone-fret p)) - (goto-char p) - (setq fall-p (zone-fall-through-ws - (zone-cpos p) (current-column) wend)))) + (setq mc 0 wend (window-end)) + ;; select non-ws character, but don't miss too much + (goto-char (+ wbeg (random (- wend wbeg)))) + (while (looking-at "[ \n\f]") + (if (= total (setq mc (1+ mc))) + (throw 'done 'sel) + (goto-char (+ wbeg (random (- wend wbeg)))))) + ;; character animation sequence + (let ((p (point))) + (when fret-p (zone-fret wbeg p)) + (goto-char p) + (setq c (zone-cpos p) + fall-p (zone-fall-through-ws c wbeg wend))) ;; assuming current-column has not changed... (when (and pancake-p fall-p (< (count-lines (point-min) (point)) wh)) - (previous-line 1) - (forward-char 1) - (sit-for 0.137) - (delete-char -1) - (insert "@") - (sit-for 0.137) - (delete-char -1) - (insert "*") - (sit-for 0.137) - (delete-char -1) - (insert "_")))))) + (let ((cw (ceiling (char-width (aref c 0))))) + (zone-replace-char cw 1 c ?@) (zone-park/sit-for wbeg 0.137) + (zone-replace-char cw nil c ?*) (zone-park/sit-for wbeg 0.137) + (zone-replace-char cw nil c ?_))))))) (defun zone-pgm-drip-fretfully () (zone-pgm-drip t)) @@ -549,10 +567,12 @@ If the element is a function or a list of a function and a number, (zone-pgm-drip t t)) -;;;; zone-pgm-paragraph-spaz +;;;; paragraph spazzing (for textish modes) (defun zone-pgm-paragraph-spaz () - (if (memq (zone-orig major-mode) '(text-mode fundamental-mode)) + (if (memq (zone-orig major-mode) + ;; there should be a better way to distinguish textish modes + '(text-mode texinfo-mode fundamental-mode)) (let ((fill-column fill-column) (fc-min fill-column) (fc-max fill-column) @@ -570,7 +590,7 @@ If the element is a function or a list of a function and a number, (zone-pgm-rotate))) -;;;; zone-pgm-stress +;;;; stressing and destressing (defun zone-pgm-stress () (goto-char (point-min)) @@ -596,9 +616,6 @@ If the element is a function or a list of a function and a number, (message (concat (make-string (random (- (frame-width) 5)) ? ) "grrr")) (sit-for 0.1))))) - -;;;; zone-pgm-stress-destress - (defun zone-pgm-stress-destress () (zone-call 'zone-pgm-stress 25) (zone-hiding-modeline @@ -617,6 +634,63 @@ If the element is a function or a list of a function and a number, zone-pgm-drip)))) +;;;; the lyfe so short the craft so long to lerne --chaucer + +(defvar zone-pgm-random-life-wait nil + "*Seconds to wait between successive `life' generations. +If nil, `zone-pgm-random-life' chooses a value from 0-3 (inclusive).") + +(defun zone-pgm-random-life () + (require 'life) + (zone-fill-out-screen (1- (window-width)) (1- (window-height))) + (let ((top (progn (goto-char (window-start)) (forward-line 7) (point))) + (bot (progn (goto-char (window-end)) (forward-line -7) (point))) + (rtc (- (frame-width) 11)) + (min (window-start)) + (max (1- (window-end))) + s c col) + (delete-region max (point-max)) + (while (and (progn (goto-char min) (sit-for 0.05)) + (progn (goto-char (+ min (random max))) + (or (progn (skip-chars-forward " @\n" max) + (not (= max (point)))) + (unless (or (= 0 (skip-chars-backward " @\n" min)) + (= min (point))) + (forward-char -1) + t)))) + (unless (or (eolp) (eobp)) + (setq s (zone-cpos (point)) + c (aref s 0)) + (zone-replace-char + (char-width c) + 1 s (cond ((or (> top (point)) + (< bot (point)) + (or (> 11 (setq col (current-column))) + (< rtc col))) + 32) + ((and (<= ?a c) (>= ?z c)) (+ c (- ?A ?a))) + ((and (<= ?A c) (>= ?Z c)) ?*) + (t ?@))))) + (sit-for 3) + (setq col nil) + (goto-char bot) + (while (< top (point)) + (setq c (point)) + (move-to-column 9) + (setq col (cons (buffer-substring (point) c) col)) + (end-of-line 0) + (forward-char -10)) + (let ((life-patterns (vector + (if (and col (search-forward "@" max t)) + (cons (make-string (length (car col)) 32) col) + (list (mapconcat 'identity + (make-list (/ (- rtc 11) 15) + (make-string 5 ?@)) + (make-string 10 32))))))) + (life (or zone-pgm-random-life-wait (random 4))) + (kill-buffer nil)))) + + ;;;;;;;;;;;;;;; (provide 'zone) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index f2750ec8ff..9c7e8fe156 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1044,6 +1044,7 @@ exited abnormally with code %d\n" (defvar compilation-minor-mode-map (let ((map (make-sparse-keymap))) (define-key map [mouse-2] 'compile-goto-error) + (define-key map [follow-link] 'mouse-face) (define-key map "\C-c\C-c" 'compile-goto-error) (define-key map "\C-m" 'compile-goto-error) (define-key map "\C-c\C-k" 'kill-compilation) @@ -1073,6 +1074,7 @@ exited abnormally with code %d\n" (defvar compilation-button-map (let ((map (make-sparse-keymap))) (define-key map [mouse-2] 'compile-goto-error) + (define-key map [follow-link] 'mouse-face) (define-key map "\C-m" 'compile-goto-error) map) "Keymap for compilation-message buttons.") @@ -1084,6 +1086,7 @@ exited abnormally with code %d\n" ;; because that introduces a menu bar item we don't want. ;; That confuses C-down-mouse-3. (define-key map [mouse-2] 'compile-goto-error) + (define-key map [follow-link] 'mouse-face) (define-key map "\C-c\C-c" 'compile-goto-error) (define-key map "\C-m" 'compile-goto-error) (define-key map "\C-c\C-k" 'kill-compilation) diff --git a/lisp/progmodes/executable.el b/lisp/progmodes/executable.el index a5d401a5f5..0eb5377101 100644 --- a/lisp/progmodes/executable.el +++ b/lisp/progmodes/executable.el @@ -199,20 +199,20 @@ non-executable files." (file-modes buffer-file-name))))))) +;;;###autoload (defun executable-interpret (command) "Run script with user-specified args, and collect output in a buffer. -While script runs asynchronously, you can use the \\[next-error] command -to find the next error." +While script runs asynchronously, you can use the \\[next-error] +command to find the next error. The buffer is also in `comint-mode' and +`compilation-shell-minor-mode', so that you can answer any prompts." (interactive (list (read-string "Run script: " (or executable-command buffer-file-name)))) (require 'compile) (save-some-buffers (not compilation-ask-about-save)) - (make-local-variable 'executable-command) - (compile-internal (setq executable-command command) - "No more errors." "Interpretation" - ;; Give it a simpler regexp to match. - nil executable-error-regexp-alist)) + (set (make-local-variable 'executable-command) command) + (let ((compilation-error-regexp-alist executable-error-regexp-alist)) + (compilation-start command t (lambda (x) "*interpretation*")))) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index fd4b716ae4..04fcae78ea 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -275,6 +275,9 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies (defvar grep-error-face compilation-error-face "Face name to use for grep error messages.") +(defvar grep-match-face 'match + "Face name to use for grep matches.") + (defvar grep-mode-font-lock-keywords '(;; Command output lines. ("^\\([A-Za-z_0-9/\.+-]+\\)[ \t]*:" 1 font-lock-function-name-face) @@ -291,7 +294,7 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies (2 compilation-line-face)) ;; Highlight grep matches and delete markers ("\\(\033\\[01;41m\\)\\(.*?\\)\\(\033\\[00m\\)" - (2 compilation-column-face) + (2 grep-match-face) ((lambda (p)) (progn ;; Delete markers with `replace-match' because it updates diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index eaa6f3be4e..44675470b6 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -841,6 +841,8 @@ IDL has currently stepped.") (defvar idlwave-shell-sources-query) (defvar idlwave-shell-mode-map) (defvar idlwave-shell-calling-stack-index) +(defvar idlwave-shell-only-prompt-pattern nil) +(defvar tool-bar-map) (defun idlwave-shell-mode () "Major mode for interacting with an inferior IDL process. @@ -994,7 +996,7 @@ IDL has currently stepped.") (setq idlwave-shell-hide-output nil) ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility - (make-local-hook 'kill-buffer-hook) + ;;(make-local-hook 'kill-buffer-hook) (add-hook 'kill-buffer-hook 'idlwave-shell-kill-shell-buffer-confirm nil 'local) (add-hook 'kill-buffer-hook 'idlwave-shell-delete-temp-files nil 'local) @@ -1038,7 +1040,7 @@ IDL has currently stepped.") (setq abbrev-mode t) ;; NB: `make-local-hook' needed for older/alternative Emacs compatibility - (make-local-hook 'post-command-hook) + ;;(make-local-hook 'post-command-hook) (add-hook 'post-command-hook 'idlwave-command-hook nil t) ;; Read the command history? @@ -1458,7 +1460,6 @@ Otherwise just move the line. Move down unless UP is non-nil." "Return t if the shell process is running." (eq (process-status idlwave-shell-process-name) 'run)) -(defvar idlwave-shell-only-prompt-pattern nil) (defun idlwave-shell-filter-hidden-output (output) "Filter hidden output, leaving the good stuff. @@ -1475,6 +1476,7 @@ error messages, etc." (defvar idlwave-shell-hidden-output-buffer " *idlwave-shell-hidden-output*" "Buffer containing hidden output from IDL commands.") +(defvar idlwave-shell-current-state nil) (defun idlwave-shell-filter (proc string) "Watch for IDL prompt and filter incoming text. @@ -1627,7 +1629,55 @@ and then calls `idlwave-shell-send-command' for any pending commands." (run-hooks 'idlwave-shell-sentinel-hook)) (run-hooks 'idlwave-shell-sentinel-hook)))) -(defvar idlwave-shell-current-state nil) +(defvar idlwave-shell-error-buffer " *idlwave-shell-errors*" + "Buffer containing syntax errors from IDL compilations.") + +;; FIXME: the following two variables do not currently allow line breaks +;; in module and file names. I am not sure if it will be necessary to +;; change this. Currently it seems to work the way it is. +(defvar idlwave-shell-syntax-error + "^% Syntax error.\\s-*\n\\s-*At:\\s-*\\(.*\\),\\s-*Line\\s-*\\(.*\\)" + "A regular expression to match an IDL syntax error. +The 1st pair matches the file name, the second pair matches the line +number.") + +(defvar idlwave-shell-other-error + "^% .*\n\\s-*At:\\s-*\\(.*\\),\\s-*Line\\s-*\\(.*\\)" + "A regular expression to match any IDL error.") + +(defvar idlwave-shell-halting-error + "^% .*\n\\([^%].*\n\\)*% Execution halted at:\\(\\s-*\\S-+\\s-*[0-9]+\\s-*.*\\)\n" + "A regular expression to match errors which halt execution.") + +(defvar idlwave-shell-cant-continue-error + "^% Can't continue from this point.\n" + "A regular expression to match errors stepping errors.") + +(defvar idlwave-shell-file-line-message + (concat + "\\(" ; program name group (1) + "\\$MAIN\\$\\|" ; main level routine + "\\<[a-zA-Z][a-zA-Z0-9_$:]*" ; start with a letter followed by [..] + "\\([ \t]*\n[ \t]*[a-zA-Z0-9_$:]+\\)*"; continuation lines program name (2) + "\\)" ; end program name group (1) + "[ \t\n]+" ; white space + "\\(" ; line number group (3) + "[0-9]+" ; the line number (the fix point) + "\\([ \t]*\n[ \t]*[0-9]+\\)*" ; continuation lines number (4) + "\\)" ; end line number group (3) + "[ \t\n]+" ; white space + "\\(" ; file name group (5) + "[^ \t\n]+" ; file names can contain any non-white + "\\([ \t]*\n[ \t]*[^ \t\n]+\\)*" ; continuation lines file name (6) + "\\)" ; end line number group (5) + ) + "*A regular expression to parse out the file name and line number. +The 1st group should match the subroutine name. +The 3rd group is the line number. +The 5th group is the file name. +All parts may contain linebreaks surrounded by spaces. This is important +in IDL5 which inserts random linebreaks in long module and file names.") + (defun idlwave-shell-scan-for-state () "Scan for state info. Looks for messages in output from last IDL command indicating where IDL has stopped. The types of messages we are @@ -1721,55 +1771,6 @@ the above." ;; Otherwise, no particular state (t (setq idlwave-shell-current-state nil))))) -(defvar idlwave-shell-error-buffer " *idlwave-shell-errors*" - "Buffer containing syntax errors from IDL compilations.") - -;; FIXME: the following two variables do not currently allow line breaks -;; in module and file names. I am not sure if it will be necessary to -;; change this. Currently it seems to work the way it is. -(defvar idlwave-shell-syntax-error - "^% Syntax error.\\s-*\n\\s-*At:\\s-*\\(.*\\),\\s-*Line\\s-*\\(.*\\)" - "A regular expression to match an IDL syntax error. -The 1st pair matches the file name, the second pair matches the line -number.") - -(defvar idlwave-shell-other-error - "^% .*\n\\s-*At:\\s-*\\(.*\\),\\s-*Line\\s-*\\(.*\\)" - "A regular expression to match any IDL error.") - -(defvar idlwave-shell-halting-error - "^% .*\n\\([^%].*\n\\)*% Execution halted at:\\(\\s-*\\S-+\\s-*[0-9]+\\s-*.*\\)\n" - "A regular expression to match errors which halt execution.") - -(defvar idlwave-shell-cant-continue-error - "^% Can't continue from this point.\n" - "A regular expression to match errors stepping errors.") - -(defvar idlwave-shell-file-line-message - (concat - "\\(" ; program name group (1) - "\\$MAIN\\$\\|" ; main level routine - "\\<[a-zA-Z][a-zA-Z0-9_$:]*" ; start with a letter followed by [..] - "\\([ \t]*\n[ \t]*[a-zA-Z0-9_$:]+\\)*"; continuation lines program name (2) - "\\)" ; end program name group (1) - "[ \t\n]+" ; white space - "\\(" ; line number group (3) - "[0-9]+" ; the line number (the fix point) - "\\([ \t]*\n[ \t]*[0-9]+\\)*" ; continuation lines number (4) - "\\)" ; end line number group (3) - "[ \t\n]+" ; white space - "\\(" ; file name group (5) - "[^ \t\n]+" ; file names can contain any non-white - "\\([ \t]*\n[ \t]*[^ \t\n]+\\)*" ; continuation lines file name (6) - "\\)" ; end line number group (5) - ) - "*A regular expression to parse out the file name and line number. -The 1st group should match the subroutine name. -The 3rd group is the line number. -The 5th group is the file name. -All parts may contain linebreaks surrounded by spaces. This is important -in IDL5 which inserts random linebreaks in long module and file names.") - (defun idlwave-shell-parse-line (string &optional skip-main) "Parse IDL message for the subroutine, file name and line number. We need to work hard here to remove the stupid line breaks inserted by @@ -2102,8 +2103,8 @@ Change the default directory for the process buffer to concur." 'hide 'wait) ;; If we don't know anything about the class, update shell routines (if (and idlwave-shell-get-object-class - (not (assoc-ignore-case idlwave-shell-get-object-class - (idlwave-class-alist)))) + (not (assoc-string idlwave-shell-get-object-class + (idlwave-class-alist) t))) (idlwave-shell-maybe-update-routine-info)) idlwave-shell-get-object-class))) @@ -2165,9 +2166,10 @@ keywords." (idlwave-complete arg))))) ;; Get rid of opaque dynamic variable passing of link? +(defvar link) ;dynamic variable (defun idlwave-shell-complete-execcomm-help (mode word) (let ((word (or (nth 1 idlwave-completion-help-info) word)) - (entry (assoc-ignore-case word idlwave-executive-commands-alist))) + (entry (assoc-string word idlwave-executive-commands-alist t))) (cond ((eq mode 'test) (and (stringp word) entry (cdr entry))) @@ -2217,6 +2219,7 @@ args of an executive .run, .rnew or .compile." (looking-at "\\$"))) ;; Debugging Commands ------------------------------------------------------ +(defvar idlwave-shell-electric-debug-mode) ; defined by easy-mmode (defun idlwave-shell-redisplay (&optional hide) "Tries to resync the display with where execution has stopped. @@ -3517,6 +3520,7 @@ considered the new breakpoint if the file name of frame matches." (defvar idlwave-shell-bp-overlays nil "Alist of overlays marking breakpoints") +(defvar idlwave-shell-bp-glyph) (defun idlwave-shell-update-bp-overlays () "Update the overlays which mark breakpoints in the source code. @@ -3605,7 +3609,6 @@ Existing overlays are recycled, in order to minimize consumption." (set-window-buffer win buf)))))))) -(defvar idlwave-shell-bp-glyph) (defun idlwave-shell-make-new-bp-overlay (&optional type disabled help) "Make a new overlay for highlighting breakpoints. @@ -4026,7 +4029,7 @@ Otherwise, just expand the file name." '(alt)))) (shift (memq 'shift mod)) (mod-noshift (delete 'shift (copy-sequence mod))) - s k1 c2 k2 cmd cannotshift) + s k1 c2 k2 cmd electric only-buffer cannotshift) (while (setq s (pop specs)) (setq k1 (nth 0 s) c2 (nth 1 s) @@ -4089,6 +4092,9 @@ Otherwise, just expand the file name." (setq idlwave-shell-suppress-electric-debug nil)) (idlwave-shell-electric-debug-mode)) +(defvar idlwave-shell-electric-debug-read-only) +(defvar idlwave-shell-electric-debug-buffers nil) + (easy-mmode-define-minor-mode idlwave-shell-electric-debug-mode "Toggle Electric Debug mode. With no argument, this command toggles the mode. @@ -4138,7 +4144,6 @@ idlwave-shell-electric-debug-mode-map) (force-mode-line-update)) ;; Turn it off in all relevant buffers -(defvar idlwave-shell-electric-debug-buffers nil) (defun idlwave-shell-electric-debug-all-off () (setq idlwave-shell-suppress-electric-debug nil) (let ((buffers idlwave-shell-electric-debug-buffers) diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 45694b57b9..a17ba3e844 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -2571,7 +2571,9 @@ If not in a statement just moves to end of line. Returns position." (let ((save-point (point))) (when (re-search-forward ".*&" lim t) (goto-char (match-end 0)) - (if (idlwave-quoted) (goto-char save-point))) + (if (idlwave-quoted) + (goto-char save-point) + (if (eq (char-after (- (point) 2)) ?&) (goto-char save-point)))) (point))) (defun idlwave-skip-label-or-case () diff --git a/lisp/replace.el b/lisp/replace.el index 8a5c0a9680..775ad0ffb0 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -735,16 +735,17 @@ Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. Compatibility function for \\[next-error] invocations." (interactive "p") ;; we need to run occur-find-match from within the Occur buffer - (with-current-buffer + (with-current-buffer (if (next-error-buffer-p (current-buffer)) (current-buffer) (next-error-find-buffer nil nil (lambda() (eq major-mode 'occur-mode)))) - - (when reset - (goto-char (point-min))) + + (goto-char (cond (reset (point-min)) + ((< argp 0) (line-beginning-position)) + ((line-end-position)))) (occur-find-match - (abs (prefix-numeric-value argp)) - (if (> 0 (prefix-numeric-value argp)) + (abs argp) + (if (> 0 argp) #'previous-single-property-change #'next-single-property-change) "No more matches") @@ -752,6 +753,20 @@ Compatibility function for \\[next-error] invocations." (set-window-point (get-buffer-window (current-buffer)) (point)) (occur-mode-goto-occurrence))) +(defface match + '((((class color) (min-colors 88) (background light)) + :background "Tan") + (((class color) (min-colors 88) (background dark)) + :background "RoyalBlue4") + (((class color) (min-colors 8)) + :background "blue" :foreground "white") + (((type tty) (class mono)) + :inverse-video t) + (t :background "gray")) + "Face used to highlight matches permanently." + :group 'matching + :version "21.4") + (defcustom list-matching-lines-default-context-lines 0 "*Default number of context lines included around `list-matching-lines' matches. A negative number means to include that many lines before the match. @@ -761,7 +776,7 @@ A positive number means to include that many lines both before and after." (defalias 'list-matching-lines 'occur) -(defcustom list-matching-lines-face 'bold +(defcustom list-matching-lines-face 'match "*Face used by \\[list-matching-lines] to show the text that matches. If the value is nil, don't highlight the matching portions specially." :type 'face @@ -776,18 +791,22 @@ If the value is nil, don't highlight the buffer names specially." (defun occur-accumulate-lines (count &optional keep-props) (save-excursion (let ((forwardp (> count 0)) - (result nil)) + result beg end) (while (not (or (zerop count) (if forwardp (eobp) (bobp)))) (setq count (+ count (if forwardp -1 1))) + (setq beg (line-beginning-position) + end (line-end-position)) + (if (and keep-props (boundp 'jit-lock-mode) jit-lock-mode + (text-property-not-all beg end 'fontified t)) + (jit-lock-fontify-now beg end)) (push (funcall (if keep-props #'buffer-substring #'buffer-substring-no-properties) - (line-beginning-position) - (line-end-position)) + beg end) result) (forward-line (if forwardp 1 -1))) (nreverse result)))) @@ -982,14 +1001,17 @@ See also `multi-occur'." (when (setq endpt (re-search-forward regexp nil t)) (setq matches (1+ matches)) ;; increment match count (setq matchbeg (match-beginning 0)) - (setq begpt (save-excursion - (goto-char matchbeg) - (line-beginning-position))) (setq lines (+ lines (1- (count-lines origpt endpt)))) + (save-excursion + (goto-char matchbeg) + (setq begpt (line-beginning-position) + endpt (line-end-position))) (setq marker (make-marker)) (set-marker marker matchbeg) - (setq curstring (buffer-substring begpt - (line-end-position))) + (if (and keep-props (boundp 'jit-lock-mode) jit-lock-mode + (text-property-not-all begpt endpt 'fontified t)) + (jit-lock-fontify-now begpt endpt)) + (setq curstring (buffer-substring begpt endpt)) ;; Depropertize the string, and maybe ;; highlight the matches (let ((len (length curstring)) @@ -998,17 +1020,15 @@ See also `multi-occur'." (set-text-properties 0 len nil curstring)) (while (and (< start len) (string-match regexp curstring start)) - (add-text-properties (match-beginning 0) - (match-end 0) - (append - `(occur-match t) - (when match-face - ;; Use `face' rather than - ;; `font-lock-face' here - ;; so as to override faces - ;; copied from the buffer. - `(face ,match-face))) - curstring) + (add-text-properties + (match-beginning 0) (match-end 0) + (append + `(occur-match t) + (when match-face + ;; Use `face' rather than `font-lock-face' here + ;; so as to override faces copied from the buffer. + `(face ,match-face))) + curstring) (setq start (match-end 0)))) ;; Generate the string to insert for this match (let* ((out-line @@ -1019,7 +1039,10 @@ See also `multi-occur'." (when prefix-face `(font-lock-face prefix-face)) '(occur-prefix t))) - curstring + ;; We don't put `mouse-face' on the newline, + ;; because that loses. And don't put it + ;; on context lines to reduce flicker. + (propertize curstring 'mouse-face 'highlight) "\n")) (data (if (= nlines 0) @@ -1043,10 +1066,7 @@ See also `multi-occur'." (insert "-------\n")) (add-text-properties beg end - `(occur-target ,marker help-echo "mouse-2: go to this occurrence")) - ;; We don't put `mouse-face' on the newline, - ;; because that loses. - (add-text-properties beg (1- end) '(mouse-face highlight))))) + `(occur-target ,marker help-echo "mouse-2: go to this occurrence"))))) (goto-char endpt)) (if endpt (progn @@ -1214,7 +1234,7 @@ but coerced to the correct value of INTEGERS." (defun replace-match-maybe-edit (newtext fixedcase literal noedit match-data) "Make a replacement with `replace-match', editing `\\?'. -NEXTEXT, FIXEDCASE, LITERAL are just passed on. If NOEDIT is true, no +NEWTEXT, FIXEDCASE, LITERAL are just passed on. If NOEDIT is true, no check for `\\?' is made to save time. MATCH-DATA is used for the replacement. In case editing is done, it is changed to use markers. @@ -1281,6 +1301,9 @@ make, or the user didn't cancel the call." ;; (match-data); otherwise it is t if a match is possible at point. (match-again t) + (isearch-string isearch-string) + (isearch-regexp isearch-regexp) + (isearch-case-fold-search isearch-case-fold-search) (message (if query-flag (substitute-command-keys @@ -1313,6 +1336,12 @@ make, or the user didn't cancel the call." (if regexp-flag from-string (regexp-quote from-string)) "\\b"))) + (when query-replace-lazy-highlight + (setq isearch-string search-string + isearch-regexp (or delimited-flag regexp-flag) + isearch-case-fold-search case-fold-search + isearch-lazy-highlight-last-string nil)) + (push-mark) (undo-boundary) (unwind-protect @@ -1380,7 +1409,7 @@ make, or the user didn't cancel the call." (if (not query-flag) (let ((inhibit-read-only query-replace-skip-read-only)) - (unless noedit + (unless (or literal noedit) (replace-highlight (nth 0 real-match-data) (nth 1 real-match-data))) (setq noedit @@ -1528,7 +1557,16 @@ make, or the user didn't cancel the call." (setq unread-command-events (append (listify-key-sequence key) unread-command-events)) - (setq done t)))) + (setq done t))) + (when query-replace-lazy-highlight + ;; Restore isearch data for lazy highlighting + ;; in case of isearching during recursive edit + (setq isearch-string search-string + isearch-regexp (or delimited-flag regexp-flag) + isearch-case-fold-search case-fold-search) + ;; Force lazy rehighlighting only after replacements + (if (not (memq def '(skip backup))) + (setq isearch-lazy-highlight-last-string nil)))) ;; Record previous position for ^ when we move on. ;; Change markers to numbers in the match data ;; since lots of markers slow down editing. @@ -1564,26 +1602,44 @@ make, or the user didn't cancel the call." (and keep-going stack))) (defcustom query-replace-highlight t - "*Non-nil means to highlight words during query replacement." + "*Non-nil means to highlight matches during query replacement." :type 'boolean :group 'matching) +(defcustom query-replace-lazy-highlight t + "*Controls the lazy-highlighting during query replacements. +When non-nil, all text in the buffer matching the current match +is highlighted lazily using isearch lazy highlighting (see +`isearch-lazy-highlight-initial-delay' and +`isearch-lazy-highlight-interval')." + :type 'boolean + :group 'matching + :version "21.4") + +(defface query-replace + '((t (:inherit isearch))) + "Face for highlighting query replacement matches." + :group 'matching + :version "21.4") + (defvar replace-overlay nil) +(defun replace-highlight (beg end) + (if query-replace-highlight + (if replace-overlay + (move-overlay replace-overlay beg end (current-buffer)) + (setq replace-overlay (make-overlay beg end)) + (overlay-put replace-overlay 'priority 1) ;higher than lazy overlays + (overlay-put replace-overlay 'face 'query-replace))) + (if query-replace-lazy-highlight + (isearch-lazy-highlight-new-loop))) + (defun replace-dehighlight () - (and replace-overlay - (progn - (delete-overlay replace-overlay) - (setq replace-overlay nil)))) - -(defun replace-highlight (start end) - (and query-replace-highlight - (if replace-overlay - (move-overlay replace-overlay start end (current-buffer)) - (setq replace-overlay (make-overlay start end)) - (overlay-put replace-overlay 'face - (if (facep 'query-replace) - 'query-replace 'region))))) + (when replace-overlay + (delete-overlay replace-overlay)) + (when query-replace-lazy-highlight + (isearch-lazy-highlight-cleanup isearch-lazy-highlight-cleanup) + (setq isearch-lazy-highlight-last-string nil))) ;; arch-tag: 16b4cd61-fd40-497b-b86f-b667c4cf88e4 ;;; replace.el ends here diff --git a/lisp/simple.el b/lisp/simple.el index a0d2306634..7465e33c8e 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -123,33 +123,33 @@ to navigate in it.") (make-variable-buffer-local 'next-error-function) -(defsubst next-error-buffer-p (buffer - &optional - extra-test-inclusive +(defsubst next-error-buffer-p (buffer + &optional + extra-test-inclusive extra-test-exclusive) "Test if BUFFER is a next-error capable buffer. EXTRA-TEST-INCLUSIVE is called to allow extra buffers. -EXTRA-TEST-INCLUSIVE is called to disallow buffers." +EXTRA-TEST-EXCLUSIVE is called to disallow buffers." (with-current-buffer buffer (or (and extra-test-inclusive (funcall extra-test-inclusive)) (and (if extra-test-exclusive (funcall extra-test-exclusive) t) next-error-function)))) -(defun next-error-find-buffer (&optional other-buffer - extra-test-inclusive +(defun next-error-find-buffer (&optional other-buffer + extra-test-inclusive extra-test-exclusive) "Return a next-error capable buffer. OTHER-BUFFER will disallow the current buffer. EXTRA-TEST-INCLUSIVE is called to allow extra buffers. -EXTRA-TEST-INCLUSIVE is called to disallow buffers." +EXTRA-TEST-EXCLUSIVE is called to disallow buffers." (or ;; 1. If one window on the selected frame displays such buffer, return it. (let ((window-buffers (delete-dups (delq nil (mapcar (lambda (w) (if (next-error-buffer-p - (window-buffer w) - extra-test-inclusive extra-test-exclusive) + (window-buffer w) + extra-test-inclusive extra-test-exclusive) (window-buffer w))) (window-list)))))) (if other-buffer @@ -159,29 +159,29 @@ EXTRA-TEST-INCLUSIVE is called to disallow buffers." ;; 2. If next-error-last-buffer is set to a live buffer, use that. (if (and next-error-last-buffer (buffer-name next-error-last-buffer) - (next-error-buffer-p next-error-last-buffer - extra-test-inclusive extra-test-exclusive) + (next-error-buffer-p next-error-last-buffer + extra-test-inclusive extra-test-exclusive) (or (not other-buffer) (not (eq next-error-last-buffer (current-buffer))))) next-error-last-buffer) ;; 3. If the current buffer is a next-error capable buffer, return it. (if (and (not other-buffer) - (next-error-buffer-p (current-buffer) - extra-test-inclusive extra-test-exclusive)) + (next-error-buffer-p (current-buffer) + extra-test-inclusive extra-test-exclusive)) (current-buffer)) ;; 4. Look for a next-error capable buffer in a buffer list. (let ((buffers (buffer-list))) (while (and buffers - (or (not (next-error-buffer-p - (car buffers) - extra-test-inclusive extra-test-exclusive)) + (or (not (next-error-buffer-p + (car buffers) + extra-test-inclusive extra-test-exclusive)) (and other-buffer (eq (car buffers) (current-buffer))))) (setq buffers (cdr buffers))) (if buffers (car buffers) (or (and other-buffer - (next-error-buffer-p (current-buffer) - extra-test-inclusive extra-test-exclusive) + (next-error-buffer-p (current-buffer) + extra-test-inclusive extra-test-exclusive) ;; The current buffer is a next-error capable buffer. (progn (if other-buffer @@ -645,9 +645,6 @@ If BACKWARD-ONLY is non-nil, only delete spaces before point." (skip-chars-forward " \t") (constrain-to-field nil orig-pos t))))) -(defvar inhibit-mark-movement nil - "If non-nil, \\[beginning-of-buffer] and \\[end-of-buffer] does not set the mark.") - (defun beginning-of-buffer (&optional arg) "Move point to the beginning of the buffer; leave mark at previous position. With \\[universal-argument] prefix, do not set mark at previous position. @@ -659,8 +656,9 @@ of the accessible part of the buffer. Don't use this command in Lisp programs! \(goto-char (point-min)) is faster and avoids clobbering the mark." (interactive "P") - (unless (or inhibit-mark-movement (consp arg)) - (push-mark)) + (or (consp arg) + (and transient-mark-mode mark-active) + (push-mark)) (let ((size (- (point-max) (point-min)))) (goto-char (if (and arg (not (consp arg))) (+ (point-min) @@ -683,8 +681,9 @@ of the accessible part of the buffer. Don't use this command in Lisp programs! \(goto-char (point-max)) is faster and avoids clobbering the mark." (interactive "P") - (unless (or inhibit-mark-movement (consp arg)) - (push-mark)) + (or (consp arg) + (and transient-mark-mode mark-active) + (push-mark)) (let ((size (- (point-max) (point-min)))) (goto-char (if (and arg (not (consp arg))) (- (point-max) @@ -1485,6 +1484,17 @@ is not *inside* the region START...END." (t '(0 . 0))) '(0 . 0))) + +;; When the first undo batch in an undo list is longer than undo-outer-limit, +;; this function gets called to ask the user what to do. +;; Garbage collection is inhibited around the call, +;; so it had better not do a lot of consing. +(setq undo-outer-limit-function 'undo-outer-limit-truncate) +(defun undo-outer-limit-truncate (size) + (if (yes-or-no-p (format "Buffer %s undo info is %d bytes long; discard it? " + (buffer-name) size)) + (progn (setq buffer-undo-list nil) t) + nil)) (defvar shell-command-history nil "History list for some commands that read shell commands.") @@ -2991,11 +3001,11 @@ You can also deactivate the mark by typing \\[keyboard-quit] or Many commands change their behavior when Transient Mark mode is in effect and the mark is active, by acting on the region instead of their usual default part of the buffer's text. Examples of such commands include -\\[comment-dwim], \\[flush-lines], \\[ispell], \\[keep-lines], -\\[query-replace], \\[query-replace-regexp], and \\[undo]. Invoke -\\[apropos-documentation] and type \"transient\" or \"mark.*active\" at -the prompt, to see the documentation of commands which are sensitive to -the Transient Mark mode." +\\[comment-dwim], \\[flush-lines], \\[keep-lines], \ +\\[query-replace], \\[query-replace-regexp], \\[ispell], and \\[undo]. +Invoke \\[apropos-documentation] and type \"transient\" or +\"mark.*active\" at the prompt, to see the documentation of +commands which are sensitive to the Transient Mark mode." :global t :group 'editing-basics :require nil) (defun pop-global-mark () @@ -3246,7 +3256,7 @@ Outline mode sets this." (if (if forward ;; If going forward, don't accept the previous ;; allowable position if it is before the target line. - (< line-beg (point)) + (< line-beg (point)) ;; If going backward, don't accept the previous ;; allowable position if it is still after the target line. (<= (point) line-end)) @@ -3527,12 +3537,17 @@ With argument, do this that many times." (interactive "p") (forward-word (- (or arg 1)))) -(defun mark-word (arg) - "Set mark arg words away from point. -If this command is repeated, it marks the next ARG words after the ones -already marked." - (interactive "p") - (cond ((and (eq last-command this-command) (mark t)) +(defun mark-word (&optional arg) + "Set mark ARG words away from point. +The place mark goes is the same place \\[forward-word] would +move to with the same argument. +If this command is repeated or mark is active in Transient Mark mode, +it marks the next ARG words after the ones already marked." + (interactive "P") + (cond ((or (and (eq last-command this-command) (mark t)) + (and transient-mark-mode mark-active)) + (setq arg (if arg (prefix-numeric-value arg) + (if (< (mark) (point)) -1 1))) (set-mark (save-excursion (goto-char (mark)) @@ -3541,7 +3556,7 @@ already marked." (t (push-mark (save-excursion - (forward-word arg) + (forward-word (prefix-numeric-value arg)) (point)) nil t)))) @@ -4025,8 +4040,7 @@ or go back to just one window (by deleting all but the selected window)." (abort-recursive-edit)) (current-prefix-arg nil) - ((and transient-mark-mode - mark-active) + ((and transient-mark-mode mark-active) (deactivate-mark)) ((> (recursion-depth) 0) (exit-recursive-edit)) diff --git a/lisp/subr.el b/lisp/subr.el index 4818d37156..edc303bee8 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1874,6 +1874,19 @@ is allowed once again." ,@body) (quit (setq quit-flag t) nil))) +(defmacro while-no-input (&rest body) + "Execute BODY only as long as there's no pending input. +If input arrives, that ends the execution of BODY, +and `while-no-input' returns nil. If BODY finishes, +`while-no-input' returns whatever value BODY produced." + (declare (debug t) (indent 0)) + (let ((catch-sym (make-symbol "input"))) + `(with-local-quit + (catch ',catch-sym + (let ((throw-on-input ',catch-sym)) + (when (sit-for 0 0 t) + ,@body)))))) + (defmacro combine-after-change-calls (&rest body) "Execute BODY, but don't call the after-change functions till the end. If BODY makes changes in the buffer, they are recorded diff --git a/lisp/term.el b/lisp/term.el index 8c624568ad..14a567a667 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -1402,7 +1402,7 @@ The main purpose is to get rid of the local keymap." :kl=\\EOD:kd=\\EOB:kr=\\EOC:ku=\\EOA:kN=\\E[6~:kP=\\E[5~:@7=\\E[4~:kh=\\E[1~\ :mk=\\E[8m:cb=\\E[1K:op=\\E[39;49m:Co#8:pa#64:AB=\\E[4%%dm:AF=\\E[3%%dm:cr=^M\ :bl=^G:do=^J:le=^H:ta=^I:se=\E[27m:ue=\E24m\ -:kb=^?:kD=^[[3~:sc=\E7:rc=\E8:" +:kb=^?:kD=^[[3~:sc=\E7:rc=\E8:r1=\Ec:" ;;; : -undefine ic ;;; don't define :te=\\E[2J\\E[?47l\\E8:ti=\\E7\\E[?47h\ "termcap capabilities supported") @@ -2893,6 +2893,10 @@ See `term-prompt-regexp'." (term-goto (car term-saved-cursor) (cdr term-saved-cursor))) (setq term-terminal-state 0)) + ((eq char ?c) ;; \Ec - Reset (terminfo: rs1) + ;; This is used by the "clear" program. + (setq term-terminal-state 0) + (term-reset-terminal)) ;; The \E#8 reset sequence for xterm. We ;; probably don't need to handle it, but this ;; is the code to parse it. @@ -3020,13 +3024,29 @@ See `term-prompt-regexp'." (set-marker term-home-marker (point)) (setq term-current-row (1- term-height)))))) +;;; Reset the terminal, delete all the content and set the face to the +;;; default one. +(defun term-reset-terminal () + (erase-buffer) + (setq term-current-row 1) + (setq term-current-column 1) + (setq term-insert-mode nil) + (setq term-current-face nil) + (setq term-ansi-current-underline 0) + (setq term-ansi-current-bold 0) + (setq term-ansi-current-reverse 0) + (setq term-ansi-current-color 0) + (setq term-ansi-current-invisible 0) + (setq term-ansi-face-already-done 1) + (setq term-ansi-current-bg-color 0)) + ;;; New function to deal with ansi colorized output, as you can see you can ;;; have any bold/underline/fg/bg/reverse combination. -mm (defun term-handle-colors-array (parameter) (cond -;;; Bold +;;; Bold (terminfo: bold) ((eq parameter 1) (setq term-ansi-current-bold 1)) diff --git a/lisp/term/mac-win.el b/lisp/term/mac-win.el index 5032135da2..2b5c4d2a99 100644 --- a/lisp/term/mac-win.el +++ b/lisp/term/mac-win.el @@ -199,7 +199,7 @@ Switch to a buffer editing the last file dropped." (let ((encoding-vector (make-vector 256 nil)) (i 0) - (vec ;; mac-centraleuropean (128..255) -> UCS mapping + (vec ;; mac-centraleurroman (128..255) -> UCS mapping [ #x00C4 ;; 128:LATIN CAPITAL LETTER A WITH DIAERESIS #x0100 ;; 129:LATIN CAPITAL LETTER A WITH MACRON #x0101 ;; 130:LATIN SMALL LETTER A WITH MACRON @@ -339,8 +339,8 @@ Switch to a buffer editing the last file dropped." (setq i (1+ i))) (setq translation-table (make-translation-table-from-vector encoding-vector)) -;; (define-translation-table 'mac-centraleuropean-decoder translation-table) - (define-translation-table 'mac-centraleuropean-encoder +;; (define-translation-table 'mac-centraleurroman-decoder translation-table) + (define-translation-table 'mac-centraleurroman-encoder (char-table-extra-slot translation-table 0))) (let @@ -493,8 +493,8 @@ Switch to a buffer editing the last file dropped." (defvar mac-font-encoder-list '(("mac-roman" mac-roman-encoder ccl-encode-mac-roman-font "%s") - ("mac-centraleuropean" mac-centraleuropean-encoder - ccl-encode-mac-centraleuropean-font "%s ce") + ("mac-centraleurroman" mac-centraleurroman-encoder + ccl-encode-mac-centraleurroman-font "%s ce") ("mac-cyrillic" mac-cyrillic-encoder ccl-encode-mac-cyrillic-font "%s cy"))) @@ -515,15 +515,15 @@ Switch to a buffer editing the last file dropped." (if mac-encoded (aset table c mac-encoded)))))))) -(define-ccl-program ccl-encode-mac-centraleuropean-font +(define-ccl-program ccl-encode-mac-centraleurroman-font `(0 (if (r0 != ,(charset-id 'ascii)) (if (r0 <= ?\x8f) - (translate-character mac-centraleuropean-encoder r0 r1) + (translate-character mac-centraleurroman-encoder r0 r1) ((r1 <<= 7) (r1 |= r2) - (translate-character mac-centraleuropean-encoder r0 r1))))) - "CCL program for Mac Central European font") + (translate-character mac-centraleurroman-encoder r0 r1))))) + "CCL program for Mac Central European Roman font") (define-ccl-program ccl-encode-mac-cyrillic-font `(0 diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index f6a1c1d5cc..f3a7616bfd 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1975,7 +1975,7 @@ SPC: Accept word this time. (sit-for 5) (kill-buffer "*Ispell Help*")) (unwind-protect - (progn + (let ((resize-mini-windows 'grow-only)) (select-window (minibuffer-window)) (erase-buffer) (message nil) diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el index 206f7a42f7..353aa0ee8a 100644 --- a/lisp/textmodes/paragraphs.el +++ b/lisp/textmodes/paragraphs.el @@ -357,13 +357,15 @@ the number of paragraphs marked equals ARG. If ARG is negative, point is put at end of this paragraph, mark is put at beginning of this or a previous paragraph. -If this command is repeated, it marks the next ARG paragraphs after (or -before, if arg is negative) the ones already marked." +If this command is repeated or mark is active in Transient Mark mode, +it marks the next ARG paragraphs after (or before, if arg is negative) +the ones already marked." (interactive "p") (unless arg (setq arg 1)) (when (zerop arg) (error "Cannot mark zero paragraphs")) - (cond ((and (eq last-command this-command) (mark t)) + (cond ((or (and (eq last-command this-command) (mark t)) + (and transient-mark-mode mark-active)) (set-mark (save-excursion (goto-char (mark)) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index f6f4c63fdc..bac2ed6f80 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -1351,7 +1351,9 @@ Mark is left at original location." (when (eq (char-after) ?{) (let ((newpos (point))) (when (ignore-errors (backward-sexp 1) t) - (if (looking-at "\\\\end\\>") + (if (or (looking-at "\\\\end\\>") + ;; In case the \\ ends a verbatim section. + (and (looking-at "end\\>") (eq (char-before) ?\\))) (tex-last-unended-begin) (goto-char newpos)))))))) diff --git a/lisp/tooltip.el b/lisp/tooltip.el index 5bcb28dde5..2e60df0245 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -1,6 +1,7 @@ ;;; tooltip.el --- show tooltip windows -;; Copyright (C) 1997, 1999, 2000, 2001, 2004 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1999, 2000, 2001, 2002, 2003, 2004 +;; Free Software Foundation, Inc. ;; Author: Gerd Moellmann <[email protected]> ;; Keywords: help c mouse tools @@ -476,7 +477,25 @@ This function must return nil if it doesn't handle EVENT." (defun tooltip-show-help-function (msg) "Function installed as `show-help-function'. MSG is either a help string to display, or nil to cancel the display." - (let ((previous-help tooltip-help-message)) + (let ((previous-help tooltip-help-message) + mp pos) + (if (and mouse-1-click-follows-link + (stringp msg) + (save-match-data + (string-match "^mouse-2" msg)) + (setq mp (mouse-pixel-position)) + (consp (setq pos (cdr mp))) + (setq pos (posn-at-x-y (car pos) (cdr pos) (car mp))) + (windowp (posn-window pos))) + (with-current-buffer (window-buffer (posn-window pos)) + (if (mouse-on-link-p (posn-point pos)) + (setq msg (concat + (cond + ((eq mouse-1-click-follows-link 'double) "double-") + ((and (integerp mouse-1-click-follows-link) + (< mouse-1-click-follows-link 0)) "Long ") + (t "")) + "mouse-1" (substring msg 7)))))) (setq tooltip-help-message msg) (cond ((null msg) ;; Cancel display. This also cancels a delayed tip, if diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index c9663baff8..9bb5ef1c3e 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,7 @@ +2004-12-11 Stefan Monnier <[email protected]> + + * url-handlers.el: Don't `require' everything eagerly. + 2004-11-30 Paul Pogonyshev <[email protected]> * url-http.el (url-http-handle-cookies): Bind `url-current-object' @@ -18,8 +22,7 @@ 2004-11-12 Masatake YAMATO <[email protected]> - * url-mailto.el (url-mailto): Fix a typo in the - comment. + * url-mailto.el (url-mailto): Fix a typo in the comment. 2004-11-02 Masatake YAMATO <[email protected]> @@ -76,12 +79,12 @@ * url-vars.el (url-passwd-entry-func): Var deleted. (mm-mime-mule-charset-alist): Remove compatibility code for old Gnus. - (url-weekday-alist): Renamed from weekday-alist. - (url-monthabbrev-alist): Renamed from monthabbrev-alist. + (url-weekday-alist): Rename from weekday-alist. + (url-monthabbrev-alist): Rename from monthabbrev-alist. (url-vars-unload-hook): Initialize hook var to hold the function. - * url-util.el (url-get-normalized-date): Use - url-weekday-alist and url-monthabbrev-alist. + * url-util.el (url-get-normalized-date): Use url-weekday-alist and + url-monthabbrev-alist. * url-misc.el: Load cl at compile time. @@ -99,8 +102,8 @@ * url-news.el (url-snews): Use nntp-open-tls-stream if url-gateway-method is tls. - * url-ldap.el (url-ldap-certificate-formatter): Use - tls-certificate-information if ssl.el is not available. + * url-ldap.el (url-ldap-certificate-formatter): + Use tls-certificate-information if ssl.el is not available. * url-https.el (url-https-create-secure-wrapper): Use tls if ssl is not available. diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index db961b9c27..f90f21a3db 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -25,11 +25,21 @@ ;;; Code: -(require 'url) -(require 'url-parse) -(require 'url-util) -(require 'mm-decode) -(require 'mailcap) +;; (require 'url) +(eval-when-compile (require 'url-parse)) +;; (require 'url-util) +(eval-when-compile (require 'mm-decode)) +;; (require 'mailcap) +;; The following functions in the byte compiler's warnings are known not +;; to cause any real problem for the following reasons: +;; - mm-save-part-to-file, mm-destroy-parts: always used +;; after mm-dissect-buffer and defined in the same file. +;; The following are autoloaded instead of `require'd to avoid eagerly +;; loading all of URL when turning on url-handler-mode in the .emacs. +(autoload 'url-retrieve-synchronously "url" "Retrieve url synchronously.") +(autoload 'url-expand-file-name "url-expand" "Convert url to a fully specified url, and canonicalize it.") +(autoload 'mm-dissect-buffer "mm-decode" "Dissect the current buffer and return a list of MIME handles.") +(autoload 'url-scheme-get-property "url-methods" "Get property of a URL SCHEME.") (eval-when-compile (require 'cl)) diff --git a/lisp/vc-svn.el b/lisp/vc-svn.el index fafb5eff7c..cbb951d60b 100644 --- a/lisp/vc-svn.el +++ b/lisp/vc-svn.el @@ -447,10 +447,14 @@ and that it passes `vc-svn-global-switches' to it before FLAGS." (vc-insert-file (expand-file-name ".svn/entries" dirname))) (goto-char (point-min)) (when (re-search-forward - (concat "name=\"svn:this_dir\"[\n\t ]*" - "\\([-a-z]+=\"[^\"]*\"[\n\t ]*\\)*?" + ;; Old `svn' used name="svn:dir", newer use just name="". + (concat "name=\"\\(?:svn:this_dir\\)?\"[\n\t ]*" + "\\(?:[-a-z]+=\"[^\"]*\"[\n\t ]*\\)*?" "url=\"\\([^\"]+\\)\"") nil t) - (match-string 2)))) + ;; This is not a hostname but a URL. This may actually be considered + ;; as a feature since it allows vc-svn-stay-local to specify different + ;; behavior for different modules on the same server. + (match-string 1)))) (defun vc-svn-parse-status (localp) "Parse output of \"svn status\" command in the current buffer. @@ -505,6 +509,30 @@ essential information." (and (string-match "^[0-9]" tag) (not (string-match "[^0-9]" tag)))) +;; Support for `svn annotate' + +(defun vc-svn-annotate-command (file buf &optional rev) + (vc-svn-command buf 0 file "annotate" (if rev (concat "-r" rev)))) + +(defun vc-svn-annotate-time-of-rev (rev) + ;; Arbitrarily assume 10 commmits per day. + (/ (string-to-number rev) 10.0)) + +(defun vc-svn-annotate-current-time () + (vc-svn-annotate-time-of-rev vc-annotate-parent-rev)) + +(defconst vc-svn-annotate-re "[ \t]*\\([0-9]+\\)[ \t]+[^\t ]+ ") + +(defun vc-svn-annotate-time () + (when (looking-at vc-svn-annotate-re) + (goto-char (match-end 0)) + (vc-svn-annotate-time-of-rev (match-string 1)))) + +(defun vc-svn-annotate-extract-revision-at-line () + (save-excursion + (beginning-of-line) + (if (looking-at vc-svn-annotate-re) (match-string 1)))) + (provide 'vc-svn) ;; arch-tag: 02f10c68-2b4d-453a-90fc-1eee6cfb268d diff --git a/lisp/vc.el b/lisp/vc.el index 63e9be651d..64de035192 100644 --- a/lisp/vc.el +++ b/lisp/vc.el @@ -2836,7 +2836,7 @@ Uses `rcs2log' which only works for RCS and CVS." (pop-to-buffer (set-buffer (get-buffer-create "*vc*"))) (erase-buffer) - (insert-file tempfile) + (insert-file-contents tempfile) "failed")) (setq default-directory (file-name-directory changelog)) (delete-file tempfile))))) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 4888bf478d..c782e4262b 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -327,6 +327,7 @@ new value.") (let ((keymap (widget-get widget :keymap)) (face (or (widget-get widget :value-face) 'widget-field-face)) (help-echo (widget-get widget :help-echo)) + (follow-link (widget-get widget :follow-link)) (rear-sticky (or (not widget-field-add-space) (widget-get widget :size)))) (if (functionp help-echo) @@ -345,6 +346,7 @@ new value.") ;; works in the field when, say, Custom uses `suppress-keymap'. (overlay-put overlay 'local-map keymap) (overlay-put overlay 'face face) + (overlay-put overlay 'follow-link follow-link) (overlay-put overlay 'help-echo help-echo)) (setq to (1- to)) (setq rear-sticky t)) @@ -354,6 +356,7 @@ new value.") (overlay-put overlay 'field widget) (overlay-put overlay 'local-map keymap) (overlay-put overlay 'face face) + (overlay-put overlay 'follow-link follow-link) (overlay-put overlay 'help-echo help-echo))) (widget-specify-secret widget)) @@ -378,6 +381,7 @@ new value.") (defun widget-specify-button (widget from to) "Specify button for WIDGET between FROM and TO." (let ((overlay (make-overlay from to nil t nil)) + (follow-link (widget-get widget :follow-link)) (help-echo (widget-get widget :help-echo))) (widget-put widget :button-overlay overlay) (if (functionp help-echo) @@ -389,6 +393,7 @@ new value.") (unless (widget-get widget :suppress-face) (overlay-put overlay 'face (widget-apply widget :button-face-get))) (overlay-put overlay 'pointer 'hand) + (overlay-put overlay 'follow-link follow-link) (overlay-put overlay 'help-echo help-echo))) (defun widget-mouse-help (window overlay point) @@ -1705,6 +1710,7 @@ If END is omitted, it defaults to the length of LIST." "An embedded link." :button-prefix 'widget-link-prefix :button-suffix 'widget-link-suffix + :follow-link "\C-m" :help-echo "Follow the link." :format "%[%t%]") diff --git a/lisp/xml.el b/lisp/xml.el index aba84d3323..daf5689c18 100644 --- a/lisp/xml.el +++ b/lisp/xml.el @@ -179,6 +179,8 @@ If PARSE-NS is non-nil, then QNAMES are expanded." xml))) +(defvar xml-name-re) +(defvar xml-entity-value-re) (let* ((start-chars (concat "[:alpha:]:_")) (name-chars (concat "-[:digit:]." start-chars)) ;;[3] S ::= (#x20 | #x9 | #xD | #xA)+ |