diff options
Diffstat (limited to 'lisp')
84 files changed, 4396 insertions, 2203 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 30aee0030b..187f2ff3fa 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,707 @@ +2006-08-27 Michael Olson <[email protected]> + + * emacs-lisp/tq.el: Small grammar fix in comments. + (tq-enqueue): Check for existence of queue rather than the + head queue item's question, which was a no-op. + (tq-filter, tq-process-buffer): Make sure the process buffer + exists before making it the current buffer. + +2006-08-27 YAMAMOTO Mitsuharu <[email protected]> + + * term/mac-win.el (mac-apple-event-map): Rename hicommand to hi-command. + (mac-dnd-drop-data): Apply 2006-08-22 change for x-dnd-drop-data. + (special-event-map): Apply 2006-08-16 change for x-win.el. + +2006-08-26 Stefan Monnier <[email protected]> + + * progmodes/python.el (python-send-receive): Wait in the + process's buffer so as to check the right buffer-local variables. + +2006-08-25 Stefan Monnier <[email protected]> + + * emacs-lisp/checkdoc.el: Remove * in defcustoms. + (defgroup checkdoc): Move to beginning. + + * progmodes/python.el (python-preoutput-skip-next-prompt): New var. + (python-preoutput-continuation): Remove. + (python-preoutput-filter): Simplify correspondingly. + Remove handling of _emacs_ok. Make sure we skip _emacs_out's prompts. + Loop around to catch embedded _emacs_out output. + (run-python): Send the import&print command on a single line. + (python-send-command): Send command&print on a single line. + (python-send-string): Only add double \n if needed. + (python-send-receive): Loop until the result comes. + (python-mode-running): Defvar it. + (python-setup-brm): Remove unused var `menu'. + Only bind py-mode-map and `features' around brm-init. + (python-calculate-indentation): Remove unused var `point'. + (python-beginning-of-defun): Remove unused var `def-line'. + +2006-08-25 Richard Stallman <[email protected]> + + * kmacro.el (kmacro-repeat-on-last-key): Doc fix. + +2006-08-25 Michael Kifer <[email protected]> + + * viper.el (viper-set-hooks): Use frame bindings for + viper-vi-state-cursor-color. + (viper-non-hook-settings): Don't set default + mode-line-buffer-identification. + + * viper-util.el (viper-set-cursor-color-according-to-state): New fun. + (viper-set-cursor-color-according-to-state) + (viper-get-saved-cursor-color-in-replace-mode) + (viper-get-saved-cursor-color-in-insert-mode): Make conditional on + viper-emacs-state-cursor-color. + + * viper-cmd.el (viper-envelop-ESC-key): Bug fix. + (viper-undo): Use point if undo-beg-posn is nil. + (viper-insert-state-post-command-sentinel, viper-change-state-to-emacs) + (viper-after-change-undo-hook): Don't use + viper-emacs-state-cursor-color by default. + (viper-undo): More sensible positioning after undo. + + * viper-ex.el (ex-splice-args-in-1-letr-cmd): Get rid of caddr. + (viper-emacs-state-cursor-color): Default to nil, since this feature + doesn't work well yet. + + * ediff-mult.el (ediff-intersect-directories) + (ediff-get-directory-files-under-revision, ediff-dir-diff-copy-file): + always expand filenames. + +2006-08-24 Stefan Monnier <[email protected]> + + * tumme.el: Remove * in defcustoms's docstrings. + +2006-08-24 Chong Yidong <[email protected]> + + * emacs-lisp/timer.el (timer-set-idle-time, run-with-idle-timer): + Accept internal time format for SECS arg. + (timer-relative-time): Doc fix. + + * jit-lock.el: "Stealth fontification by requeuing timers" patch, + adapted from Martin Rudalics. + (jit-lock-stealth-repeat-timer, jit-lock-stealth-buffers): New vars. + (jit-lock-mode): Create jit-lock-stealth-repeat-timer. + (jit-lock-stealth-fontify): Reschedule as a idle timer instead of + using sit-for. + +2006-08-24 Francesc Rocher <[email protected]> + + * cus-start.el (all): Add `overline-margin' and + `x-underline-at-descent-line'. + +2006-08-24 Kim F. Storm <[email protected]> + + * progmodes/grep.el (grep-find-use-xargs): Use explicit value `exec' + to mean "use find -exec"; nil now unambiguously means auto-detect. + (grep-compute-defaults): Set grep-find-use-xargs to `exec' if not `gnu'. + Use shell-quote-argument to build grep-find-command and grep-find-template. + (rgrep): Use shell-quote-argument to properly quote arguments to find. + Reported by Tom Seddon. + +2006-08-23 Chong Yidong <[email protected]> + + * startup.el (fancy-splash-head): Give instructions for dismissing + the splash screen for default startup too. + (display-startup-echo-area-message, fancy-splash-screens) + (use-fancy-splash-screens-p): New arg hide-on-input. If nil, show + all splash text at once and keep the splash buffer around. + (command-line-1): Give display-startup-echo-area-message a t arg. + +2006-08-23 Carsten Dominik <[email protected]> + + * textmodes/org.el (org-follow-gnus-link): Make sure the dedicated + gnus frame is selected. + +2006-08-23 Nick Roberts <[email protected]> + + * progmodes/gdb-ui.el (gdb-starting): Reset gdb-signalled to nil. + +2006-08-22 Kim F. Storm <[email protected]> + + * ido.el (ido-set-matches-1): Fix full matching for subdirs. + Add suffix matching for subdirs. + +2006-08-22 Jorgen Schaefer <[email protected]> (tiny change) + + * x-dnd.el (x-dnd-drop-data): Don't call goto-char if + mouse-yank-at-point is non-nil. + +2006-08-22 Nick Roberts <[email protected]> + + * progmodes/gdb-ui.el (gdb-frame-memory-buffer): Make frame + a bit wider and remove fringes to fit initial output on line. + +2006-08-21 Stefan Monnier <[email protected]> + + * frame.el (blink-cursor-end): Only ignore the error we care about. + (blink-cursor-mode): Use blink-cursor-end to simplify the code. + +2006-08-21 Richard Stallman <[email protected]> + + * whitespace.el (whitespace-cleanup): Doc fix. + +2006-08-20 Ryan Yeske <[email protected]> + + * net/rcirc.el (rcirc-show-maximum-output): New var. + (rcirc-buffer-process): If no buffer argument is supplied, use + current-buffer. + (rcirc-complete-nick): Complete to the last completed nick first. + (rcirc-mode): Preserve the value of `rcirc-urls' across + connections. Setup scroll function. + (rcirc-scroll-to-bottom): New function. + (rcirc-print): Use nick syntax around regexp work. + Notice dim-nicks speaking only if they say our nick. + (rcirc-update-activity-string): Do not show the modeline indicator + if there are no live rcirc processes. + (rcirc-cmd-ignore): Ignore case. + (rcirc-browse-url-at-point): Fix off-by-one error. + +2006-08-20 Stefan Monnier <[email protected]> + + * progmodes/python.el: Remove * in defcustom docstrings. + (run-python, python-proc, python-try-complete): Use derived-mode-p. + (python-mode): Set tab-width and indent-tabs-mode. + +2006-08-20 Dave Love <[email protected]> + + * progmodes/python.el: Update to Dave Love's latest version. + (python-font-lock-keywords, python-mode): Don't use + font-lock-syntax-table, but match symbol elements explicitly instead. + (python-mode-map): Add help, and a few more key bindings. + (python-skip-comments/blanks): Move out of comments as well. + (python-continuation-line-p): Behave better with unbalanced parens. + (python-blank-line-p): New fun. + (python-open-block-statement-p): Don't use a heuristic. + (python-outdent-p): Better handle blocks-in-the-same-line. + (python-calculate-indentation): Misc improvements. + (python-comment-indent): Remove. + (python-block-pairs): New var. + (python-first-word): New fun. + (python-indentation-levels): Handle more common cases. + (python-indent-line-1): Add `leave' argument. + (python-indent-region): New fun. + (python-skip-out): New fun. + (python-beginning-of-statement, python-end-of-statement): Use it. + (python-next-statement): Return correct count even at eob. + (python-end-of-block): Fix paren-typo. + (python-imenu-create-index): Add module variables. + (run-python): Add `new' arg. + Check we're at a prompt before returning. + (python-send-command): Move to end of buffer. + Wait for prompt to return. + (python-set-proc): New fun. + (python-imports): New var. + (python-describe-symbol): Use it. Adjust to new interface of `ehelp'. + (python-eldoc-function): Try to move out of arg list. + (python-outline-level): Offset by 1. + (python-find-imports): New fun. + (python-symbol-completions): Use python-imports. + (python-module-path, ffap-alist): Add support for ffap. + (python-skeletons, python-mode-abbrev-table, def-python-skeleton) + (pythin-insert-*, python-default-template, python-expand-template): + Add templates/skeletons. + (python-setup-brm): Support for Bicycle Repair Man. + (python-abbrev-syntax-table): New var. + (python-abbrev-pc-hook, python-pea-hook): New funs. + +2006-08-20 Chong Yidong <[email protected]> + + * frame.el (blink-cursor-start): Set timer first. + (blink-cursor-end): Ignore timer cancelling errors. + Suggested by Ken Manheimer. + +2006-08-20 Juanma Barranquero <[email protected]> + + * newcomment.el (comment-box): Call `comment-normalize-vars'. + Add autoload cookie. + +2006-08-20 Richard Stallman <[email protected]> + + * simple.el (line-number-at-pos): Doc fix. + + * emacs-lisp/timer.el (run-with-idle-timer): Pass t to + timer-activate-when-idle, so timer can run before Emacs becomes + non-idle again. + +2006-08-18 Yoni Rabkin Katzenell <[email protected]> (tiny change) + + * whitespace.el (whitespace-cleanup-internal): New optional arg + REGION-ONLY. If it's non-nil, modify the message to the user + accordingly. + (whitespace-cleanup-region): Call whitespace-cleanup-internal with + a non-nil argument. + +2006-08-18 Gustav H,Ae(Bllberg <[email protected]> (tiny change) + + * rect.el (spaces-string): Simplify and add doc string. + +2006-08-17 Romain Francoise <[email protected]> + + * progmodes/gdb-ui.el (gdb-edit-locals-value): Balance parens. + +2006-08-17 Richard Stallman <[email protected]> + + * compare-w.el (compare-windows): lambda's take an arg and pass + it to compare-windows-skip-whitespace. + +2006-08-17 Martin Rudalics <[email protected]> + + * jit-lock.el (jit-lock-fontify-now): Protect the modified status of + the right buffer. + +2006-08-17 Stefan Monnier <[email protected]> + + * pcvs-parse.el (cvs-parse-table): Accept the new `...' format for + removed files. + +2006-08-17 Nick Roberts <[email protected]> + + * progmodes/gdb-ui.el (gdb-locals-watch-map) + (gdb-locals-watch-map-1): Suppress keymap first. + (gdb-edit-locals-map-1): New variable. + (gdb-edit-locals-value): New function. + (gdb-stack-list-locals-handler): Use them. + +2006-08-16 Stefan Monnier <[email protected]> + + * mouse.el (global-map): Allow yanking with mouse-2 at a spot whose + cursor would normally be drawn in the fringe. + + * font-lock.el (font-lock-extend-region-wholelines): Fix up typo. + Reported by Martin Rudalics <[email protected]>. + +2006-08-16 Richard Stallman <[email protected]> + + * term/x-win.el (x-clipboard-yank): Specify * in interactive spec. + (special-event-map): Process drag-n-drop events this way. + + * simple.el (move-beginning-of-line): Test whether fields + would prevent motion back to line's first visible character. + If so, stop where the fields would stop the motion. + + * newcomment.el (comment-indent): Fully update INDENT + before checking to see if it will change the text. + + * cus-edit.el (custom-newline): New function. + (custom-mode-map): Bind newline to custom-newline. + + * compare-w.el (compare-windows): Factor compare-ignore-whitespace + into ignore-whitespace. + Check each buffer for its skip-function. + Handle compare-windows-skip-whitespace special-case test + by returning t from default skip function. + +2006-08-15 Carsten Dominik <[email protected]> + + * textmodes/org.el (org-clock-special-range) + (org-clock-update-time-maybe): New functions. + (org-stamp-time-of-day-regexp): Allow weekday to be of word chars, + not only a-z. + (org-agenda-get-blocks): Allow multiple blocks per headline. + (org-timestamp-change): Call `org-clock-update-time-maybe'. + (org-export-html-title-format) + (org-export-html-toplevel-hlevel): New options. + (org-export-language-setup): Add support for Czech. + (org-mode, org-insert-todo-heading, org-find-visible) + (org-find-invisible, org-invisible-p, org-invisible-p2) + (org-back-to-heading, org-on-heading-p, org-up-heading-all) + (org-show-subtree, org-show-entry, org-make-options-regexp): + Remove compatibility support for old outline-mode. + (org-check-occur-regexp): Funtion removed. + (org-on-heading-p, org-back-to-heading): Made defalias. + (org-set-local): New defsubst. + (org-set-regexps-and-options, org-mode) + (org-set-font-lock-defaults, org-edit-agenda-file-list) + (org-timeline, org-agenda-list, org-todo-list, org-tags-view) + (org-remember-apply-template, org-table-edit-field) + (org-table-edit-formulas, orgtbl-mode, org-export-as-ascii) + (org-set-autofill-regexps): Use `org-set-local'. + (org-table-eval-formula): Fix bug with parsing of display flags. + +2006-08-15 Nick Roberts <[email protected]> + + * progmodes/gdb-ui.el (gdb-info-stack-custom): Indicate selected + frame with fringe arrow. Suggested by Simon Marshall + <[email protected]>. + (gdb-stack-position): New variable. + (gdb-starting, gdb-exited): Reset gdb-stack-position to nil. + (gdb-frames-mode): Set gdb-stack-position to nil. + Add to overlay-arrow-variable-list + (gdb-reset): Delete gdb-stack-position from above list. + +2006-08-14 Jan Dj,Ad(Brv <[email protected]> + + * term/x-win.el (menu-bar-edit-menu): Disable paste if buffer is + read only. + +2006-08-13 Romain Francoise <[email protected]> + + * cus-theme.el (customize-create-theme) + (custom-theme-visit-theme): End `y-or-n-p' prompt with a space. + + * filesets.el (filesets-add-buffer): Ditto. + + * pcvs.el (cvs-change-cvsroot): Ditto. + +2006-08-13 Nick Roberts <[email protected]> + + * progmodes/gdb-ui.el (gdb-frame-separate-io-buffer) + (gdb-use-separate-io-buffer, menu): Avoid using `inferior' in text. + (gdb-memory-mode, gdb-locals-watch-map): Don't quote lambda + expressions. + (gdb-info-breakpoints-custom): Use gdb-breakpoint-regexp. + Only search till end of line. + Add face to function names in case of no filename. + Add face to variable names of watchpoints. + +2006-08-12 Robert Thorpe <[email protected]> (tiny change) + + * cus-start.el <indent-tabs-mode>: Move to the `indent' + customization group. + +2006-08-12 Ken Manheimer <[email protected]> + + * allout.el (allout-prior-bindings, allout-added-bindings): + Remove, after long deprecation. + (allout-beginning-of-line-cycles, allout-end-of-line-cycles): + Add customization vars controlling allout-beginning-of-line and + allout-end-of-line conveniences. + (allout-header-prefix, allout-use-mode-specific-leader) + (allout-use-mode-specific-leader, allout-mode-leaders): + Revise docstrings. + (allout-infer-header-lead): Change to be an alias for + allout-infer-header-lead-and-primary-bullet. + (allout-infer-header-lead-and-primary-bullet): New version of + allout-infer-header-lead which assigns the primary bullet to the + same as the header lead, when its being changed. + (allout-infer-body-reindent): Apply regexp-quote instead of + unconditionally prepending "\\", so that all literal + allout-header-prefix and allout-primary-bullet strings are + properly handled. + (allout-add-resumptions): Add optional qualifier for extending or + appending to existing values, rather than replacing them. + (allout-view-change-hook): Clarify docstring. + (allout-exposure-change-hook): Take explicit arguments, via + run-hook-with-args. + (allout-structure-added-hook) + (allout-structure-deleted-hook) + (allout-structure-shifted-hook): New hooks analogous to + allout-exposure-change-hook for other kinds of structural outline + edits. + (allout-encryption-plaintext-sanitization-regexps): New encryption + customization variable, by which cooperating modes can provde + massage of the plaintext without actually being passed it. + (allout-encryption-ciphertext-rejection-regexps) + (allout-encryption-ciphertext-rejection-ceiling): New encryption + customization variables, by which cooperating modes can prohibit + rare but possible ciphertext patterns from fouling their + operation, with actually being passed the ciphertext. + (allout-mode): Run activation and deactivation hooks after the + minor-mode variable has been toggled, to clarify the mode + disposition. The new encryption ciphertext rejection variable is + used to ensure that the ciphertext does not contain text that + would be recognized as outline structural elements by allout. + Substite allout-beginning-of-line and allout-end-of-line for + conventionall beginning-of-line and end-of-line bindings. + If allout-old-style-prefixes is non-nil, don't nullify it on mode + activation! + (allout-beginning-of-line): Respect `allout-beginning-of-line-cycles'. + (allout-end-of-line): Respect `allout-end-of-line-cycles'. + (allout-chart-subtree): Implement new mode, charting only the + visible items in the subtree, when new 'visible' parameter is non-nil. + (allout-end-of-subtree): Properly handle the last item in the buffer. + (allout-pre-command-business, allout-command-counter): + Increment an advertised counter so that cooperating enhancements can + track revisions of items. + (allout-open-topic): Run allout-structure-added-hook with suitable + arguments. + (allout-shift-in): Run allout-structure-shifted-hook with suitable + arguments. + (allout-shift-out): Fix doubling for negative args and ensure call + of allout-structure-shifted-hook by solely using allout-shift-in. + (allout-kill-line, allout-kill-topic): + Run allout-structure-deleted-hook with suitable arguments. + (allout-yank-processing): Run allout-structure-added-hook with + proper arguments. + (allout-yank): Enclose activity in allout-unprotected. + (allout-flag-region): Run allout-exposure-change-hook with + suitable arguments, instead of making the callee infer the arguments. + (allout-encrypt-string): + Support allout-encryption-plaintext-sanitization-regexps, + allout-encryption-ciphertext-rejection-regexps, and + allout-encryption-ciphertext-rejection-ceiling. Indicate correct + en/de cryption mode in symmetric encryption failure message. + (allout-obtain-passphrase): Use copy-sequence to get a distinct + copy of the passphrase, and don't zero it or we'll corrupt the + stashed copy. + (allout-create-encryption-passphrase-verifier) + (allout-verify-passphrase): Respect the new signature for + allout-encrypt-string. + (allout-get-configvar-values): Convenience for getting a + configuration variable value and handling its absence gracefully. + +2006-08-11 Romain Francoise <[email protected]> + + * obsolete/zone-mode.el: Delete. + +2006-08-11 Stefan Monnier <[email protected]> + + * textmodes/dns-mode.el (dns-mode): Use before-save-hook. + +2006-08-11 Thien-Thi Nguyen <[email protected]> + + * emacs-lisp/bindat.el (bindat-ip-to-string): + Use `format-network-address' if possible. + +2006-08-11 Jan Dj,Ad(Brv <[email protected]> + + * x-dnd.el (x-dnd-init-frame): Call x-register-dnd-atom. + +2006-08-10 Chong Yidong <[email protected]> + + * emacs-lisp/edebug.el (edebug-recursive-edit): Don't save and + restore unread-command-events here. + (edebug-display): Do it here, to detect sit-for interruptions. + +2006-08-10 Romain Francoise <[email protected]> + + * textmodes/dns-mode.el: Alias `zone-mode' to `dns-mode'. + (dns-mode-soa-auto-increment-serial): New user option. + (dns-mode-soa-maybe-increment-serial): New function. + (dns-mode): Add the latter to `write-contents-functions'. + + * obsolete/zone-mode.el: Move to obsolete/ from net/. + Delete autoload cookies. + +2006-08-10 John Wiegley <[email protected]> + + * eshell/em-glob.el (eshell-glob-chars-list) + (eshell-glob-translate-alist): Add support for [^g] in character globs. + +2006-08-10 Richard Stallman <[email protected]> + + * facemenu.el (facemenu-add-face): Pass frame to facemenu-active-faces. + (facemenu-set-face): Doc fix. + (facemenu-listed-faces): Doc fix. + +2006-08-09 Chong Yidong <[email protected]> + + * avoid.el (mouse-avoidance-animating-pointer): New var. + (mouse-avoidance-nudge-mouse): Use it. + (mouse-avoidance-banish): Rename from mouse-avoidance-banish-hook. + (mouse-avoidance-exile): Rename from mouse-avoidance-exile-hook + (mouse-avoidance-fancy): Rename from mouse-avoidance-fancy-hook. + Don't activate if currently animating. All callers changed. + +2006-08-09 John Wiegley <[email protected]> + + * calendar/timeclock.el (timeclock-use-elapsed): Added a new + variable, which causes timeclock to report elapsed time worked, + instead of just work remaining. + +2006-08-09 Kenichi Handa <[email protected]> + + * international/latexenc.el (latexenc-find-file-coding-system): + Fix for the case that the 2nd element of arg-list is a cons. + +2006-08-08 Chong Yidong <[email protected]> + + * info.el (Info-fontify-node): Handle preceding `in' for note + reference hiding rules. + +2006-08-08 Stefan Monnier <[email protected]> + + * progmodes/sh-script.el (sh-quoted-subshell): Make sure we don't + mistake a closing " for an opening one. + +2006-08-07 Dan Nicolaescu <[email protected]> + + * term/xterm.el (terminal-init-xterm): Add more key bindings. + +2006-08-07 Stefan Monnier <[email protected]> + + * complete.el (PC-do-completion): Filter out completions matching + completion-ignored-extensions before checking whether there are + multiple completions. + Don't use `list' unnecessarily when building completion tables. + +2006-08-06 Richard Stallman <[email protected]> + + * help.el (describe-mode): Make minor mode list more concise. + +2006-08-05 Chong Yidong <[email protected]> + + * bindings.el: Give mode-line-format, mode-line-modes, and + mode-line-position `standard-value' properties. + +2006-08-05 Eli Zaretskii <[email protected]> + + * buff-menu.el (list-buffers-noselect): For Info buffers, use + "(file)node" instead of the file name. + +2006-08-05 Richard Stallman <[email protected]> + + * faces.el (escape-glyph): Doc fix. + +2006-08-04 Kenichi Handa <[email protected]> + + * international/mule-diag.el (describe-font): Improve docstring + and error message. Use frame-parameter (not frame-parameters). + +2006-08-03 Stefan Monnier <[email protected]> + + * progmodes/gud.el (gdb-script-font-lock-syntactic-keywords): + Correctly mark the end-of-docstring char. + +2006-08-03 Chong Yidong <[email protected]> + + * simple.el (line-move-to-column): Constrain move-to-column to + current field. + +2006-08-03 Stefan Monnier <[email protected]> + + * font-lock.el (font-lock-beg, font-lock-end) + (font-lock-extend-region-functions): New vars. + (font-lock-extend-region-multiline) + (font-lock-extend-region-wholelines): New functions. + (font-lock-default-fontify-region): Use them. + (font-lock-extend-jit-lock-region-after-change): Only round up + if font-lock-default-fontify-region will do it as well. + + * font-lock.el (font-lock-extend-after-change-region-function): + Rename from font-lock-extend-region-function. + (font-lock-extend-region): Remove by inlining at call sites. + (font-lock-after-change-function): Don't needlessly round up to a whole + number of lines. + (font-lock-extend-jit-lock-region-after-change): Be more careful about + the boundary conditions and the interactions between the various ways + to extend the region. + +2006-08-02 Stefan Monnier <[email protected]> + + * jit-lock.el (jit-lock-fontify-now): Preserve the buffer's + modification status when forcing the second redisplay. + +2006-08-03 Kim F. Storm <[email protected]> + + * edmacro.el (edmacro-fix-menu-commands): Ignore switch-frame. + +2006-08-02 Stefan Monnier <[email protected]> + + * pcvs-util.el (cvs-get-buffer-create): Obey `noreuse' even if `name' + doesn't look like a file name. + + * complete.el (PC-expand-many-files): Avoid signalling an error when + the current directory doesn't exist. Reported by Micha,Ak(Bl Cadilhac. + +2006-08-02 Andreas Schwab <[email protected]> + + * bindings.el (mode-line-format): Simplify reference to vc-mode. + +2006-08-02 Nick Roberts <[email protected]> + + * bindings.el (map): Make mode-line-buffer-identification-keymap + before defining propertized-buffer-identification. + +2006-08-01 Richard Stallman <[email protected]> + + * bindings.el (mode-line-format): Adjust spacing around vc-mode. + +2006-08-02 Nick Roberts <[email protected]> + + * progmodes/gdb-ui.el (gdb-find-source-frame): Make nil the + default value. + (gdb-find-source-frame): New function. + (menu): Add to menu bar. + +2006-08-01 Stefan Monnier <[email protected]> + + * font-core.el (font-lock-extend-region-function) + (font-lock-extend-region): Move to font-lock.el. + + * font-lock.el (font-lock-extend-region-function) + (font-lock-extend-region): Move from font-core.el. Simplify. + + * jit-lock.el (jit-lock-fontify-now): Cause a second redisplay + if needed. + (jit-lock-start, jit-lock-end): New dynamic scoped vars. + (jit-lock-after-change-extend-region-functions): New hook. + (jit-lock-after-change): Use it instead of hard-coding font-lock code. + + * font-lock.el (font-lock-extend-jit-lock-region-after-change): New fun. + (font-lock-turn-on-thing-lock): Use it. + + * longlines.el (longlines-show-region): Make it work on read-only + buffers as well. + +2006-08-01 Nick Roberts <[email protected]> + + * progmodes/gdb-ui.el (gdb-set-hollow): Check for gud-last-last-frame. + +2006-07-31 Richard Stallman <[email protected]> + + * progmodes/vhdl-mode.el (vhdl-speedbar-display-directory) + (vhdl-speedbar-display-projects): Update old obsolete + speedbar variable names. + +2006-07-31 Nick Roberts <[email protected]> + + * progmodes/gdb-ui.el (gdb-find-source-frame): New option. + (gdb-stopped): Use it. + + * t-mouse.el (t-mouse-mode): Use set-process-query-on-exit-flag. + +2006-07-29 Chong Yidong <[email protected]> + + * loadhist.el (unload-feature): Handle new `(t . SYMBOL)' format + for load-history elements. + +2006-07-29 Eli Zaretskii <[email protected]> + + * files.el (convert-standard-filename): For Cygwin, replace + characters not allowed in Windows file names. + (make-auto-save-file-name): Add Cygwin to the list of systems + where the auto-save file name needs to be run through + convert-standard-filename. + +2006-07-29 Lennart Borgman <[email protected]> + + * window.el (bw-get-tree): Don't integerp subtree if it's nil. + +2006-07-28 Richard Stallman <[email protected]> + + * bindings.el (mode-line-frame-identification) + (propertized-buffer-identification): Centralize the code + to initialize the variable. + + * progmodes/grep.el (grep-default-command): Catch errors from + wildcard-to-regexp. + +2006-07-29 Kim F. Storm <[email protected]> + + * progmodes/grep.el (grep-tag-default): New function. + (grep-default-command, grep-read-regexp): Use it. + (grep-read-files): Use car of grep-files-history or grep-files-aliases + as default if nothing else applies. + +2006-07-28 Bill Atkins <[email protected]> (tiny change) + + * wdired.el (wdired-change-to-wdired-mode, wdired-change-to-dired-mode): + Throw error if buffer is not in Dired and Wdired mode, respectively. + +2006-07-28 Chong Yidong <[email protected]> + + * cus-edit.el (custom-no-edit): Revert 2006-07-27 change, so that + self-insert-command keys don't activate buttons. + (custom-mode-map): Just don't bind "\C-m" to `custom-no-edit'. + +2006-07-29 Nick Roberts <[email protected]> + + * progmodes/gdb-ui.el (gdb-info-breakpoints-custom): Use different + faces for enable character. + 2006-07-28 Nick Roberts <[email protected]> * Makefile.in (recompile): Update comment to reflect change @@ -31,9 +735,9 @@ 2006-07-26 Mathias Dahl <[email protected]> - * tumme.el (tumme-backward-image): Add prefix argument. Add error + * tumme.el (tumme-backward-image): Add prefix argument. Add error when at first image. - (tumme-forward-image): Add prefix argument. Add error when at last + (tumme-forward-image): Add prefix argument. Add error when at last image. 2006-07-25 Stefan Monnier <[email protected]> @@ -45,10 +749,10 @@ * tumme.el (tumme-track-original-file): Add `buffer-live-p' check. (tumme-format-properties-string): Handle empty `buf'. - (tumme-get-comment): Change variable names inside `let'. Add - missing `let' variable that cause font-lock problems. - (tumme-write-comments): Change variable names inside `let'. Add - missing `let' variable that cause font-lock problems. + (tumme-get-comment): Change variable names inside `let'. + Add missing `let' variable that cause font-lock problems. + (tumme-write-comments): Change variable names inside `let'. + Add missing `let' variable that cause font-lock problems. (tumme-forward-image): Rename from `tumme-forward-char'. (tumme-backward-image): Rename from `tumme-backward-char'. @@ -97,8 +801,8 @@ 2006-07-24 Daiki Ueno <[email protected]> * pgg-def.el (pgg-truncate-key-identifier): Truncate the key ID to 8 - letters from the end. Thanks to "David Smith" <[email protected]> and - [email protected] (Andreas V,Av(Bgele) + letters from the end. Thanks to "David Smith" <[email protected]> + and [email protected] (Andreas V,Av(Bgele). 2006-07-23 Thien-Thi Nguyen <[email protected]> @@ -137,7 +841,7 @@ 2006-07-21 Dan Nicolaescu <[email protected]> * term/xterm.el (terminal-init-xterm): Fix key bindings - syntax. Bind S-return, C-M-., C-TAB, S-TAB and C-S-TAB. + syntax. Bind S-return, C-M-., C-TAB, S-TAB and C-S-TAB. 2006-07-21 Eli Zaretskii <[email protected]> @@ -173,7 +877,7 @@ * calc.el (calc-previous-alg-entry): Remove variable. - * calc-aent.el (calc-alg-entry-history, calc-quick-calc-history): + * calc-aent.el (calc-alg-entry-history, calc-quick-calc-history): New variables. (calc-alg-entry): Use `calc-alg-entry-history'. (calc-do-quick-calc): Use `calc-quick-calc-history'. @@ -497,8 +1201,8 @@ 2006-07-10 Chong Yidong <[email protected]> - * progmodes/cc-awk.el (defconst): Use eval-and-compile to avoid - compilation error. + * progmodes/cc-awk.el (c-awk-escaped-nls*): Use eval-and-compile to + avoid compilation error. * subr.el (sit-for): New function. diff --git a/lisp/allout.el b/lisp/allout.el index f1f262c70b..379f664d09 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -213,15 +213,73 @@ just the header." (put 'allout-show-bodies 'safe-local-variable (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil))))) +;;;_ = allout-beginning-of-line-cycles +(defcustom allout-beginning-of-line-cycles t + "*If non-nil, \\[allout-beginning-of-line] will cycle through smart-placement options. + +Cycling only happens on when the command is repeated, not when it +follows a different command. + +Smart-placement means that repeated calls to this function will +advance as follows: + + - if the cursor is on a non-headline body line and not on the first column: + then it goes to the first column + - if the cursor is on the first column of a non-headline body line: + then it goes to the start of the headline within the item body + - if the cursor is on the headline and not the start of the headline: + then it goes to the start of the headline + - if the cursor is on the start of the headline: + then it goes to the bullet character \(for hotspot navigation\) + - if the cursor is on the bullet character: + then it goes to the first column of that line \(the headline\) + - if the cursor is on the first column of the headline: + then it goes to the start of the headline within the item body. + +In this fashion, you can use the beginning-of-line command to do +its normal job and then, when repeated, advance through the +entry, cycling back to start. + +If this configuration variable is nil, then the cursor is just +advanced to the beginning of the line and remains there on +repeated calls." + :type 'boolean :group 'allout) +;;;_ = allout-end-of-line-cycles +(defcustom allout-end-of-line-cycles t + "*If non-nil, \\[allout-end-of-line] will cycle through smart-placement options. + +Cycling only happens on when the command is repeated, not when it +follows a different command. + +Smart-placement means that repeated calls to this function will +advance as follows: + + - if the cursor is not on the end-of-line, + then it goes to the end-of-line + - if the cursor is on the end-of-line but not the end-of-entry, + then it goes to the end-of-entry, exposing it if necessary + - if the cursor is on the end-of-entry, + then it goes to the end of the head line + +In this fashion, you can use the end-of-line command to do its +normal job and then, when repeated, advance through the entry, +cycling back to start. + +If this configuration variable is nil, then the cursor is just +advanced to the end of the line and remains there on repeated +calls." + :type 'boolean :group 'allout) + ;;;_ = allout-header-prefix (defcustom allout-header-prefix "." +;; this string is treated as literal match. it will be `regexp-quote'd, so +;; one cannot use regular expressions to match varying header prefixes. "*Leading string which helps distinguish topic headers. Outline topic header lines are identified by a leading topic header prefix, which mostly have the value of this var at their front. -\(Level 1 topics are exceptions. They consist of only a single -character, which is typically set to the `allout-primary-bullet'. Many -outlines start at level 2 to avoid this discrepancy." +Level 1 topics are exceptions. They consist of only a single +character, which is typically set to the `allout-primary-bullet'." :type 'string :group 'allout) (make-variable-buffer-local 'allout-header-prefix) @@ -300,11 +358,13 @@ strings." (defcustom allout-use-mode-specific-leader t "*When non-nil, use mode-specific topic-header prefixes. -Allout outline mode will use the mode-specific `allout-mode-leaders' -and/or comment-start string, if any, to lead the topic prefix string, -so topic headers look like comments in the programming language. +Allout outline mode will use the mode-specific `allout-mode-leaders' or +comment-start string, if any, to lead the topic prefix string, so topic +headers look like comments in the programming language. It will also use +the comment-start string, with an '_' appended, for `allout-primary-bullet'. -String values are used as they stand. +String values are used as literals, not regular expressions, so +do not escape any regulare-expression characters. Value t means to first check for assoc value in `allout-mode-leaders' alist, then use comment-start string, if any, then use default \(`.'). @@ -313,15 +373,17 @@ alist, then use comment-start string, if any, then use default \(`.'). Set to the symbol for either of `allout-mode-leaders' or `comment-start' to use only one of them, respectively. -Value nil means to always use the default \(`.'). - -comment-start strings that do not end in spaces are tripled, and an -`_' underscore is tacked on the end, to distinguish them from regular -comment strings. comment-start strings that do end in spaces are not -tripled, but an underscore is substituted for the space. [This -presumes that the space is for appearance, not comment syntax. You -can use `allout-mode-leaders' to override this behavior, when -incorrect.]" +Value nil means to always use the default \(`.') and leave +`allout-primary-bullet' unaltered. + +comment-start strings that do not end in spaces are tripled in +the header-prefix, and an `_' underscore is tacked on the end, to +distinguish them from regular comment strings. comment-start +strings that do end in spaces are not tripled, but an underscore +is substituted for the space. [This presumes that the space is +for appearance, not comment syntax. You can use +`allout-mode-leaders' to override this behavior, when +undesired.]" :type '(choice (const t) (const nil) string (const allout-mode-leaders) (const comment-start)) @@ -334,13 +396,14 @@ incorrect.]" (defvar allout-mode-leaders '() "Specific allout-prefix leading strings per major modes. -Entries will be used instead or in lieu of mode-specific -comment-start strings. See also `allout-use-mode-specific-leader'. +Use this if the mode's comment-start string isn't what you +prefer, or if the mode lacks a comment-start string. See +`allout-use-mode-specific-leader' for more details. If you're constructing a string that will comment-out outline structuring so it can be included in program code, append an extra character, like an \"_\" underscore, to distinguish the lead string -from regular comments that start at bol.") +from regular comments that start at the beginning-of-line.") ;;;_ = allout-old-style-prefixes (defcustom allout-old-style-prefixes nil @@ -828,9 +891,9 @@ language comments. Returns the leading string." (setq allout-reindent-bodies nil) (allout-reset-header-lead header-lead) header-lead) -;;;_ > allout-infer-header-lead () -(defun allout-infer-header-lead () - "Determine appropriate `allout-header-prefix'. +;;;_ > allout-infer-header-lead-and-primary-bullet () +(defun allout-infer-header-lead-and-primary-bullet () + "Determine appropriate `allout-header-prefix' and `allout-primary-bullet'. Works according to settings of: @@ -874,10 +937,14 @@ invoking it directly." "_"))))))) (if (not leader) nil - (if (string= leader allout-header-prefix) - nil ; no change, nothing to do. - (setq allout-header-prefix leader) - allout-header-prefix)))) + (setq allout-header-prefix leader) + (if (not allout-old-style-prefixes) + ;; setting allout-primary-bullet makes the top level topics use - + ;; actually, be - the special prefix: + (setq allout-primary-bullet leader)) + allout-header-prefix))) +(defalias 'allout-infer-header-lead + 'allout-infer-header-lead-and-primary-bullet) ;;;_ > allout-infer-body-reindent () (defun allout-infer-body-reindent () "Determine proper setting for `allout-reindent-bodies'. @@ -930,13 +997,13 @@ Works with respect to `allout-plain-bullets-string' and (setq allout-plain-bullets-string-len (length allout-plain-bullets-string)) (setq allout-header-subtraction (1- (length allout-header-prefix))) ;; Produce the new allout-regexp: - (setq allout-regexp (concat "\\(\\" - allout-header-prefix - "[ \t]*[" - allout-bullets-string - "]\\)\\|\\" - allout-primary-bullet - "+\\|\^l")) + (setq allout-regexp (concat "\\(" + (regexp-quote allout-header-prefix) + "[ \t]*[" + allout-bullets-string + "]\\)\\|" + (regexp-quote allout-primary-bullet) + "+\\|\^l")) (setq allout-line-boundary-regexp (concat "\\(\n\\)\\(" allout-regexp "\\)")) (setq allout-bob-regexp @@ -965,16 +1032,6 @@ See doc string for allout-keybindings-list for format of binding list." (car (cdr cell))))))) keymap-list) map)) -;;;_ = allout-prior-bindings - being deprecated. -(defvar allout-prior-bindings nil - "Variable for use in V18, with allout-added-bindings, for -resurrecting, on mode deactivation, bindings that existed before -activation. Being deprecated.") -;;;_ = allout-added-bindings - being deprecated -(defvar allout-added-bindings nil - "Variable for use in V18, with allout-prior-bindings, for -resurrecting, on mode deactivation, bindings that existed before -activation. Being deprecated.") ;;;_ : Menu bar (defvar allout-mode-exposure-menu) (defvar allout-mode-editing-menu) @@ -1050,43 +1107,65 @@ See `allout-add-resumptions' and `allout-do-resumptions'.") (make-variable-buffer-local 'allout-mode-prior-settings) ;;;_ > allout-add-resumptions (&rest pairs) (defun allout-add-resumptions (&rest pairs) - "Set name/value pairs. + "Set name/value PAIRS. Old settings are preserved for later resumption using `allout-do-resumptions'. +The new values are set as a buffer local. On resumption, the prior buffer +scope of the variable is restored along with its value. If it was a void +buffer-local value, then it is left as nil on resumption. + The pairs are lists whose car is the name of the variable and car of the -cdr is the new value: '(some-var some-value)'. +cdr is the new value: '(some-var some-value)'. The pairs can actually be +triples, where the third element qualifies the disposition of the setting, +as described further below. -The new value is set as a buffer local. +If the optional third element is the symbol 'extend, then the new value +created by `cons'ing the second element of the pair onto the front of the +existing value. -If the variable was not previously buffer-local, then that is noted and the -`allout-do-resumptions' will just `kill-local-variable' of that binding. +If the optional third element is the symbol 'append, then the new value is +extended from the existing one by `append'ing a list containing the second +element of the pair onto the end of the existing value. -If it previously was buffer-local, the old value is noted and resurrected -by `allout-do-resumptions'. \(If the local value was previously void, then -it is left as nil on resumption.\) +Extension, and resumptions in general, should not be used for hook +functions - use the 'local mode of `add-hook' for that, instead. The settings are stored on `allout-mode-prior-settings'." (while pairs (let* ((pair (pop pairs)) (name (car pair)) - (value (cadr pair))) + (value (cadr pair)) + (qualifier (if (> (length pair) 2) + (caddr pair))) + prior-value) (if (not (symbolp name)) (error "Pair's name, %S, must be a symbol, not %s" name (type-of name))) + (setq prior-value (condition-case err + (symbol-value name) + (void-variable nil))) (when (not (assoc name allout-mode-prior-settings)) ;; Not already added as a resumption, create the prior setting entry. (if (local-variable-p name) ;; is already local variable - preserve the prior value: - (push (list name (condition-case err - (symbol-value name) - (void-variable nil))) - allout-mode-prior-settings) + (push (list name prior-value) allout-mode-prior-settings) ;; wasn't local variable, indicate so for resumption by killing ;; local value, and make it local: (push (list name) allout-mode-prior-settings) (make-local-variable name))) - (set name value)))) + (if qualifier + (cond ((eq qualifier 'extend) + (if (not (listp prior-value)) + (error "extension of non-list prior value attempted") + (set name (cons value prior-value)))) + ((eq qualifier 'append) + (if (not (listp prior-value)) + (error "appending of non-list prior value attempted") + (set name (append prior-value (list value))))) + (t (error "unrecognized setting qualifier `%s' encountered" + qualifier))) + (set name value))))) ;;;_ > allout-do-resumptions () (defun allout-do-resumptions () "Resume all name/value settings registered by `allout-add-resumptions'. @@ -1121,18 +1200,67 @@ their settings before allout-mode was started." "Symbol for use as allout invisible-text overlay category.") ;;;_ x allout-view-change-hook (defvar allout-view-change-hook nil - "*\(Deprecated\) Hook that's run after allout outline exposure changes. + "*\(Deprecated\) A hook run after allout outline exposure changes. -Switch to using `allout-exposure-change-hook' instead. Both -variables are currently respected, but this one will be ignored -in a subsequent allout version.") +Switch to using `allout-exposure-change-hook' instead. Both hooks are +currently respected, but the other conveys the details of the exposure +change via explicit parameters, and this one will eventually be disabled in +a subsequent allout version.") ;;;_ = allout-exposure-change-hook (defvar allout-exposure-change-hook nil - "*Hook that's run after allout outline exposure changes. + "*Hook that's run after allout outline subtree exposure changes. + +It is run at the conclusion of `allout-flag-region'. + +Functions on the hook must take three arguments: + + - from - integer indicating the point at the start of the change. + - to - integer indicating the point of the end of the change. + - flag - change mode: nil for exposure, otherwise concealment. + +This hook might be invoked multiple times by a single command. + +This hook is replacing `allout-view-change-hook', which is being deprecated +and eventually will not be invoked.") +;;;_ = allout-structure-added-hook +(defvar allout-structure-added-hook nil + "*Hook that's run after addition of items to the outline. + +Functions on the hook should take two arguments: + + - new-start - integer indicating the point at the start of the first new item. + - new-end - integer indicating the point of the end of the last new item. + +Some edits that introduce new items may missed by this hook - +specifically edits that native allout routines do not control. + +This hook might be invoked multiple times by a single command.") +;;;_ = allout-structure-deleted-hook +(defvar allout-structure-deleted-hook nil + "*Hook that's run after disciplined deletion of subtrees from the outline. + +Functions on the hook must take two arguments: + + - depth - integer indicating the depth of the subtree that was deleted. + - removed-from - integer indicating the point where the subtree was removed. + +Some edits that remove or invalidate items may missed by this hook - +specifically edits that native allout routines do not control. -This variable will replace `allout-view-change-hook' in a subsequent allout -version, though both are currently respected.") +This hook might be invoked multiple times by a single command.") +;;;_ = allout-structure-shifted-hook +(defvar allout-structure-shifted-hook nil + "*Hook that's run after shifting of items in the outline. +Functions on the hook should take two arguments: + + - depth-change - integer indicating depth increase, negative for decrease + - start - integer indicating the start point of the shifted parent item. + +Some edits that shift items can be missed by this hook - specifically edits +that native allout routines do not control. + +This hook might be invoked multiple times by a single command.") ;;;_ = allout-outside-normal-auto-fill-function (defvar allout-outside-normal-auto-fill-function nil "Value of normal-auto-fill-function outside of allout mode. @@ -1186,6 +1314,42 @@ state, if file variable adjustments are enabled. See This is used to decrypt the topic that was currently being edited, if it was encrypted automatically as part of a file write or autosave.") (make-variable-buffer-local 'allout-after-save-decrypt) +;;;_ = allout-encryption-plaintext-sanitization-regexps +(defvar allout-encryption-plaintext-sanitization-regexps nil + "List of regexps whose matches are removed from plaintext before encryption. + +This is for the sake of removing artifacts, like escapes, that are added on +and not actually part of the original plaintext. The removal is done just +prior to encryption. + +Entries must be symbols that are bound to the desired values. + +Each value can be a regexp or a list with a regexp followed by a +substitution string. If it's just a regexp, all its matches are removed +before the text is encrypted. If it's a regexp and a substitution, the +substition is used against the regexp matches, a la `replace-match'.") +(make-variable-buffer-local 'allout-encryption-text-removal-regexps) +;;;_ = allout-encryption-ciphertext-rejection-regexps +(defvar allout-encryption-ciphertext-rejection-regexps nil + "Variable for regexps matching plaintext to remove before encryption. + +This is for the sake of redoing encryption in cases where the ciphertext +incidentally contains strings that would disrupt mode operation - +for example, a line that happens to look like an allout-mode topic prefix. + +Entries must be symbols that are bound to the desired regexp values. + +The encryption will be retried up to +`allout-encryption-ciphertext-rejection-limit' times, after which an error +is raised.") + +(make-variable-buffer-local 'allout-encryption-ciphertext-rejection-regexps) +;;;_ = allout-encryption-ciphertext-rejection-ceiling +(defvar allout-encryption-ciphertext-rejection-ceiling 5 + "Limit on number of times encryption ciphertext is rejected. + +See `allout-encryption-ciphertext-rejection-regexps' for rejection reasons.") +(make-variable-buffer-local 'allout-encryption-ciphertext-rejection-ceiling) ;;;_ > allout-mode-p () ;; Must define this macro above any uses, or byte compilation will lack ;; proper def, if file isn't loaded - eg, during emacs build! @@ -1637,16 +1801,15 @@ OPEN: A topic that is not closed, though its offspring or body may be." (remove-overlays (point-min) (point-max) 'category 'allout-exposure-category) - (run-hooks 'allout-mode-deactivate-hook) - (setq allout-mode nil)) + (setq allout-mode nil) + (run-hooks 'allout-mode-deactivate-hook)) ;; Activation: ((not active) (setq allout-explicitly-deactivated nil) (if allout-old-style-prefixes ;; Inhibit all the fancy formatting: - (allout-add-resumptions '((allout-primary-bullet "*") - (allout-old-style-prefixes ())))) + (allout-add-resumptions '(allout-primary-bullet "*"))) (allout-overlay-preparations) ; Doesn't hurt to redo this. @@ -1654,15 +1817,28 @@ OPEN: A topic that is not closed, though its offspring or body may be." (allout-infer-body-reindent) (set-allout-regexp) + (allout-add-resumptions + '(allout-encryption-ciphertext-rejection-regexps + allout-line-boundary-regexp + extend) + '(allout-encryption-ciphertext-rejection-regexps + allout-bob-regexp + extend)) ;; Produce map from current version of allout-keybindings-list: (setq allout-mode-map (produce-allout-mode-map allout-keybindings-list)) (substitute-key-definition 'beginning-of-line - 'move-beginning-of-line + 'allout-beginning-of-line + allout-mode-map global-map) + (substitute-key-definition 'move-beginning-of-line + 'allout-beginning-of-line allout-mode-map global-map) (substitute-key-definition 'end-of-line - 'move-end-of-line + 'allout-end-of-line + allout-mode-map global-map) + (substitute-key-definition 'move-end-of-line + 'allout-end-of-line allout-mode-map global-map) (produce-allout-mode-menubar-entries) (fset 'allout-mode-map allout-mode-map) @@ -1717,8 +1893,8 @@ OPEN: A topic that is not closed, though its offspring or body may be." (if allout-layout (setq do-layout t)) - (run-hooks 'allout-mode-hook) - (setq allout-mode t)) + (setq allout-mode t) + (run-hooks 'allout-mode-hook)) ;; Reactivation: ((setq do-layout t) @@ -2044,6 +2220,52 @@ Outermost is first." (while (allout-hidden-p) (end-of-line) (if (allout-hidden-p) (forward-char 1))))) +;;;_ > allout-beginning-of-line () +(defun allout-beginning-of-line () + "Beginning-of-line with `allout-beginning-of-line-cycles' behavior, if set." + + (interactive) + + (if (or (not allout-beginning-of-line-cycles) + (not (equal last-command this-command))) + (move-beginning-of-line 1) + (let ((beginning-of-body (save-excursion + (allout-beginning-of-current-entry) + (point)))) + (cond ((= (current-column) 0) + (allout-beginning-of-current-entry)) + ((< (point) beginning-of-body) + (allout-beginning-of-current-line)) + ((= (point) beginning-of-body) + (goto-char (allout-current-bullet-pos))) + (t (allout-beginning-of-current-line) + (if (< (point) beginning-of-body) + ;; we were on the headline after its start: + (allout-beginning-of-current-entry))))))) +;;;_ > allout-end-of-line () +(defun allout-end-of-line () + "End-of-line with `allout-end-of-line-cycles' behavior, if set." + + (interactive) + + (if (or (not allout-end-of-line-cycles) + (not (equal last-command this-command))) + (allout-end-of-current-line) + (let ((end-of-entry (save-excursion + (allout-end-of-entry) + (point)))) + (cond ((not (eolp)) + (allout-end-of-current-line)) + ((or (allout-hidden-p) (save-excursion + (forward-char -1) + (allout-hidden-p))) + (allout-back-to-current-heading) + (allout-show-current-entry) + (allout-end-of-entry)) + ((>= (point) end-of-entry) + (allout-back-to-current-heading) + (allout-end-of-current-line)) + (t (allout-end-of-entry)))))) ;;;_ > allout-next-heading () (defsubst allout-next-heading () "Move to the heading for the topic \(possibly invisible) after this one. @@ -2108,13 +2330,17 @@ Return the location of the beginning of the heading, or nil if not found." ;;; for assessment or adjustment of the subtree, without redundant ;;; traversal of the structure. -;;;_ > allout-chart-subtree (&optional levels orig-depth prev-depth) -(defun allout-chart-subtree (&optional levels orig-depth prev-depth) +;;;_ > allout-chart-subtree (&optional levels visible orig-depth prev-depth) +(defun allout-chart-subtree (&optional levels visible orig-depth prev-depth) "Produce a location \"chart\" of subtopics of the containing topic. Optional argument LEVELS specifies the depth \(relative to start -depth) for the chart. Subsequent optional args are not for public -use. +depth) for the chart. + +When optional argument VISIBLE is non-nil, the chart includes +only the visible subelements of the charted subjects. + +The remaining optional args are not for internal use by the function. Point is left at the end of the subtree. @@ -2141,7 +2367,9 @@ starting point, and PREV-DEPTH is depth of prior topic." ; position to first offspring: (progn (setq orig-depth (allout-depth)) (or prev-depth (setq prev-depth (1+ orig-depth))) - (allout-next-heading))) + (if visible + (allout-next-visible-heading 1) + (allout-next-heading)))) ;; Loop over the current levels' siblings. Besides being more ;; efficient than tail-recursing over a level, it avoids exceeding @@ -2163,8 +2391,12 @@ starting point, and PREV-DEPTH is depth of prior topic." ;; next heading at lesser depth: (while (and (<= curr-depth (allout-recent-depth)) - (allout-next-heading)))) - (allout-next-heading))) + (if visible + (allout-next-visible-heading 1) + (allout-next-heading))))) + (if visible + (allout-next-visible-heading 1) + (allout-next-heading)))) ((and (< prev-depth curr-depth) (or (not levels) @@ -2173,8 +2405,9 @@ starting point, and PREV-DEPTH is depth of prior topic." (setq chart (cons (allout-chart-subtree (and levels (1- levels)) - orig-depth - curr-depth) + visible + orig-depth + curr-depth) chart)) ;; ... then continue with this one. ) @@ -2369,7 +2602,9 @@ Returns the value of point." (while (and (not (eobp)) (> (allout-recent-depth) level)) (allout-next-heading)) - (and (not (eobp)) (forward-char -1)) + (if (eobp) + (allout-end-of-entry) + (forward-char -1)) (if (and (not include-trailing-blank) (= ?\n (preceding-char))) (forward-char -1)) (setq allout-recent-end-of-subtree (point)))) @@ -2675,6 +2910,13 @@ hot-spot operation, where literal characters typed over a topic bullet are mapped to the command of the corresponding control-key on the `allout-mode-map'.") (make-variable-buffer-local 'allout-post-goto-bullet) +;;;_ = allout-command-counter +(defvar allout-command-counter 0 + "Counter that monotonically increases in allout-mode buffers. + +Set by `allout-pre-command-business', to support allout addons in +coordinating with allout activity.") +(make-variable-buffer-local 'allout-command-counter) ;;;_ > allout-post-command-business () (defun allout-post-command-business () "Outline `post-command-hook' function. @@ -2692,7 +2934,7 @@ are mapped to the command of the corresponding control-key on the allout-after-save-decrypt) (allout-after-saves-handler)) - ;; Implement -post-goto-bullet, if set: + ;; Implement allout-post-goto-bullet, if set: (if (and allout-post-goto-bullet (allout-current-bullet-pos)) (progn (goto-char (allout-current-bullet-pos)) @@ -2701,7 +2943,9 @@ are mapped to the command of the corresponding control-key on the ;;;_ > allout-pre-command-business () (defun allout-pre-command-business () "Outline `pre-command-hook' function for outline buffers. -Implements special behavior when cursor is on bullet character. + +Among other things, implements special behavior when the cursor is on the +topic bullet character. When the cursor is on the bullet character, self-insert characters are reinterpreted as the corresponding control-character in the @@ -2709,7 +2953,7 @@ reinterpreted as the corresponding control-character in the the cursor which has moved as a result of such reinterpretation is positioned on the bullet character of the destination topic. -The upshot is that you can get easy, single (ie, unmodified) key +The upshot is that you can get easy, single \(ie, unmodified\) key outline maneuvering operations by positioning the cursor on the bullet char. When in this mode you can use regular cursor-positioning command/keystrokes to relocate the cursor off of a bullet character to @@ -2717,6 +2961,9 @@ return to regular interpretation of self-insert characters." (if (not (allout-mode-p)) nil + ;; Increment allout-command-counter + (setq allout-command-counter (1+ allout-command-counter)) + ;; Do hot-spot navigation. (if (and (eq this-command 'self-insert-command) (eq (point)(allout-current-bullet-pos))) (allout-hotspot-key-handler)))) @@ -2990,6 +3237,8 @@ case.) If OFFER-RECENT-BULLET is true, offer to use the bullet of the prior sibling. +Runs + Nuances: - Creation of new topics is with respect to the visible topic @@ -3040,7 +3289,8 @@ Nuances: allout-numbered-bullet)))) (point))) dbl-space - doing-beginning) + doing-beginning + start end) (if (not opening-on-blank) ; Positioning and vertical @@ -3141,8 +3391,10 @@ Nuances: (not (bolp))) (forward-char 1)))) )) + (setq start (point)) (insert (concat (allout-make-topic-prefix opening-numbered t depth) " ")) + (setq end (1+ (point))) (allout-rebullet-heading (and offer-recent-bullet ref-bullet) depth nil nil t) @@ -3150,6 +3402,8 @@ Nuances: (save-excursion (goto-char ref-topic) (allout-show-children))) (end-of-line) + + (run-hook-with-args 'allout-structure-added-hook start end) ) ) ;;;_ > allout-open-subtopic (arg) @@ -3548,6 +3802,7 @@ discontinuity. The first topic in the file can be adjusted to any positive depth, however." (interactive "p") (if (> arg 0) + ;; refuse to create a containment discontinuity: (save-excursion (allout-back-to-current-heading) (if (not (bobp)) @@ -3564,7 +3819,20 @@ depth, however." (1+ predecessor-depth))) (error (concat "Disallowed shift deeper than" " containing topic's children."))))))) - (allout-rebullet-topic arg)) + (let ((where (point)) + has-successor) + (if (and (< arg 0) + (allout-current-topic-collapsed-p) + (save-excursion (allout-next-sibling))) + (setq has-successor t)) + (allout-rebullet-topic arg) + (when (< arg 0) + (save-excursion + (if (allout-ascend) + (allout-show-children))) + (if has-successor + (allout-show-children))) + (run-hook-with-args 'allout-structure-shifted-hook arg where))) ;;;_ > allout-shift-out (arg) (defun allout-shift-out (arg) "Decrease depth of current heading and any topics collapsed within it. @@ -3574,9 +3842,7 @@ one level greater than the immediately previous topic, to avoid containment discontinuity. The first topic in the file can be adjusted to any positive depth, however." (interactive "p") - (if (< arg 0) - (allout-shift-in (* arg -1))) - (allout-rebullet-topic (* arg -1))) + (allout-shift-in (* arg -1))) ;;;_ : Surgery (kill-ring) functions with special provisions for outlines: ;;;_ > allout-kill-line (&optional arg) (defun allout-kill-line (&optional arg) @@ -3610,7 +3876,8 @@ depth, however." (save-excursion ; Renumber subsequent topics if needed: (if (not (looking-at allout-regexp)) (allout-next-heading)) - (allout-renumber-to-depth depth)))))) + (allout-renumber-to-depth depth))) + (run-hook-with-args 'allout-structure-deleted-hook depth (point))))) ;;;_ > allout-kill-topic () (defun allout-kill-topic () "Kill topic together with subtopics. @@ -3656,7 +3923,8 @@ when yank with allout-yank into an outline as a heading." (allout-unprotected (kill-region beg (point))) (sit-for 0) (save-excursion - (allout-renumber-to-depth depth)))) + (allout-renumber-to-depth depth)) + (run-hook-with-args 'allout-structure-deleted-hook depth (point)))) ;;;_ > allout-yank-processing () (defun allout-yank-processing (&optional arg) @@ -3683,112 +3951,113 @@ however, are left exactly like normal, non-allout-specific yanks." ; region around subject: (if (< (allout-mark-marker t) (point)) (exchange-point-and-mark)) - (let* ((inhibit-field-text-motion t) - (subj-beg (point)) - (into-bol (bolp)) - (subj-end (allout-mark-marker t)) - (was-collapsed (get-text-property subj-beg 'allout-was-collapsed)) - ;; 'resituate' if yanking an entire topic into topic header: - (resituate (and (allout-e-o-prefix-p) - (looking-at (concat "\\(" allout-regexp "\\)")) - (allout-prefix-data (match-beginning 1) + (allout-unprotected + (let* ((subj-beg (point)) + (into-bol (bolp)) + (subj-end (allout-mark-marker t)) + (was-collapsed (get-text-property subj-beg 'allout-was-collapsed)) + ;; 'resituate' if yanking an entire topic into topic header: + (resituate (and (allout-e-o-prefix-p) + (looking-at (concat "\\(" allout-regexp "\\)")) + (allout-prefix-data (match-beginning 1) (match-end 1)))) - ;; `rectify-numbering' if resituating (where several topics may - ;; be resituating) or yanking a topic into a topic slot (bol): - (rectify-numbering (or resituate - (and into-bol (looking-at allout-regexp))))) - (if resituate + ;; `rectify-numbering' if resituating (where several topics may + ;; be resituating) or yanking a topic into a topic slot (bol): + (rectify-numbering (or resituate + (and into-bol (looking-at allout-regexp))))) + (if resituate ; The yanked stuff is a topic: - (let* ((prefix-len (- (match-end 1) subj-beg)) - (subj-depth (allout-recent-depth)) - (prefix-bullet (allout-recent-bullet)) - (adjust-to-depth - ;; Nil if adjustment unnecessary, otherwise depth to which - ;; adjustment should be made: - (save-excursion - (and (goto-char subj-end) - (eolp) - (goto-char subj-beg) - (and (looking-at allout-regexp) - (progn - (beginning-of-line) - (not (= (point) subj-beg))) - (looking-at allout-regexp) - (allout-prefix-data (match-beginning 0) + (let* ((prefix-len (- (match-end 1) subj-beg)) + (subj-depth (allout-recent-depth)) + (prefix-bullet (allout-recent-bullet)) + (adjust-to-depth + ;; Nil if adjustment unnecessary, otherwise depth to which + ;; adjustment should be made: + (save-excursion + (and (goto-char subj-end) + (eolp) + (goto-char subj-beg) + (and (looking-at allout-regexp) + (progn + (beginning-of-line) + (not (= (point) subj-beg))) + (looking-at allout-regexp) + (allout-prefix-data (match-beginning 0) (match-end 0))) - (allout-recent-depth)))) - (more t)) - (setq rectify-numbering allout-numbered-bullet) - (if adjust-to-depth + (allout-recent-depth)))) + (more t)) + (setq rectify-numbering allout-numbered-bullet) + (if adjust-to-depth ; Do the adjustment: - (progn - (message "... yanking") (sit-for 0) - (save-restriction - (narrow-to-region subj-beg subj-end) + (progn + (message "... yanking") (sit-for 0) + (save-restriction + (narrow-to-region subj-beg subj-end) ; Trim off excessive blank ; line at end, if any: - (goto-char (point-max)) - (if (looking-at "^$") - (allout-unprotected (delete-char -1))) + (goto-char (point-max)) + (if (looking-at "^$") + (allout-unprotected (delete-char -1))) ; Work backwards, with each ; shallowest level, ; successively excluding the ; last processed topic from ; the narrow region: - (while more - (allout-back-to-current-heading) + (while more + (allout-back-to-current-heading) ; go as high as we can in each bunch: - (while (allout-ascend-to-depth (1- (allout-depth)))) - (save-excursion - (allout-rebullet-topic-grunt (- adjust-to-depth + (while (allout-ascend-to-depth (1- (allout-depth)))) + (save-excursion + (allout-rebullet-topic-grunt (- adjust-to-depth subj-depth)) - (allout-depth)) - (if (setq more (not (bobp))) - (progn (widen) - (forward-char -1) - (narrow-to-region subj-beg (point)))))) - (message "") - ;; Preserve new bullet if it's a distinctive one, otherwise - ;; use old one: - (if (string-match (regexp-quote prefix-bullet) - allout-distinctive-bullets-string) + (allout-depth)) + (if (setq more (not (bobp))) + (progn (widen) + (forward-char -1) + (narrow-to-region subj-beg (point)))))) + (message "") + ;; Preserve new bullet if it's a distinctive one, otherwise + ;; use old one: + (if (string-match (regexp-quote prefix-bullet) + allout-distinctive-bullets-string) ; Delete from bullet of old to ; before bullet of new: - (progn - (beginning-of-line) - (delete-region (point) subj-beg) - (set-marker (allout-mark-marker t) subj-end) - (goto-char subj-beg) - (allout-end-of-prefix)) + (progn + (beginning-of-line) + (delete-region (point) subj-beg) + (set-marker (allout-mark-marker t) subj-end) + (goto-char subj-beg) + (allout-end-of-prefix)) ; Delete base subj prefix, ; leaving old one: - (delete-region (point) (+ (point) - prefix-len - (- adjust-to-depth subj-depth))) + (delete-region (point) (+ (point) + prefix-len + (- adjust-to-depth subj-depth))) ; and delete residual subj ; prefix digits and space: - (while (looking-at "[0-9]") (delete-char 1)) - (if (looking-at " ") (delete-char 1)))) - (exchange-point-and-mark)))) - (if rectify-numbering - (progn - (save-excursion + (while (looking-at "[0-9]") (delete-char 1)) + (if (looking-at " ") (delete-char 1)))) + (exchange-point-and-mark)))) + (if rectify-numbering + (progn + (save-excursion ; Give some preliminary feedback: - (message "... reconciling numbers") (sit-for 0) + (message "... reconciling numbers") (sit-for 0) ; ... and renumber, in case necessary: - (goto-char subj-beg) - (if (allout-goto-prefix) - (allout-rebullet-heading nil ;;; solicit + (goto-char subj-beg) + (if (allout-goto-prefix) + (allout-rebullet-heading nil ;;; solicit (allout-depth) ;;; depth - nil ;;; number-control - nil ;;; index + nil ;;; number-control + nil ;;; index t)) - (message "")))) - (when (and (or into-bol resituate) was-collapsed) - (remove-text-properties subj-beg (1+ subj-beg) '(allout-was-collapsed)) - (allout-hide-current-subtree)) - (if (not resituate) - (exchange-point-and-mark)))) + (message "")))) + (when (and (or into-bol resituate) was-collapsed) + (remove-text-properties subj-beg (1+ subj-beg) '(allout-was-collapsed)) + (allout-hide-current-subtree)) + (if (not resituate) + (exchange-point-and-mark)) + (run-hook-with-args 'allout-structure-added-hook subj-beg subj-end)))) ;;;_ > allout-yank (&optional arg) (defun allout-yank (&optional arg) "`allout-mode' yank, with depth and numbering adjustment of yanked topics. @@ -3820,10 +4089,10 @@ works with normal `yank' in non-outline buffers." (interactive "*P") (setq this-command 'yank) - (yank arg) + (allout-unprotected + (yank arg)) (if (allout-mode-p) - (allout-yank-processing)) -) + (allout-yank-processing))) ;;;_ > allout-yank-pop (&optional arg) (defun allout-yank-pop (&optional arg) "Yank-pop like `allout-yank' when popping to bare outline prefixes. @@ -3882,9 +4151,13 @@ by pops to non-distinctive yanks. Bug..." ;;;_ - Fundamental ;;;_ > allout-flag-region (from to flag) (defun allout-flag-region (from to flag) - "Conceal text from FROM to TO if FLAG is non-nil, else reveal it. + "Conceal text between FROM and TO if FLAG is non-nil, else reveal it. + +Exposure-change hook `allout-exposure-change-hook' is run with the same +arguments as this function, after the exposure changes are made. \(The old +`allout-view-change-hook' is being deprecated, and eventually will not be +invoked.\)" -Text is shown if flag is nil and hidden otherwise." ;; We use outline invisibility spec. (remove-overlays from to 'category 'allout-exposure-category) (when flag @@ -3895,7 +4168,7 @@ Text is shown if flag is nil and hidden otherwise." (while props (overlay-put o (pop props) (pop props))))))) (run-hooks 'allout-view-change-hook) - (run-hooks 'allout-exposure-change-hook)) + (run-hook-with-args 'allout-exposure-change-hook from to flag)) ;;;_ > allout-flag-current-subtree (flag) (defun allout-flag-current-subtree (flag) "Conceal currently-visible topic's subtree if FLAG non-nil, else reveal it." @@ -4071,10 +4344,12 @@ true, then single-line topics are considered to be collapsed. By default, they are treated as being uncollapsed." (save-excursion (and - (= (progn (allout-back-to-current-heading) - (move-end-of-line 1) - (point)) - (allout-end-of-current-subtree (not (looking-at "\n\n")))) + ;; Is the topic all on one line (allowing for trailing blank line)? + (>= (progn (allout-back-to-current-heading) + (move-end-of-line 1) + (point)) + (allout-end-of-current-subtree (not (looking-at "\n\n")))) + (or include-single-liners (progn (backward-char 1) (allout-hidden-p)))))) ;;;_ > allout-hide-current-subtree (&optional just-close) @@ -5097,8 +5372,8 @@ See `allout-toggle-current-subtree-encryption' for more details." ;;; fetch-pass &optional retried verifying ;;; passphrase) (defun allout-encrypt-string (text decrypt allout-buffer key-type for-key - fetch-pass &optional retried verifying - passphrase) + fetch-pass &optional retried rejected + verifying passphrase) "Encrypt or decrypt message TEXT. If DECRYPT is true (default false), then decrypt instead of encrypt. @@ -5116,6 +5391,11 @@ that have been solicited in sequence leading to this current call. Optional PASSPHRASE enables explicit delivery of the decryption passphrase, for verification purposes. +Optional REJECTED is for internal use - conveys the number of +rejections due to matches against +`allout-encryption-ciphertext-rejection-regexps', as limited by +`allout-encryption-ciphertext-rejection-ceiling'. + Returns the resulting string, or nil if the transformation fails." (require 'pgg) @@ -5141,6 +5421,17 @@ Returns the resulting string, or nil if the transformation fails." target-prompt-id (or (buffer-file-name allout-buffer) target-prompt-id)))) + (strip-plaintext-regexps + (if (not decrypt) + (allout-get-configvar-values + 'allout-encryption-plaintext-sanitization-regexps))) + (reject-ciphertext-regexps + (if (not decrypt) + (allout-get-configvar-values + 'allout-encryption-ciphertext-rejection-regexps))) + (rejected (or rejected 0)) + (rejections-left (- allout-encryption-ciphertext-rejection-ceiling + rejected)) result-text status) (if (and fetch-pass (not passphrase)) @@ -5161,10 +5452,19 @@ Returns the resulting string, or nil if the transformation fails." key-type allout-buffer retried fetch-pass))) + (with-temp-buffer (insert text) + (when (and strip-plaintext-regexps (not decrypt)) + (dolist (re strip-plaintext-regexps) + (let ((re (if (listp re) (car re) re)) + (replacement (if (listp re) (cadr re) ""))) + (goto-char (point-min)) + (while (re-search-forward re nil t) + (replace-match replacement nil nil))))) + (cond ;; symmetric: @@ -5183,7 +5483,8 @@ Returns the resulting string, or nil if the transformation fails." (if verifying (throw 'encryption-failed nil) (pgg-remove-passphrase-from-cache target-cache-id t) - (error "Symmetric-cipher encryption failed - %s" + (error "Symmetric-cipher %scryption failed - %s" + (if decrypt "de" "en") "try again with different passphrase.")))) ;; encrypt 'keypair: @@ -5208,48 +5509,68 @@ Returns the resulting string, or nil if the transformation fails." (if status (pgg-situate-output (point-min) (point-max)) (error (pgg-remove-passphrase-from-cache target-cache-id t) - (error "decryption failed")))) - ) + (error "decryption failed"))))) (setq result-text (buffer-substring 1 (- (point-max) (if decrypt 0 1)))) - - ;; validate result - non-empty - (cond ((not result-text) - (if verifying - nil - ;; transform was fruitless, retry w/new passphrase. - (pgg-remove-passphrase-from-cache target-cache-id t) - (allout-encrypt-string text allout-buffer decrypt nil - (if retried (1+ retried) 1) - passphrase))) - - ;; Barf if encryption yields extraordinary control chars: - ((and (not decrypt) - (string-match "[\C-a\C-k\C-o-\C-z\C-@]" - result-text)) - (error (concat "encryption produced unusable" - " non-armored text - reconfigure!"))) - - ;; valid result and just verifying or non-symmetric: - ((or verifying (not (equal key-type 'symmetric))) - (if (or verifying decrypt) - (pgg-add-passphrase-to-cache target-cache-id - passphrase t)) - result-text) - - ;; valid result and regular symmetric - "register" - ;; passphrase with mnemonic aids/cache. - (t - (set-buffer allout-buffer) - (if passphrase - (pgg-add-passphrase-to-cache target-cache-id - passphrase t)) - (allout-update-passphrase-mnemonic-aids for-key passphrase - allout-buffer) - result-text) - ) ) + + ;; validate result - non-empty + (cond ((not result-text) + (if verifying + nil + ;; transform was fruitless, retry w/new passphrase. + (pgg-remove-passphrase-from-cache target-cache-id t) + (allout-encrypt-string text decrypt allout-buffer + key-type for-key nil + (if retried (1+ retried) 1) + rejected verifying nil))) + + ;; Retry (within limit) if ciphertext contains rejections: + ((and (not decrypt) + ;; Check for disqualification of this ciphertext: + (let ((regexps reject-ciphertext-regexps) + reject-it) + (while (and regexps (not reject-it)) + (setq reject-it (string-match (car regexps) + result-text)) + (pop regexps)) + reject-it)) + (setq rejections-left (1- rejections-left)) + (if (<= rejections-left 0) + (error (concat "Ciphertext rejected too many times" + " (%s), per `%s'") + allout-encryption-ciphertext-rejection-ceiling + 'allout-encryption-ciphertext-rejection-regexps) + (allout-encrypt-string text decrypt allout-buffer + key-type for-key nil + retried (1+ rejected) + verifying passphrase))) + ;; Barf if encryption yields extraordinary control chars: + ((and (not decrypt) + (string-match "[\C-a\C-k\C-o-\C-z\C-@]" + result-text)) + (error (concat "Encryption produced non-armored text, which" + "conflicts with allout mode - reconfigure!"))) + + ;; valid result and just verifying or non-symmetric: + ((or verifying (not (equal key-type 'symmetric))) + (if (or verifying decrypt) + (pgg-add-passphrase-to-cache target-cache-id + passphrase t)) + result-text) + + ;; valid result and regular symmetric - "register" + ;; passphrase with mnemonic aids/cache. + (t + (set-buffer allout-buffer) + (if passphrase + (pgg-add-passphrase-to-cache target-cache-id + passphrase t)) + (allout-update-passphrase-mnemonic-aids for-key passphrase + allout-buffer) + result-text) + ) ) ) ) @@ -5313,7 +5634,6 @@ of the availability of a cached copy." (pgg-read-passphrase-from-cache cache-id t))) (got-pass (or cached (pgg-read-passphrase full-prompt cache-id t))) - confirmation) (if (not got-pass) @@ -5321,14 +5641,14 @@ of the availability of a cached copy." ;; Duplicate our handle on the passphrase so it's not clobbered by ;; deactivate-passwd memory clearing: - (setq got-pass (format "%s" got-pass)) + (setq got-pass (copy-sequence got-pass)) (cond (verifier-string (save-window-excursion (if (allout-encrypt-string verifier-string 'decrypt allout-buffer 'symmetric - for-key nil 0 'verifying - got-pass) + for-key nil 0 0 'verifying + (copy-sequence got-pass)) (setq confirmation (format "%s" got-pass)))) (if (and (not confirmation) @@ -5365,15 +5685,7 @@ of the availability of a cached copy." ;; recurse to this routine: (pgg-read-passphrase prompt-sans-hint cache-id t)) (pgg-remove-passphrase-from-cache cache-id t) - (error "Confirmation failed."))) - ;; reduce opportunity for memory cherry-picking by zeroing duplicate: - (dotimes (i (length got-pass)) - (aset got-pass i 0)) - ) - ) - ) - ) - ) + (error "Confirmation failed.")))))))) ;;;_ > allout-encrypted-topic-p () (defun allout-encrypted-topic-p () "True if the current topic is encryptable and encrypted." @@ -5426,7 +5738,7 @@ An error is raised if the text is not encrypted." (dotimes (i (length spew)) (aset spew i (1+ (random 254)))) (allout-encrypt-string spew nil (current-buffer) 'symmetric - nil nil 0 passphrase)) + nil nil 0 0 passphrase)) ) ;;;_ > allout-update-passphrase-mnemonic-aids (for-key passphrase ;;; outline-buffer) @@ -5505,7 +5817,7 @@ Derived from value of `allout-passphrase-verifier-string'." allout-passphrase-verifier-string (allout-encrypt-string (allout-get-encryption-passphrase-verifier) 'decrypt allout-buffer 'symmetric - key nil 0 'verifying passphrase) + key nil 0 0 'verifying passphrase) t))) ;;;_ > allout-next-topic-pending-encryption (&optional except-mark) (defun allout-next-topic-pending-encryption (&optional except-mark) @@ -5808,6 +6120,25 @@ If BEG is bigger than END we return 0." (goto-char (1+ (match-beginning 0))) (setq count (1+ count))) count)))) +;;;_ > allout-get-configvar-values (varname) +(defun allout-get-configvar-values (configvar-name) + "Return a list of values of the symbols in list bound to CONFIGVAR-NAME. + +The user is prompted for removal of symbols that are unbound, and they +otherwise are ignored. + +CONFIGVAR-NAME should be the name of the configuration variable, +not its value." + + (let ((configvar-value (symbol-value configvar-name)) + got) + (dolist (sym configvar-value) + (if (not (boundp sym)) + (if (yes-or-no-p (format "%s entry `%s' is unbound - remove it? " + configvar-name sym)) + (delq sym (symbol-value configvar-name))) + (push (symbol-value sym) got))) + (reverse got))) ;;;_ > allout-mark-marker to accommodate divergent emacsen: (defun allout-mark-marker (&optional force buffer) "Accommodate the different signature for `mark-marker' across Emacsen. diff --git a/lisp/avoid.el b/lisp/avoid.el index 1868707720..b497c2007b 100644 --- a/lisp/avoid.el +++ b/lisp/avoid.el @@ -124,6 +124,7 @@ Only applies in mouse-avoidance-modes `animate' and `jump'." (defvar mouse-avoidance-pointer-shapes nil) (defvar mouse-avoidance-n-pointer-shapes 0) (defvar mouse-avoidance-old-pointer-shape nil) +(defvar mouse-avoidance-animating-pointer nil) ;; This timer is used to run something when Emacs is idle. (defvar mouse-avoidance-timer nil) @@ -243,16 +244,19 @@ You can redefine this if you want the mouse banished to a different corner." (+ (cdr mouse-avoidance-state) deltay))) (if (or (eq mouse-avoidance-mode 'animate) (eq mouse-avoidance-mode 'proteus)) - (let ((i 0.0)) + (let ((i 0.0) + (incr (max .1 (/ 1.0 mouse-avoidance-nudge-dist)))) + (setq mouse-avoidance-animating-pointer t) (while (<= i 1) (mouse-avoidance-set-mouse-position (cons (+ (car cur-pos) (round (* i deltax))) (+ (cdr cur-pos) (round (* i deltay))))) - (setq i (+ i (max .1 (/ 1.0 mouse-avoidance-nudge-dist)))) + (setq i (+ i incr)) (if (eq mouse-avoidance-mode 'proteus) (mouse-avoidance-set-pointer-shape (mouse-avoidance-random-shape))) - (sit-for mouse-avoidance-animation-delay))) + (sit-for mouse-avoidance-animation-delay)) + (setq mouse-avoidance-animating-pointer nil)) (mouse-avoidance-set-mouse-position (cons (+ (car (cdr cur)) deltax) (+ (cdr (cdr cur)) deltay)))))) @@ -294,11 +298,11 @@ redefine this function to suit your own tastes." (memq 'drag modifiers) (memq 'down modifiers))))))) -(defun mouse-avoidance-banish-hook () +(defun mouse-avoidance-banish () (if (not (mouse-avoidance-ignore-p)) (mouse-avoidance-banish-mouse))) -(defun mouse-avoidance-exile-hook () +(defun mouse-avoidance-exile () ;; For exile mode, the state is nil when the mouse is in its normal ;; position, and set to the old mouse-position when the mouse is in exile. (if (not (mouse-avoidance-ignore-p)) @@ -317,9 +321,10 @@ redefine this function to suit your own tastes." ;; but clear state anyway, to be ready for another move (setq mouse-avoidance-state nil)))))) -(defun mouse-avoidance-fancy-hook () +(defun mouse-avoidance-fancy () ;; Used for the "fancy" modes, ie jump et al. - (if (and (not (mouse-avoidance-ignore-p)) + (if (and (not mouse-avoidance-animating-pointer) + (not (mouse-avoidance-ignore-p)) (mouse-avoidance-too-close-p (mouse-position))) (let ((old-pos (mouse-position))) (mouse-avoidance-nudge-mouse) @@ -375,14 +380,14 @@ definition of \"random distance\".)" (eq mode 'animate) (eq mode 'proteus)) (setq mouse-avoidance-timer - (run-with-idle-timer 0.1 t 'mouse-avoidance-fancy-hook)) + (run-with-idle-timer 0.1 t 'mouse-avoidance-fancy)) (setq mouse-avoidance-mode mode mouse-avoidance-state (cons 0 0) mouse-avoidance-old-pointer-shape (and (boundp 'x-pointer-shape) x-pointer-shape))) ((eq mode 'exile) (setq mouse-avoidance-timer - (run-with-idle-timer 0.1 t 'mouse-avoidance-exile-hook)) + (run-with-idle-timer 0.1 t 'mouse-avoidance-exile)) (setq mouse-avoidance-mode mode mouse-avoidance-state nil)) ((or (eq mode 'banish) @@ -390,7 +395,7 @@ definition of \"random distance\".)" (and (null mode) (null mouse-avoidance-mode)) (and mode (> (prefix-numeric-value mode) 0))) (setq mouse-avoidance-timer - (run-with-idle-timer 0.1 t 'mouse-avoidance-banish-hook)) + (run-with-idle-timer 0.1 t 'mouse-avoidance-banish)) (setq mouse-avoidance-mode 'banish)) (t (setq mouse-avoidance-mode nil))) (force-mode-line-update)) diff --git a/lisp/bindings.el b/lisp/bindings.el index eea9184cee..9671bf26f2 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -215,14 +215,6 @@ mnemonics of the following coding systems: (make-variable-buffer-local 'mode-line-mule-info) -(defvar mode-line-buffer-identification (purecopy '("%12b")) "\ -Mode-line control for identifying the buffer being displayed. -Its default value is (\"%12b\"). -Major modes that edit things other than ordinary files may change this -\(e.g. Info, Dired,...)") - -(make-variable-buffer-local 'mode-line-buffer-identification) - (defvar mode-line-frame-identification '(window-system " " "-%F ") "Mode-line control to describe the current frame.") @@ -294,56 +286,102 @@ Keymap to display on minor modes.") ;; mouse-1: select window, mouse-2: delete others, mouse-3: delete, ;; drag-mouse-1: resize, C-mouse-2: split horizontally" "mouse-1: select (drag to resize), mouse-2: delete others, mouse-3: delete this") - (dashes (propertize "--" 'help-echo help-echo))) - (setq-default mode-line-format - (list - "%e" - (propertize "-" 'help-echo help-echo) - 'mode-line-mule-info - 'mode-line-client - 'mode-line-modified - 'mode-line-frame-identification - 'mode-line-buffer-identification - (propertize " " 'help-echo help-echo) - 'mode-line-position - `(vc-mode ("" vc-mode ,(propertize " " 'help-echo help-echo))) - 'mode-line-modes - `(which-func-mode ("" which-func-format ,dashes)) - `(global-mode-string (,dashes global-mode-string)) - (propertize "-%-" 'help-echo help-echo))) - - (setq-default mode-line-modes - (list - (propertize "%[(" 'help-echo help-echo) - `(:propertize ("" mode-name) - help-echo "mouse-1: major mode, mouse-2: major mode help, mouse-3: toggle minor modes" - mouse-face mode-line-highlight - local-map ,mode-line-major-mode-keymap) - '("" mode-line-process) - `(:propertize ("" minor-mode-alist) - mouse-face mode-line-highlight - help-echo "mouse-2: minor mode help, mouse-3: toggle minor modes" - local-map ,mode-line-minor-mode-keymap) - (propertize "%n" 'help-echo "mouse-2: widen" - 'mouse-face 'mode-line-highlight - 'local-map (make-mode-line-mouse-map - 'mouse-2 #'mode-line-widen)) - (propertize ")%]--" 'help-echo help-echo))) - - (setq-default mode-line-position - `((-3 ,(propertize "%p" 'help-echo help-echo)) - (size-indication-mode - (8 ,(propertize " of %I" 'help-echo help-echo))) - (line-number-mode - ((column-number-mode - (10 ,(propertize " (%l,%c)" 'help-echo help-echo)) - (6 ,(propertize " L%l" 'help-echo help-echo)))) - ((column-number-mode - (5 ,(propertize " C%c" 'help-echo help-echo)))))))) + (dashes (propertize "--" 'help-echo help-echo)) + (standard-mode-line-format + (list + "%e" + (propertize "-" 'help-echo help-echo) + 'mode-line-mule-info + 'mode-line-client + 'mode-line-modified + 'mode-line-frame-identification + 'mode-line-buffer-identification + (propertize " " 'help-echo help-echo) + 'mode-line-position + '(vc-mode vc-mode) + (propertize " " 'help-echo help-echo) + 'mode-line-modes + `(which-func-mode ("" which-func-format ,dashes)) + `(global-mode-string (,dashes global-mode-string)) + (propertize "-%-" 'help-echo help-echo))) + (standard-mode-line-modes + (list + (propertize "%[(" 'help-echo help-echo) + `(:propertize ("" mode-name) + help-echo "mouse-1: major mode, mouse-2: major mode help, mouse-3: toggle minor modes" + mouse-face mode-line-highlight + local-map ,mode-line-major-mode-keymap) + '("" mode-line-process) + `(:propertize ("" minor-mode-alist) + mouse-face mode-line-highlight + help-echo "mouse-2: minor mode help, mouse-3: toggle minor modes" + local-map ,mode-line-minor-mode-keymap) + (propertize "%n" 'help-echo "mouse-2: widen" + 'mouse-face 'mode-line-highlight + 'local-map (make-mode-line-mouse-map + 'mouse-2 #'mode-line-widen)) + (propertize ")%]--" 'help-echo help-echo))) + + (standard-mode-line-position + `((-3 ,(propertize "%p" 'help-echo help-echo)) + (size-indication-mode + (8 ,(propertize " of %I" 'help-echo help-echo))) + (line-number-mode + ((column-number-mode + (10 ,(propertize " (%l,%c)" 'help-echo help-echo)) + (6 ,(propertize " L%l" 'help-echo help-echo)))) + ((column-number-mode + (5 ,(propertize " C%c" 'help-echo help-echo)))))))) + + (setq-default mode-line-format standard-mode-line-format) + (put 'mode-line-format 'standard-value + (list `(quote ,standard-mode-line-format))) + + (setq-default mode-line-modes standard-mode-line-modes) + (put 'mode-line-modes 'standard-value + (list `(quote ,standard-mode-line-modes))) + + (setq-default mode-line-position standard-mode-line-position) + (put 'mode-line-position 'standard-value + (list `(quote ,standard-mode-line-position)))) (defvar mode-line-buffer-identification-keymap nil "\ Keymap for what is displayed by `mode-line-buffer-identification'.") +;; Add menu of buffer operations to the buffer identification part +;; of the mode line.or header line. +; +(let ((map (make-sparse-keymap))) + ;; Bind down- events so that the global keymap won't ``shine + ;; through''. + (define-key map [mode-line mouse-1] 'mode-line-previous-buffer) + (define-key map [header-line down-mouse-1] 'ignore) + (define-key map [header-line mouse-1] 'mode-line-previous-buffer) + (define-key map [header-line down-mouse-3] 'ignore) + (define-key map [mode-line mouse-3] 'mode-line-next-buffer) + (define-key map [header-line down-mouse-3] 'ignore) + (define-key map [header-line mouse-3] 'mode-line-next-buffer) + (setq mode-line-buffer-identification-keymap map)) + +(defun propertized-buffer-identification (fmt) + "Return a list suitable for `mode-line-buffer-identification'. +FMT is a format specifier such as \"%12b\". This function adds +text properties for face, help-echo, and local-map to it." + (list (propertize fmt + 'face 'mode-line-buffer-id + 'help-echo + (purecopy "mouse-1: previous buffer, mouse-3: next buffer") + 'mouse-face 'mode-line-highlight + 'local-map mode-line-buffer-identification-keymap))) + +(defvar mode-line-buffer-identification (propertized-buffer-identification "%12b") "\ +Mode-line control for identifying the buffer being displayed. +Its default value is (\"%12b\") with some text properties added. +Major modes that edit things other than ordinary files may change this +\(e.g. Info, Dired,...)") + +(make-variable-buffer-local 'mode-line-buffer-identification) + (defun unbury-buffer () "\ Switch to the last buffer in the buffer list." (interactive) @@ -449,35 +487,6 @@ Menu of mode operations in the mode line.") (let ((indicator (car (nth 4 (car (cdr event)))))) (describe-minor-mode-from-indicator indicator))) -;; Add menu of buffer operations to the buffer identification part -;; of the mode line.or header line. -; -(let ((map (make-sparse-keymap))) - ;; Bind down- events so that the global keymap won't ``shine - ;; through''. - (define-key map [mode-line mouse-1] 'mode-line-previous-buffer) - (define-key map [header-line down-mouse-1] 'ignore) - (define-key map [header-line mouse-1] 'mode-line-previous-buffer) - (define-key map [header-line down-mouse-3] 'ignore) - (define-key map [mode-line mouse-3] 'mode-line-next-buffer) - (define-key map [header-line down-mouse-3] 'ignore) - (define-key map [header-line mouse-3] 'mode-line-next-buffer) - (setq mode-line-buffer-identification-keymap map)) - -(defun propertized-buffer-identification (fmt) - "Return a list suitable for `mode-line-buffer-identification'. -FMT is a format specifier such as \"%12b\". This function adds -text properties for face, help-echo, and local-map to it." - (list (propertize fmt - 'face 'mode-line-buffer-id - 'help-echo - (purecopy "mouse-1: previous buffer, mouse-3: next buffer") - 'mouse-face 'mode-line-highlight - 'local-map mode-line-buffer-identification-keymap))) - -(setq-default mode-line-buffer-identification - (propertized-buffer-identification "%12b")) - (defvar minor-mode-alist nil "\ Alist saying how to show minor modes in the mode line. Each element looks like (VARIABLE STRING); diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index e9e7e9a2bb..398b362d4e 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -117,6 +117,7 @@ file buffers. It affects both manual reverting and reverting by Auto Revert Mode.") (defvar Info-current-file) ;; from info.el +(defvar Info-current-node) ;; from info.el (make-variable-buffer-local 'Buffer-menu-files-only) @@ -786,7 +787,12 @@ For more information, see the function `buffer-menu'." ((eq file 'toc) (setq file "*Info TOC*")) ((not (stringp file)) ;; avoid errors - (setq file nil)))))) + (setq file nil)) + (t + (setq file (concat "(" + (file-name-nondirectory file) + ")" + Info-current-node))))))) (push (list buffer bits name (buffer-size) mode file) list)))))) ;; Preserve the original buffer-list ordering, just in case. diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el index 3f2697509f..13b3671e16 100644 --- a/lisp/calendar/timeclock.el +++ b/lisp/calendar/timeclock.el @@ -95,7 +95,7 @@ :group 'timeclock) (defcustom timeclock-relative t - "*Whether to maken reported time relative to `timeclock-workday'. + "*Whether to make reported time relative to `timeclock-workday'. For example, if the length of a normal workday is eight hours, and you work four hours on Monday, then the amount of time \"remaining\" on Tuesday is twelve hours -- relative to an averaged work period of @@ -251,7 +251,10 @@ each day.") This value is not accurate enough to be useful by itself. Rather, call `timeclock-workday-elapsed', to determine how much time has been worked so far today. Also, if `timeclock-relative' is nil, this value -will be the same as `timeclock-discrepancy'.") ; ? gm +will be the same as `timeclock-discrepancy'.") + +(defvar timeclock-use-elapsed nil + "Non-nil if the modeline should display time elapsed, not remaining.") (defvar timeclock-last-period nil "Integer representing the number of seconds in the last period. @@ -424,7 +427,9 @@ If SHOW-SECONDS is non-nil, display second resolution. If TODAY-ONLY is non-nil, the display will be relative only to time worked today, ignoring the time worked on previous days." (interactive "P") - (let ((remainder (timeclock-workday-remaining)) ; today-only? + (let ((remainder (timeclock-workday-remaining + (or today-only + (not timeclock-relative)))) (last-in (equal (car timeclock-last-event) "i")) status) (setq status @@ -619,7 +624,10 @@ relative only to the time worked today, and not to past time." The value of `timeclock-relative' affects the display as described in that variable's documentation." (interactive) - (let ((remainder (timeclock-workday-remaining (not timeclock-relative))) + (let ((remainder + (if timeclock-use-elapsed + (timeclock-workday-elapsed) + (timeclock-workday-remaining (not timeclock-relative)))) (last-in (equal (car timeclock-last-event) "i"))) (when (and (< remainder 0) (not (and timeclock-day-over diff --git a/lisp/compare-w.el b/lisp/compare-w.el index e61f24a0c7..8dc0ac1e33 100644 --- a/lisp/compare-w.el +++ b/lisp/compare-w.el @@ -167,16 +167,14 @@ on first call it advances points to the next difference, on second call it synchronizes points by skipping the difference, on third call it again advances points to the next difference and so on." (interactive "P") + (if compare-ignore-whitespace + (setq ignore-whitespace (not ignore-whitespace))) (let* (p1 p2 maxp1 maxp2 b1 b2 w2 (progress 1) (opoint1 (point)) opoint2 - (skip-func (if (if ignore-whitespace ; XOR - (not compare-ignore-whitespace) - compare-ignore-whitespace) - (if (stringp compare-windows-whitespace) - 'compare-windows-skip-whitespace - compare-windows-whitespace))) + skip-func-1 + skip-func-2 (sync-func (if (stringp compare-windows-sync) 'compare-windows-sync-regexp compare-windows-sync))) @@ -190,8 +188,21 @@ on third call it again advances points to the next difference and so on." b2 (window-buffer w2)) (setq opoint2 p2) (setq maxp1 (point-max)) - (save-excursion - (set-buffer b2) + + (setq skip-func-1 (if ignore-whitespace + (if (stringp compare-windows-whitespace) + (lambda (pos) + (compare-windows-skip-whitespace pos) + t) + compare-windows-whitespace))) + + (with-current-buffer b2 + (setq skip-func-2 (if ignore-whitespace + (if (stringp compare-windows-whitespace) + (lambda (pos) + (compare-windows-skip-whitespace pos) + t) + compare-windows-whitespace))) (push-mark p2 t) (setq maxp2 (point-max))) (push-mark) @@ -199,17 +210,16 @@ on third call it again advances points to the next difference and so on." (while (> progress 0) ;; If both windows have whitespace next to point, ;; optionally skip over it. - (and skip-func + (and skip-func-1 (save-excursion (let (p1a p2a w1 w2 result1 result2) - (setq result1 (funcall skip-func opoint1)) + (setq result1 (funcall skip-func-1 opoint1)) (setq p1a (point)) (set-buffer b2) (goto-char p2) - (setq result2 (funcall skip-func opoint2)) + (setq result2 (funcall skip-func-2 opoint2)) (setq p2a (point)) - (if (or (stringp compare-windows-whitespace) - (and result1 result2 (eq result1 result2))) + (if (and result1 result2 (eq result1 result2)) (setq p1 p1a p2 p2a))))) diff --git a/lisp/complete.el b/lisp/complete.el index ca6231893c..90c1ceceb3 100644 --- a/lisp/complete.el +++ b/lisp/complete.el @@ -543,8 +543,8 @@ of `minibuffer-completion-table' and the minibuffer contents.") (let ((compl (all-completions (if env-on (file-name-nondirectory (substring str 0 p)) (substring str 0 p)) - table - pred))) + table + pred))) (setq p compl) (while p (and (string-match regex (car p)) @@ -553,6 +553,34 @@ of `minibuffer-completion-table' and the minibuffer contents.") (setq poss (cons (car p) poss)))) (setq p (cdr p))))) + ;; Handle completion-ignored-extensions + (and filename + (not (eq mode 'help)) + (let ((p2 poss)) + + ;; Build a regular expression representing the extensions list + (or (equal completion-ignored-extensions PC-ignored-extensions) + (setq PC-ignored-regexp + (concat "\\(" + (mapconcat + 'regexp-quote + (setq PC-ignored-extensions + completion-ignored-extensions) + "\\|") + "\\)\\'"))) + + ;; Check if there are any without an ignored extension. + ;; Also ignore `.' and `..'. + (setq p nil) + (while p2 + (or (string-match PC-ignored-regexp (car p2)) + (string-match "\\(\\`\\|/\\)[.][.]?/?\\'" (car p2)) + (setq p (cons (car p2) p))) + (setq p2 (cdr p2))) + + ;; If there are "good" names, use them + (and p (setq poss p)))) + ;; Now we have a list of possible completions (cond @@ -575,34 +603,6 @@ of `minibuffer-completion-table' and the minibuffer contents.") ((or (cdr (setq helpposs poss)) (memq mode '(help word))) - ;; Handle completion-ignored-extensions - (and filename - (not (eq mode 'help)) - (let ((p2 poss)) - - ;; Build a regular expression representing the extensions list - (or (equal completion-ignored-extensions PC-ignored-extensions) - (setq PC-ignored-regexp - (concat "\\(" - (mapconcat - 'regexp-quote - (setq PC-ignored-extensions - completion-ignored-extensions) - "\\|") - "\\)\\'"))) - - ;; Check if there are any without an ignored extension. - ;; Also ignore `.' and `..'. - (setq p nil) - (while p2 - (or (string-match PC-ignored-regexp (car p2)) - (string-match "\\(\\`\\|/\\)[.][.]?/?\\'" (car p2)) - (setq p (cons (car p2) p))) - (setq p2 (cdr p2))) - - ;; If there are "good" names, use them - (and p (setq poss p)))) - ;; Is the actual string one of the possible completions? (setq p (and (not (eq mode 'help)) poss)) (while (and p @@ -623,7 +623,8 @@ of `minibuffer-completion-table' and the minibuffer contents.") ;; Check if next few letters are the same in all cases (if (and (not (eq mode 'help)) - (setq prefix (try-completion (PC-chunk-after basestr skip) (mapcar 'list poss)))) + (setq prefix (try-completion (PC-chunk-after basestr skip) + poss))) (let ((first t) i) ;; Retain capitalization of user input even if ;; completion-ignore-case is set. @@ -669,13 +670,9 @@ of `minibuffer-completion-table' and the minibuffer contents.") (+ beg (length dirname)) end) skip) (mapcar - (function - (lambda (x) - (list - (and (string-match skip x) - (substring - x - (match-end 0)))))) + (lambda (x) + (when (string-match skip x) + (substring x (match-end 0)))) poss))) (or (> i 0) (> (length prefix) 0)) (or (not (eq mode 'word)) @@ -811,6 +808,12 @@ or properties are considered." (defun PC-expand-many-files (name) (with-current-buffer (generate-new-buffer " *Glob Output*") (erase-buffer) + (when (and (file-name-absolute-p name) + (not (file-directory-p default-directory))) + ;; If the current working directory doesn't exist `shell-command' + ;; signals an error. So if the file names we're looking for don't + ;; depend on the working directory, switch to a valid directory first. + (setq default-directory "/")) (shell-command (concat "echo " name) t) (goto-char (point-min)) ;; CSH-style shells were known to output "No match", whereas diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 15f43080af..609b5572a0 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -4435,9 +4435,8 @@ The format is suitable for use with `easy-menu-define'." ;; Actually, this misfeature of dense keymaps was fixed on 2001-11-26. (let ((map (make-keymap))) (set-keymap-parent map widget-keymap) - (define-key map [remap self-insert-command] - 'custom-no-edit) - (define-key map "\^m" 'custom-no-edit) + (define-key map [remap self-insert-command] 'custom-no-edit) + (define-key map "\^m" 'custom-newline) (define-key map " " 'scroll-up) (define-key map "\177" 'scroll-down) (define-key map "\C-c\C-c" 'Custom-set) @@ -4452,6 +4451,11 @@ The format is suitable for use with `easy-menu-define'." (defun custom-no-edit (pos &optional event) "Invoke button at POS, or refuse to allow editing of Custom buffer." (interactive "@d") + (error "You can't edit this part of the Custom buffer")) + +(defun custom-newline (pos &optional event) + "Invoke button at POS, or refuse to allow editing of Custom buffer." + (interactive "@d") (let ((button (get-char-property pos 'button))) (if button (widget-apply-action button event) diff --git a/lisp/cus-start.el b/lisp/cus-start.el index cceed27951..b59cb57aaf 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -175,7 +175,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of ;; fringe.c (overflow-newline-into-fringe fringe boolean) ;; indent.c - (indent-tabs-mode fill boolean) + (indent-tabs-mode indent boolean) ;; keyboard.c (meta-prefix-char keyboard character) (auto-save-interval auto-save integer) @@ -360,6 +360,7 @@ since it could result in memory overflow and make Emacs crash." (other :tag "Unlimited" t))) (unibyte-display-via-language-environment mule boolean) (blink-cursor-alist cursor alist "22.1") + (overline-margin display integer "22.1") ;; xfaces.c (scalable-fonts-allowed display boolean) ;; xfns.c @@ -371,6 +372,7 @@ since it could result in memory overflow and make Emacs crash." ;; xterm.c (mouse-autoselect-window display boolean "21.3") (x-use-underline-position-properties display boolean "21.3") + (x-underline-at-descent-line display boolean "22.1") (x-stretch-cursor display boolean "21.1"))) this symbol group type standard version native-p ;; This function turns a value diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index 53f530505a..b4fe1e4b0b 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el @@ -99,7 +99,7 @@ the directory " custom-theme-directory "\n\n") (widget-insert " ") (widget-create 'push-button :notify (lambda (&rest ignore) - (when (y-or-n-p "Discard current changes?") + (when (y-or-n-p "Discard current changes? ") (kill-buffer (current-buffer)) (customize-create-theme))) "Reset Buffer") @@ -137,7 +137,7 @@ the directory " custom-theme-directory "\n\n") (widget-insert "\n") (widget-create 'push-button :notify (lambda (&rest ignore) - (when (y-or-n-p "Discard current changes?") + (when (y-or-n-p "Discard current changes? ") (kill-buffer (current-buffer)) (customize-create-theme))) "Reset Buffer") @@ -290,7 +290,7 @@ Optional EVENT is the location for the menu." (defun custom-theme-visit-theme () (interactive) (when (or (null custom-theme-variables) - (if (y-or-n-p "Discard current changes?") + (if (y-or-n-p "Discard current changes? ") (progn (customize-create-theme) t))) (let ((theme (call-interactively 'custom-theme-merge-theme))) (unless (eq theme 'user) diff --git a/lisp/ediff-mult.el b/lisp/ediff-mult.el index 71859a5d4c..b33ad7c185 100644 --- a/lisp/ediff-mult.el +++ b/lisp/ediff-mult.el @@ -648,8 +648,8 @@ behavior." (mapcar (lambda (elt) (ediff-make-new-meta-list-element - (concat auxdir1 elt) - (concat auxdir2 elt) + (expand-file-name (concat auxdir1 elt)) + (expand-file-name (concat auxdir2 elt)) (if lis3 (progn ;; The following is done because: In merging with @@ -660,7 +660,7 @@ behavior." ;; the second case, we insert nil. (setq elt (ediff-add-slash-if-directory auxdir3 elt)) (if (file-exists-p (concat auxdir3 elt)) - (concat auxdir3 elt)))))) + (expand-file-name (concat auxdir3 elt))))))) common))) ;; return result (cons common-part difflist) @@ -716,7 +716,7 @@ behavior." auxdir1 nil nil merge-autostore-dir nil) (mapcar (lambda (elt) (ediff-make-new-meta-list-element - (concat auxdir1 elt) nil nil)) + (expand-file-name (concat auxdir1 elt)) nil nil)) common)) )) @@ -1338,7 +1338,10 @@ Useful commands: ;; update ediff-meta-list by direct modification (nconc meta-list (list (ediff-make-new-meta-list-element - otherfile1 otherfile2 otherfile3))) + (expand-file-name otherfile1) + (expand-file-name otherfile2) + (if otherfile3 + (expand-file-name otherfile3))))) ) (ediff-update-meta-buffer meta-buf 'must-redraw) )) diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 86bf29f038..3b562bbdbd 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -670,6 +670,7 @@ This function assumes that the events can be stored in a string." (cond ((atom ev) (push ev result)) ((eq (car ev) 'help-echo)) + ((eq (car ev) 'switch-frame)) ((equal ev '(menu-bar)) (push 'menu-bar result)) ((equal (cadadr ev) '(menu-bar)) diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index d05eed2c4a..1b37f3f772 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -619,9 +619,12 @@ If optional second arg SEP is a string, use that as separator." (bindat-format-vector vect "%02x" (if (stringp sep) sep ":"))) (defun bindat-ip-to-string (ip) - "Format vector IP as an ip address in dotted notation." - (format "%d.%d.%d.%d" - (aref ip 0) (aref ip 1) (aref ip 2) (aref ip 3))) + "Format vector IP as an ip address in dotted notation. +The port (if any) is omitted. IP can be a string, as well." + (if (vectorp ip) + (format-network-address ip t) + (format "%d.%d.%d.%d" + (aref ip 0) (aref ip 1) (aref ip 2) (aref ip 3)))) (provide 'bindat) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index bbeea5d703..68603c905a 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -193,8 +193,14 @@ (defvar compilation-error-regexp-alist) (defvar compilation-mode-font-lock-keywords) +(defgroup checkdoc nil + "Support for doc string checking in Emacs Lisp." + :prefix "checkdoc" + :group 'lisp + :version "20.3") + (defcustom checkdoc-autofix-flag 'semiautomatic - "*Non-nil means attempt auto-fixing of doc strings. + "Non-nil means attempt auto-fixing of doc strings. If this value is the symbol `query', then the user is queried before any change is made. If the value is `automatic', then all changes are made without asking unless the change is very-complex. If the value @@ -208,37 +214,39 @@ The value `never' is the same as nil, never ask or change anything." (other :tag "semiautomatic" semiautomatic))) (defcustom checkdoc-bouncy-flag t - "*Non-nil means to \"bounce\" to auto-fix locations. + "Non-nil means to \"bounce\" to auto-fix locations. Setting this to nil will silently make fixes that require no user interaction. See `checkdoc-autofix-flag' for auto-fixing details." :group 'checkdoc :type 'boolean) (defcustom checkdoc-force-docstrings-flag t - "*Non-nil means that all checkable definitions should have documentation. + "Non-nil means that all checkable definitions should have documentation. Style guide dictates that interactive functions MUST have documentation, and that it's good but not required practice to make non user visible items have doc strings." :group 'checkdoc :type 'boolean) +(put 'checkdoc-force-docstrings-flag 'safe-local-variable 'booleanp) (defcustom checkdoc-force-history-flag t - "*Non-nil means that files should have a History section or ChangeLog file. + "Non-nil means that files should have a History section or ChangeLog file. This helps document the evolution of, and recent changes to, the package." :group 'checkdoc :type 'boolean) (defcustom checkdoc-permit-comma-termination-flag nil - "*Non-nil means the first line of a docstring may end with a comma. + "Non-nil means the first line of a docstring may end with a comma. Ordinarily, a full sentence is required. This may be misleading when there is a substantial caveat to the one-line description -- the comma should be used when the first part could stand alone as a sentence, but it indicates that a modifying clause follows." :group 'checkdoc :type 'boolean) +(put 'checkdoc-permit-comma-termination-flag 'safe-local-variable 'booleanp) (defcustom checkdoc-spellcheck-documentation-flag nil - "*Non-nil means run Ispell on text based on value. + "Non-nil means run Ispell on text based on value. This is automatically set to nil if Ispell does not exist on your system. Possible values are: @@ -259,14 +267,14 @@ system. Possible values are: "List of words that are correct when spell-checking Lisp documentation.") (defcustom checkdoc-max-keyref-before-warn 10 - "*The number of \\ [command-to-keystroke] tokens allowed in a doc string. + "The number of \\ [command-to-keystroke] tokens allowed in a doc string. Any more than this and a warning is generated suggesting that the construct \\ {keymap} be used instead." :group 'checkdoc :type 'integer) (defcustom checkdoc-arguments-in-order-flag t - "*Non-nil means warn if arguments appear out of order. + "Non-nil means warn if arguments appear out of order. Setting this to nil will mean only checking that all the arguments appear in the proper form in the documentation, not that they are in the same order as they appear in the argument list. No mention is @@ -298,7 +306,7 @@ problem discovered. This is useful for adding additional checks.") A search leaves the cursor in front of the parameter list.") (defcustom checkdoc-verb-check-experimental-flag t - "*Non-nil means to attempt to check the voice of the doc string. + "Non-nil means to attempt to check the voice of the doc string. This check keys off some words which are commonly misused. See the variable `checkdoc-common-verbs-wrong-voice' if you wish to add your own." :group 'checkdoc @@ -2633,12 +2641,6 @@ function called to create the messages." (setq checkdoc-pending-errors nil) nil))) -(defgroup checkdoc nil - "Support for doc string checking in Emacs Lisp." - :prefix "checkdoc" - :group 'lisp - :version "20.3") - (custom-add-option 'emacs-lisp-mode-hook (lambda () (checkdoc-minor-mode 1))) @@ -2650,5 +2652,5 @@ function called to create the messages." (provide 'checkdoc) -;;; arch-tag: c49a7ec8-3bb7-46f2-bfbc-d5f26e033b26 +;; arch-tag: c49a7ec8-3bb7-46f2-bfbc-d5f26e033b26 ;;; checkdoc.el ends here diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 8645ec5a6e..5107ee6027 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -2556,6 +2556,7 @@ MSG is printed after `::::} '." (edebug-outside-buffer (current-buffer)) (edebug-outside-point (point)) (edebug-outside-mark (edebug-mark)) + (edebug-outside-unread-command-events unread-command-events) edebug-outside-windows ; window or screen configuration edebug-buffer-points @@ -2574,6 +2575,7 @@ MSG is printed after `::::} '." (overlay-arrow-string overlay-arrow-string) (cursor-in-echo-area nil) (default-cursor-in-non-selected-windows t) + (unread-command-events unread-command-events) ;; any others?? ) (if (not (buffer-name edebug-buffer)) @@ -2662,6 +2664,7 @@ MSG is printed after `::::} '." (t (message ""))) + (setq unread-command-events nil) (if (eq 'after edebug-arg-mode) (progn ;; Display result of previous evaluation. @@ -2681,8 +2684,7 @@ MSG is printed after `::::} '." ((eq edebug-execution-mode 'trace) (edebug-sit-for edebug-sit-for-seconds)) ; Force update and pause. ((eq edebug-execution-mode 'Trace-fast) - (edebug-sit-for 0)) ; Force update and continue. - ) + (edebug-sit-for 0))) ; Force update and continue. (unwind-protect (if (or edebug-stop @@ -2778,6 +2780,7 @@ MSG is printed after `::::} '." (with-timeout-unsuspend edebug-with-timeout-suspend) ;; Reset global variables to outside values in case they were changed. (setq + unread-command-events edebug-outside-unread-command-events overlay-arrow-position edebug-outside-o-a-p overlay-arrow-string edebug-outside-o-a-s cursor-in-echo-area edebug-outside-c-i-e-a @@ -2868,7 +2871,6 @@ MSG is printed after `::::} '." (edebug-outside-last-input-event last-input-event) (edebug-outside-last-command-event last-command-event) - (edebug-outside-unread-command-events unread-command-events) (edebug-outside-last-event-frame last-event-frame) (edebug-outside-last-nonmenu-event last-nonmenu-event) (edebug-outside-track-mouse track-mouse) @@ -2890,7 +2892,6 @@ MSG is printed after `::::} '." ;; More for Emacs 19 (last-input-event nil) (last-command-event nil) - (unread-command-events nil) (last-event-frame nil) (last-nonmenu-event nil) (track-mouse nil) @@ -2950,7 +2951,6 @@ MSG is printed after `::::} '." last-command edebug-outside-last-command this-command edebug-outside-this-command unread-command-char edebug-outside-unread-command-char - unread-command-events edebug-outside-unread-command-events current-prefix-arg edebug-outside-current-prefix-arg last-input-char edebug-outside-last-input-char last-input-event edebug-outside-last-input-event diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index a98dd60fc2..82eac50c87 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -60,14 +60,22 @@ fire repeatedly that many seconds apart." (defun timer-set-idle-time (timer secs &optional repeat) "Set the trigger idle time of TIMER to SECS. +SECS may be an integer, floating point number, or the internal +time format (HIGH LOW USECS) returned by, e.g., `current-idle-time'. If optional third argument REPEAT is non-nil, make the timer fire each time Emacs is idle for that many seconds." (or (timerp timer) (error "Invalid timer")) - (aset timer 1 0) - (aset timer 2 0) - (aset timer 3 0) - (timer-inc-time timer secs) + (if (consp secs) + (progn (aset timer 1 (car secs)) + (aset timer 2 (if (consp (cdr secs)) (car (cdr secs)) (cdr secs))) + (aset timer 3 (or (and (consp (cdr secs)) (consp (cdr (cdr secs))) + (nth 2 secs)) + 0))) + (aset timer 1 0) + (aset timer 2 0) + (aset timer 3 0) + (timer-inc-time timer secs)) (aset timer 4 repeat) timer) @@ -104,7 +112,7 @@ of SECS seconds since the epoch. SECS may be a fraction." (defun timer-relative-time (time secs &optional usecs) "Advance TIME by SECS seconds and optionally USECS microseconds. -SECS may be a fraction." +SECS may be either an integer or a floating point number." (let ((high (car time)) (low (if (consp (cdr time)) (nth 1 time) (cdr time))) (micro (if (numberp (car-safe (cdr-safe (cdr time)))) @@ -412,7 +420,10 @@ This function is for compatibility; see also `run-with-timer'." (defun run-with-idle-timer (secs repeat function &rest args) "Perform an action the next time Emacs is idle for SECS seconds. The action is to call FUNCTION with arguments ARGS. -SECS may be an integer or a floating point number. +SECS may be an integer, a floating point number, or the internal +time format (HIGH LOW USECS) returned by, e.g., `current-idle-time'. +If Emacs is currently idle, and has been idle for N seconds (N < SECS), +then it will call FUNCTION in SECS - N seconds from now. If REPEAT is non-nil, do the action each time Emacs has been idle for exactly SECS seconds (that is, only once for each time Emacs becomes idle). @@ -425,7 +436,7 @@ This function returns a timer object which you can use in `cancel-timer'." (let ((timer (timer-create))) (timer-set-function timer function args) (timer-set-idle-time timer secs repeat) - (timer-activate-when-idle timer) + (timer-activate-when-idle timer t) timer)) (defun with-timeout-handler (tag) diff --git a/lisp/emacs-lisp/tq.el b/lisp/emacs-lisp/tq.el index 2126d7663f..1e1e143f0f 100644 --- a/lisp/emacs-lisp/tq.el +++ b/lisp/emacs-lisp/tq.el @@ -66,7 +66,7 @@ ;; regexp: regular expression that matches the end of a response from ;; the process (defun tq-queue-head-regexp (tq) (car (cdr (car (tq-queue tq))))) -;; closure: additional data to pass to function +;; closure: additional data to pass to the function (defun tq-queue-head-closure (tq) (car (cdr (cdr (car (tq-queue tq)))))) ;; fn: function to call upon receiving a complete response from the ;; process @@ -119,7 +119,7 @@ If DELAY-QUESTION is non-nil, delay sending this question until the process has finished replying to any previous questions. This produces more reliable results with some processes." (let ((sendp (or (not delay-question) - (not (tq-queue-head-question tq))))) + (not (tq-queue tq))))) (tq-queue-add tq (unless sendp question) regexp closure fn) (when sendp (process-send-string (tq-process tq) question)))) @@ -131,35 +131,39 @@ This produces more reliable results with some processes." (defun tq-filter (tq string) "Append STRING to the TQ's buffer; then process the new data." - (with-current-buffer (tq-buffer tq) - (goto-char (point-max)) - (insert string) - (tq-process-buffer tq))) + (let ((buffer (tq-buffer tq))) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (goto-char (point-max)) + (insert string) + (tq-process-buffer tq))))) (defun tq-process-buffer (tq) "Check TQ's buffer for the regexp at the head of the queue." - (set-buffer (tq-buffer tq)) - (if (= 0 (buffer-size)) () - (if (tq-queue-empty tq) - (let ((buf (generate-new-buffer "*spurious*"))) - (copy-to-buffer buf (point-min) (point-max)) - (delete-region (point-min) (point)) - (pop-to-buffer buf nil) - (error "Spurious communication from process %s, see buffer %s" - (process-name (tq-process tq)) - (buffer-name buf))) - (goto-char (point-min)) - (if (re-search-forward (tq-queue-head-regexp tq) nil t) - (let ((answer (buffer-substring (point-min) (point)))) - (delete-region (point-min) (point)) - (unwind-protect - (condition-case nil - (funcall (tq-queue-head-fn tq) - (tq-queue-head-closure tq) - answer) - (error nil)) - (tq-queue-pop tq)) - (tq-process-buffer tq)))))) + (let ((buffer (tq-buffer tq))) + (when (buffer-live-p buffer) + (set-buffer buffer) + (if (= 0 (buffer-size)) () + (if (tq-queue-empty tq) + (let ((buf (generate-new-buffer "*spurious*"))) + (copy-to-buffer buf (point-min) (point-max)) + (delete-region (point-min) (point)) + (pop-to-buffer buf nil) + (error "Spurious communication from process %s, see buffer %s" + (process-name (tq-process tq)) + (buffer-name buf))) + (goto-char (point-min)) + (if (re-search-forward (tq-queue-head-regexp tq) nil t) + (let ((answer (buffer-substring (point-min) (point)))) + (delete-region (point-min) (point)) + (unwind-protect + (condition-case nil + (funcall (tq-queue-head-fn tq) + (tq-queue-head-closure tq) + answer) + (error nil)) + (tq-queue-pop tq)) + (tq-process-buffer tq)))))))) (provide 'tq) diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index 0dce3b94ff..af757a2a55 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -46,6 +46,8 @@ (defvar mark-even-if-inactive) (defvar init-message) (defvar initial) +(defvar undo-beg-posn) +(defvar undo-end-posn) ;; loading happens only in non-interactive compilation ;; in order to spare non-viperized emacs from being viperized @@ -196,7 +198,7 @@ (viper-save-cursor-color 'before-insert-mode)) ;; set insert mode cursor color (viper-change-cursor-color viper-insert-state-cursor-color))) - (if (eq viper-current-state 'emacs-state) + (if (and viper-emacs-state-cursor-color (eq viper-current-state 'emacs-state)) (let ((has-saved-cursor-color-in-emacs-mode (stringp (viper-get-saved-cursor-color-in-emacs-mode)))) (or has-saved-cursor-color-in-emacs-mode @@ -722,12 +724,13 @@ (viper-set-replace-overlay (point-min) (point-min))) (viper-hide-replace-overlay) - (let ((has-saved-cursor-color-in-emacs-mode - (stringp (viper-get-saved-cursor-color-in-emacs-mode)))) - (or has-saved-cursor-color-in-emacs-mode - (string= (viper-get-cursor-color) viper-emacs-state-cursor-color) - (viper-save-cursor-color 'before-emacs-mode)) - (viper-change-cursor-color viper-emacs-state-cursor-color)) + (if viper-emacs-state-cursor-color + (let ((has-saved-cursor-color-in-emacs-mode + (stringp (viper-get-saved-cursor-color-in-emacs-mode)))) + (or has-saved-cursor-color-in-emacs-mode + (string= (viper-get-cursor-color) viper-emacs-state-cursor-color) + (viper-save-cursor-color 'before-emacs-mode)) + (viper-change-cursor-color viper-emacs-state-cursor-color))) (viper-change-state 'emacs-state) @@ -1030,10 +1033,13 @@ as a Meta key and any number of multiple escapes is allowed." (inhibit-quit t)) (if (viper-ESC-event-p event) (progn - ;; Emacs 22.50.8 introduced a bug, which makes even a single ESC into - ;; a fast keyseq. To guard against this, we added a check if there - ;; are other events as well - (if (and (viper-fast-keysequence-p) unread-command-events) + ;; Some versions of Emacs (eg., 22.50.8 have a bug, which makes even + ;; a single ESC into ;; a fast keyseq. To guard against this, we + ;; added a check if there are other events as well. Keep the next + ;; line for the next time the bug reappears, so that will remember to + ;; report it. + ;;(if (and (viper-fast-keysequence-p) unread-command-events) + (if (viper-fast-keysequence-p) ;; for Emacsen without the above bug (progn (let (minor-mode-map-alist emulation-mode-map-alists) (viper-set-unread-command-events event) @@ -1744,12 +1750,14 @@ invokes the command before that, etc." ;; Hook used in viper-undo (defun viper-after-change-undo-hook (beg end len) - (setq undo-beg-posn beg - undo-end-posn (or end beg)) - ;; some other hooks may be changing various text properties in - ;; the buffer in response to 'undo'; so remove this hook to avoid - ;; its repeated invocation - (remove-hook 'viper-undo-functions 'viper-after-change-undo-hook 'local)) + (if undo-in-progress + (setq undo-beg-posn beg + undo-end-posn (or end beg)) + ;; some other hooks may be changing various text properties in + ;; the buffer in response to 'undo'; so remove this hook to avoid + ;; its repeated invocation + (remove-hook 'viper-undo-functions 'viper-after-change-undo-hook 'local) + )) (defun viper-undo () "Undo previous change." @@ -1764,25 +1772,29 @@ invokes the command before that, etc." (undo-start) (undo-more 2) - (setq undo-beg-posn (or undo-beg-posn before-undo-pt) - undo-end-posn (or undo-end-posn undo-beg-posn)) + ;;(setq undo-beg-posn (or undo-beg-posn (point)) + ;; undo-end-posn (or undo-end-posn (point))) + ;;(setq undo-beg-posn (or undo-beg-posn before-undo-pt) + ;; undo-end-posn (or undo-end-posn undo-beg-posn)) - (goto-char undo-beg-posn) - (sit-for 0) - (if (and viper-keep-point-on-undo - (pos-visible-in-window-p before-undo-pt)) + (if (and undo-beg-posn undo-end-posn) (progn - (push-mark (point-marker) t) - (viper-sit-for-short 300) - (goto-char undo-end-posn) - (viper-sit-for-short 300) - (if (and (> (viper-chars-in-region undo-beg-posn before-undo-pt) 1) - (> (viper-chars-in-region undo-end-posn before-undo-pt) 1)) - (goto-char before-undo-pt) - (goto-char undo-beg-posn))) - (push-mark before-undo-pt t)) + (goto-char undo-beg-posn) + (sit-for 0) + (if (and viper-keep-point-on-undo + (pos-visible-in-window-p before-undo-pt)) + (progn + (push-mark (point-marker) t) + (viper-sit-for-short 300) + (goto-char undo-end-posn) + (viper-sit-for-short 300) + (if (pos-visible-in-window-p undo-beg-posn) + (goto-char before-undo-pt) + (goto-char undo-beg-posn))) + (push-mark before-undo-pt t)) + )) + (if (and (eolp) (not (bolp))) (backward-char 1)) - ;;(if (not modified) (set-buffer-modified-p t)) ) (setq this-command 'viper-undo)) @@ -3952,7 +3964,8 @@ Null string will repeat previous search." (let ((val (viper-p-val arg)) (com (viper-getcom arg)) debug-on-error) - (if (null viper-s-string) (error viper-NoPrevSearch)) + (if (or (null viper-s-string) (string= viper-s-string "")) + (error viper-NoPrevSearch)) (viper-search viper-s-string viper-s-forward arg) (if com (progn diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el index e2824246fa..f9f0803458 100644 --- a/lisp/emulation/viper-ex.el +++ b/lisp/emulation/viper-ex.el @@ -208,12 +208,12 @@ ;; If this is a one-letter magic command, splice in args. (defun ex-splice-args-in-1-letr-cmd (key list) - (let ((onelet (ex-cmd-is-one-letter (assoc (substring key 0 1) list)))) - (if onelet + (let ((oneletter (ex-cmd-is-one-letter (assoc (substring key 0 1) list)))) + (if oneletter (list key - (append (cadr onelet) + (append (cadr oneletter) (if (< 1 (length key)) (list (substring key 1)))) - (caddr onelet))) + (car (cdr (cdr oneletter))) )) )) diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el index 80938b0282..465f6e5cfb 100644 --- a/lisp/emulation/viper-init.el +++ b/lisp/emulation/viper-init.el @@ -434,7 +434,10 @@ delete the text being replaced, as in standard Vi." (if (fboundp 'make-variable-frame-local) (make-variable-frame-local 'viper-insert-state-cursor-color)) -(defcustom viper-emacs-state-cursor-color "Magenta" +;; viper-emacs-state-cursor-color doesn't work well. Causes cursor colors to be +;; confused in some cases. So, this var is nulled for now. +;; (defcustom viper-emacs-state-cursor-color "Magenta" +(defcustom viper-emacs-state-cursor-color nil "Cursor color when Viper is in emacs state." :type 'string :group 'viper) diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el index 252088a476..fe179be9cd 100644 --- a/lisp/emulation/viper-util.el +++ b/lisp/emulation/viper-util.el @@ -137,10 +137,10 @@ (x-display-color-p) ; emacs )) -(defsubst viper-get-cursor-color () +(defun viper-get-cursor-color (&optional frame) (viper-cond-compile-for-xemacs-or-emacs (color-instance-name - (frame-property (selected-frame) 'cursor-color)) ; xemacs + (frame-property (or frame (selected-frame)) 'cursor-color)) ; xemacs (cdr (assoc 'cursor-color (frame-parameters))) ; emacs )) @@ -152,18 +152,31 @@ ;; cursor colors -(defun viper-change-cursor-color (new-color) +(defun viper-change-cursor-color (new-color &optional frame) (if (and (viper-window-display-p) (viper-color-display-p) (stringp new-color) (viper-color-defined-p new-color) (not (string= new-color (viper-get-cursor-color)))) (viper-cond-compile-for-xemacs-or-emacs (set-frame-property - (selected-frame) 'cursor-color (make-color-instance new-color)) + (or frame (selected-frame)) + 'cursor-color (make-color-instance new-color)) (modify-frame-parameters - (selected-frame) (list (cons 'cursor-color new-color))) + (or frame (selected-frame)) + (list (cons 'cursor-color new-color))) ) )) +(defun viper-set-cursor-color-according-to-state (&optional frame) + (cond ((eq viper-current-state 'replace-state) + (viper-change-cursor-color viper-replace-state-cursor-color frame)) + ((and (eq viper-current-state 'emacs-state) + viper-emacs-state-cursor-color) + (viper-change-cursor-color viper-emacs-state-cursor-color frame)) + ((eq viper-current-state 'insert-state) + (viper-change-cursor-color viper-insert-state-cursor-color frame)) + (t + (viper-change-cursor-color viper-vi-state-cursor-color frame)))) + ;; By default, saves current frame cursor color in the ;; viper-saved-cursor-color-in-replace-mode property of viper-replace-overlay (defun viper-save-cursor-color (before-which-mode) @@ -191,7 +204,7 @@ (if viper-emacs-p 'frame-parameter 'frame-property) (selected-frame) 'viper-saved-cursor-color-in-replace-mode) - (if (eq viper-current-state 'emacs-mode) + (if (and (eq viper-current-state 'emacs-mode) viper-emacs-state-cursor-color) viper-emacs-state-cursor-color viper-vi-state-cursor-color))) @@ -201,7 +214,7 @@ (if viper-emacs-p 'frame-parameter 'frame-property) (selected-frame) 'viper-saved-cursor-color-in-insert-mode) - (if (eq viper-current-state 'emacs-mode) + (if (and (eq viper-current-state 'emacs-mode) viper-emacs-state-cursor-color) viper-emacs-state-cursor-color viper-vi-state-cursor-color))) diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index 8f858526da..0ba7bdd041 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -534,10 +534,6 @@ If Viper is enabled, turn it off. Otherwise, turn it on." (defun viper-mode () "Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Viper'." (interactive) - (if (null viper-vi-state-cursor-color) - (modify-frame-parameters - (selected-frame) - (list (cons 'viper-vi-state-cursor-color (viper-get-cursor-color))))) (if (not noninteractive) (progn ;; if the user requested viper-mode explicitly @@ -618,7 +614,8 @@ This startup message appears whenever you load Viper, unless you type `y' now." (or (memq major-mode viper-emacs-state-mode-list) ; don't switch to Vi (memq major-mode viper-insert-state-mode-list) ; don't switch - (viper-change-state-to-vi))))) + (viper-change-state-to-vi)) + ))) ;; Apply a little heuristic to invoke vi state on major-modes @@ -862,8 +859,11 @@ It also can't undo some Viper settings." ;; info about the display and windows until emacs initialization is complete ;; So do it via the window-setup-hook (add-hook 'window-setup-hook - '(lambda () - (setq viper-vi-state-cursor-color (viper-get-cursor-color)))) + '(lambda () + (modify-frame-parameters + (selected-frame) + (list (cons 'viper-vi-state-cursor-color + (viper-get-cursor-color)))))) ;; Tell vc-diff to put *vc* in Vi mode (if (featurep 'vc) @@ -903,7 +903,6 @@ It also can't undo some Viper settings." (defadvice set-cursor-color (after viper-set-cursor-color-ad activate) "Change cursor color in VI state." - ;;(setq viper-vi-state-cursor-color (ad-get-arg 0)) (modify-frame-parameters (selected-frame) (list (cons 'viper-vi-state-cursor-color (ad-get-arg 0)))) @@ -1008,8 +1007,8 @@ It also can't undo some Viper settings." ;; these are primarily advices and Vi-ish variable settings (defun viper-non-hook-settings () - ;; Viper changes the default mode-line-buffer-identification - (setq-default mode-line-buffer-identification '(" %b")) + ;;;; Viper changes the default mode-line-buffer-identification + ;;(setq-default mode-line-buffer-identification '(" %b")) ;; setup emacs-supported vi-style feel (setq next-line-add-newlines nil diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog index 216d14d0aa..72754aa1cd 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog @@ -1,3 +1,78 @@ +2006-08-13 Romain Francoise <[email protected]> + + * erc-match.el (erc-log-matches-make-buffer): End `y-or-n-p' + prompt with a space. + +2006-08-07 Michael Olson <[email protected]> + + * erc-backend.el (erc-process-sentinel-1): Use erc-display-message + in several places instead of inserting text. + (erc-process-sentinel): Move to the input-marker before removing + the prompt. + + * erc.el (erc-port): Fix customization options. + (erc-display-message): Handle null type explicitly. Previously, + this was relying on a chance side-effect. Cosmetic indentation + tweak. + (english): Add 'finished and 'terminated entries to the catalog. + Add initial and terminal newlines to 'disconnected and + 'disconnected-noreconnect entries. Avoid long lines. + +2006-08-06 Michael Olson <[email protected]> + + * erc.el (erc-arrange-session-in-multiple-windows): Fix bug with + multi-tty Emacs. + (erc-select-startup-file): Fix bug introduced by recent change. + +2006-08-05 Michael Olson <[email protected]> + + * erc-log.el (erc-log-standardize-name): New function that returns + a filename that is safe for use for a log file. + (erc-current-logfile): Use it. + + * erc.el (erc-startup-file-list): Search in ~/.emacs.d first, + since that is a fairly standard directory. + (erc-select-startup-file): Re-write to use + convert-standard-filename, which will ensure that MS-DOS systems + look for the _ercrc.el file. + +2006-08-02 Michael Olson <[email protected]> + + * erc.el (erc-version-string): Release ERC 5.1.4. + + * Makefile, NEWS, erc.texi: Update for the 5.1.4 release. + + * erc.el (erc-active-buffer): Fix bug that caused messages to go + to the wrong buffer. Thanks to offby1 for the report. + + * erc-backend.el (erc-coding-system-for-target): Handle case where + target is nil. Thanks to Kai Fan for the patch. + +2006-07-29 Michael Olson <[email protected]> + + * erc-log.el (erc-log-setup-logging): Don't offer to save the + buffer. It will be saved automatically killed. Thanks to Johan + Bockgård and Tassilo Horn for pointing this out. + +2006-07-27 Johan Bockgård <[email protected]> + + * erc.el (define-erc-module): Make find-function and find-variable + find the names constructed by `define-erc-module' in Emacs 22. + +2006-07-14 Michael Olson <[email protected]> + + * erc-log.el (log): Make sure that we enable logging on + already-opened buffers as well, in case the user toggles this + module after loading ERC. Also be sure to remove logging ability + from all ERC buffers when the module is disabled. + (erc-log-setup-logging): Set buffer-file-name to nil rather than + the empty string. This should fix some errors that occur when + quitting Emacs without first killing all ERC buffers. + (erc-log-disable-logging): New function that removes the logging + ability from the current buffer. + + * erc-spelling.el (spelling): Use dolist and buffer-live-p. + 2006-07-12 Michael Olson <[email protected]> * erc-match.el (erc-log-matches): Bind inhibit-read-only rather diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 7dce9e4bf0..5acbcb05ab 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -493,11 +493,7 @@ action." (if erc-server-quitting ;; normal quit (progn - (let ((string "\n\n*** ERC finished ***\n") - (inhibit-read-only t)) - (erc-put-text-property 0 (length string) - 'face 'erc-error-face string) - (insert string)) + (erc-display-message nil 'error (current-buffer) 'finished) (when erc-kill-server-buffer-on-quit (set-buffer-modified-p nil) (kill-buffer (current-buffer)))) @@ -519,12 +515,8 @@ action." (erc erc-session-server erc-session-port erc-server-current-nick erc-session-user-full-name t erc-session-password) ;; terminate, do not reconnect - (let ((string (concat "\n\n*** ERC terminated: " event - "\n")) - (inhibit-read-only t)) - (erc-put-text-property 0 (length string) - 'face 'erc-error-face string) - (insert string))))) + (erc-display-message nil 'error (current-buffer) + 'terminated ?e event)))) (defun erc-process-sentinel (cproc event) "Sentinel function for ERC process." @@ -545,6 +537,7 @@ action." (run-hook-with-args 'erc-disconnected-hook (erc-current-nick) (system-name) "") ;; Remove the prompt + (goto-char (or (marker-position erc-input-marker) (point-max))) (forward-line 0) (erc-remove-text-properties-region (point) (point-max)) (delete-region (point) (point-max)) @@ -563,11 +556,12 @@ action." "Return the coding system or cons cell appropriate for TARGET. This is determined via `erc-encoding-coding-alist' or `erc-server-coding-system'." - (or (let ((case-fold-search t)) - (catch 'match - (dolist (pat erc-encoding-coding-alist) - (when (string-match (car pat) target) - (throw 'match (cdr pat)))))) + (or (when target + (let ((case-fold-search t)) + (catch 'match + (dolist (pat erc-encoding-coding-alist) + (when (string-match (car pat) target) + (throw 'match (cdr pat))))))) (and (functionp erc-server-coding-system) (funcall erc-server-coding-system)) erc-server-coding-system)) diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el index b316a8588b..2fe29e82fe 100644 --- a/lisp/erc/erc-log.el +++ b/lisp/erc/erc-log.el @@ -71,8 +71,6 @@ ;; markers. ;;; TODO: -;; * Erc needs a generalised make-safe-file-name function, so that -;; generated file names don't contain any invalid file characters. ;; ;; * Really, we need to lock the logfiles somehow, so that if a user ;; is running multiple emacsen and/or on the same channel as more @@ -218,7 +216,10 @@ also be a predicate function. To only log when you are not set away, use: (add-hook 'erc-quit-hook 'erc-conditional-save-queries) (add-hook 'erc-part-hook 'erc-conditional-save-buffer) ;; append, so that 'erc-initialize-log-marker runs first - (add-hook 'erc-connect-pre-hook 'erc-log-setup-logging 'append)) + (add-hook 'erc-connect-pre-hook 'erc-log-setup-logging 'append) + (dolist (buffer (erc-buffer-list)) + (when (buffer-live-p buffer) + (with-current-buffer buffer (erc-log-setup-logging))))) ;; disable ((remove-hook 'erc-insert-post-hook 'erc-save-buffer-in-logs) (remove-hook 'erc-send-post-hook 'erc-save-buffer-in-logs) @@ -226,7 +227,10 @@ also be a predicate function. To only log when you are not set away, use: (remove-hook 'erc-kill-channel-hook 'erc-save-buffer-in-logs) (remove-hook 'erc-quit-hook 'erc-conditional-save-queries) (remove-hook 'erc-part-hook 'erc-conditional-save-buffer) - (remove-hook 'erc-connect-pre-hook 'erc-log-setup-logging))) + (remove-hook 'erc-connect-pre-hook 'erc-log-setup-logging) + (dolist (buffer (erc-buffer-list)) + (when (buffer-live-p buffer) + (with-current-buffer buffer (erc-log-disable-logging)))))) (define-key erc-mode-map "\C-c\C-l" 'erc-save-buffer-in-logs) @@ -236,8 +240,7 @@ also be a predicate function. To only log when you are not set away, use: This function is destined to be run from `erc-connect-pre-hook'." (when (erc-logging-enabled) (auto-save-mode -1) - (setq buffer-offer-save t - buffer-file-name "") + (setq buffer-file-name nil) (set (make-local-variable 'write-file-functions) '(erc-save-buffer-in-logs)) (when erc-log-insert-log-on-open @@ -245,6 +248,12 @@ This function is destined to be run from `erc-connect-pre-hook'." (move-marker erc-last-saved-position (1- (point-max))))))) +(defun erc-log-disable-logging () + "Disable logging in the current buffer." + (when (erc-logging-enabled) + (setq buffer-offer-save nil + erc-enable-logging nil))) + (defun erc-log-all-but-server-buffers (buffer) "Returns t if logging should be enabled in BUFFER. Returns nil iff `erc-server-buffer-p' returns t." @@ -282,17 +291,27 @@ is writeable (it will be created as necessary) and (funcall erc-enable-logging (or buffer (current-buffer))) erc-enable-logging))) +(defun erc-log-standardize-name (filename) + "Make FILENAME safe to use as the name of an ERC log. +This will not work with full paths, only names. + +Any unsafe characters in the name are replaced with \"!\". The +filename is downcased." + (downcase (erc-replace-regexp-in-string + "[/\\]" "!" (convert-standard-filename filename)))) + (defun erc-current-logfile (&optional buffer) "Return the logfile to use for BUFFER. If BUFFER is nil, the value of `current-buffer' is used. This is determined by `erc-generate-log-file-name-function'. The result is converted to lowercase, as IRC is case-insensitive" (expand-file-name - (downcase (funcall erc-generate-log-file-name-function - (or buffer (current-buffer)) - (or (erc-default-target) (buffer-name buffer)) - (erc-current-nick) - erc-session-server erc-session-port)) + (erc-log-standardize-name + (funcall erc-generate-log-file-name-function + (or buffer (current-buffer)) + (or (erc-default-target) (buffer-name buffer)) + (erc-current-nick) + erc-session-server erc-session-port)) erc-log-channels-directory)) (defun erc-generate-log-file-name-with-date (buffer &rest ignore) diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index ffbc7482aa..b5dc913a8c 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -566,7 +566,7 @@ deactivate/activate match logging in the latter. See (unless buffer-already (insert " == Type \"q\" to dismiss messages ==\n") (erc-view-mode-enter nil (lambda (buffer) - (when (y-or-n-p "Discard messages?") + (when (y-or-n-p "Discard messages? ") (kill-buffer buffer))))) buffer))) diff --git a/lisp/erc/erc-spelling.el b/lisp/erc/erc-spelling.el index 3cbc786274..7ed0f51053 100644 --- a/lisp/erc/erc-spelling.el +++ b/lisp/erc/erc-spelling.el @@ -40,15 +40,13 @@ ;; Use erc-connect-pre-hook instead of erc-mode-hook as pre-hook is ;; called AFTER the server buffer is initialized. ((add-hook 'erc-connect-pre-hook 'erc-spelling-init) - (mapc (lambda (buffer) - (when buffer - (with-current-buffer buffer (erc-spelling-init)))) - (erc-buffer-list))) + (dolist (buffer (erc-buffer-list)) + (when (buffer-live-p buffer) + (with-current-buffer buffer (erc-spelling-init))))) ((remove-hook 'erc-connect-pre-hook 'erc-spelling-init) - (mapc (lambda (buffer) - (when buffer - (with-current-buffer buffer (flyspell-mode 0)))) - (erc-buffer-list)))) + (dolist (buffer (erc-buffer-list)) + (when (buffer-live-p buffer) + (with-current-buffer buffer (flyspell-mode 0)))))) (defcustom erc-spelling-dictionaries nil "An alist mapping buffer names to dictionaries. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index fd5a49eae4..41d5957625 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -67,7 +67,7 @@ ;;; Code: -(defconst erc-version-string "Version 5.1.3" +(defconst erc-version-string "Version 5.1.4" "ERC version. This is used by function `erc-version'.") (eval-when-compile (require 'cl)) @@ -157,8 +157,8 @@ parameters and authentication." This can be either a string or a number." :group 'erc :type '(choice (const :tag "None" nil) - (const :tag "Port number" number) - (const :tag "Port string" string))) + (integer :tag "Port number") + (string :tag "Port string"))) (defcustom erc-nick nil "Nickname to use if one is not provided. @@ -822,7 +822,8 @@ See `erc-server-flood-margin' for other flood-related parameters.") ;; Script parameters (defcustom erc-startup-file-list - '("~/.ercrc.el" "~/.ercrc" ".ercrc.el" ".ercrc") + '("~/.emacs.d/.ercrc.el" "~/.emacs.d/.ercrc" + "~/.ercrc.el" "~/.ercrc" ".ercrc.el" ".ercrc") "List of files to try for a startup script. The first existent and readable one will get executed. @@ -1243,7 +1244,11 @@ With arg, turn ERC %S mode on if and only if arg is positive. (format "erc-%s-mode" (downcase (symbol-name alias))))) (quote - ,mode)))))) + ,mode))) + ;; For find-function and find-variable. + (put ',mode 'definition-name ',name) + (put ',enable 'definition-name ',name) + (put ',disable 'definition-name ',name)))) (put 'define-erc-module 'doc-string-elt 3) @@ -1388,8 +1393,8 @@ server buffer") Defaults to the server buffer." (with-current-buffer (erc-server-buffer) (if (buffer-live-p erc-active-buffer) - erc-active-buffer) - (setq erc-active-buffer (current-buffer)))) + erc-active-buffer + (setq erc-active-buffer (current-buffer))))) (defun erc-set-active-buffer (buffer) "Set the value of `erc-active-buffer' to BUFFER." @@ -2358,6 +2363,8 @@ See also `erc-format-message' and `erc-display-line'." msg))) (setq string (cond + ((null type) + string) ((listp type) (mapc (lambda (type) (setq string @@ -2370,7 +2377,7 @@ See also `erc-format-message' and `erc-display-line'." (if (not (erc-response-p parsed)) (erc-display-line string buffer) (unless (member (erc-response.command parsed) erc-hide-list) - (erc-put-text-property 0 (length string) 'erc-parsed parsed string) + (erc-put-text-property 0 (length string) 'erc-parsed parsed string) (erc-put-text-property 0 (length string) 'rear-sticky t string) (erc-display-line string buffer))))) @@ -5237,13 +5244,11 @@ If FILE is found, return the path to it." (defun erc-select-startup-file () "Select an ERC startup file. See also `erc-startup-file-list'." - (let ((l erc-startup-file-list) - (f nil)) - (while (and (not f) l) - (if (file-readable-p (car l)) - (setq f (car l))) - (setq l (cdr l))) - f)) + (catch 'found + (dolist (f erc-startup-file-list) + (setq f (convert-standard-filename f)) + (when (file-readable-p f) + (throw 'found f))))) (defun erc-find-script-file (file) "Search for FILE in `default-directory', and any in `erc-script-path'." @@ -5890,7 +5895,8 @@ All windows are opened in the current frame." (setq bufs (cdr bufs)) (while bufs (split-window) - (switch-to-buffer-other-window (car bufs)) + (other-window 1) + (switch-to-buffer (car bufs)) (setq bufs (cdr bufs)) (balance-windows))))) @@ -5942,12 +5948,17 @@ All windows are opened in the current frame." (ctcp-request-to . "==> CTCP request from %n (%u@%h) to %t: %r") (ctcp-too-many . "Too many CTCP queries in single message. Ignoring") (flood-ctcp-off . "FLOOD PROTECTION: Automatic CTCP responses turned off.") - (flood-strict-mode . "FLOOD PROTECTION: Switched to Strict Flood Control mode.") - (disconnected . "Connection failed! Re-establishing connection...") - (disconnected-noreconnect . "Connection failed! Not re-establishing connection.") + (flood-strict-mode + . "FLOOD PROTECTION: Switched to Strict Flood Control mode.") + (disconnected . "\n\nConnection failed! Re-establishing connection...\n") + (disconnected-noreconnect + . "\n\nConnection failed! Not re-establishing connection.\n") + (finished . "\n\n*** ERC finished ***\n") + (terminated . "\n\n*** ERC terminated: %e\n") (login . "Logging in as \'%n\'...") (nick-in-use . "%n is in use. Choose new nickname: ") - (nick-too-long . "WARNING: Nick length (%i) exceeds max NICKLEN(%l) defined by server") + (nick-too-long + . "WARNING: Nick length (%i) exceeds max NICKLEN(%l) defined by server") (no-default-channel . "No default channel") (no-invitation . "You've got no invitation") (no-target . "No target") diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el index 76bde7784d..c700d5d7f6 100644 --- a/lisp/eshell/em-glob.el +++ b/lisp/eshell/em-glob.el @@ -97,7 +97,7 @@ This option slows down recursive glob processing by quite a bit." :type 'boolean :group 'eshell-glob) -(defcustom eshell-glob-chars-list '(?\] ?\[ ?* ?? ?~ ?\( ?\) ?| ?#) +(defcustom eshell-glob-chars-list '(?\] ?\[ ?* ?? ?~ ?\( ?\) ?| ?# ?^) "*List of additional characters used in extended globbing." :type '(repeat character) :group 'eshell-glob) @@ -105,6 +105,7 @@ This option slows down recursive glob processing by quite a bit." (defcustom eshell-glob-translate-alist '((?\] . "]") (?\[ . "[") + (?^ . "^") (?? . ".") (?* . ".*") (?~ . "~") diff --git a/lisp/facemenu.el b/lisp/facemenu.el index a8d8ea9a4b..eaaf4dacd7 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el @@ -134,18 +134,24 @@ just before \"Other\" at the end." (defcustom facemenu-listed-faces nil "*List of faces to include in the Face menu. -Each element should be a symbol, which is the name of a face. +Each element should be a symbol, the name of a face. The \"basic \" faces in `facemenu-keybindings' are automatically -added to the Face menu, and are not included in this list. - -You can set this list before loading facemenu.el, or add a face to it before -creating that face if you want it to be listed. If you change the -variable so as to eliminate faces that have already been added to the menu, -call `facemenu-update' to recalculate the menu contents. - -If this variable is t, all faces will be added to the menu. This -is useful for setting temporarily if you want to add faces to the -menu when they are created." +added to the Face menu, and need not be in this list. + +This value takes effect when you load facemenu.el. If the +list includes symbols which are not defined as faces, they +are ignored; however, subsequently defining or creating +those faces adds them to the menu then. You can call +`facemenu-update' to recalculate the menu contents, such as +if you change the value of this variable, + +If this variable is t, all faces that you apply to text +using the face menu commands (even by name), and all faces +that you define or create, are added to the menu. You may +find it useful to set this variable to t temporarily while +you define some faces, so that they will be added. However, +if the value is no longer t and you call `facemenu-update', +it will remove any faces not explicitly in the list." :type '(choice (const :tag "List all faces" t) (const :tag "None" nil) (repeat symbol)) @@ -320,19 +326,24 @@ variables." ;;;###autoload (defun facemenu-set-face (face &optional start end) - "Add FACE to the region or next character typed. -This adds FACE to the top of the face list; any faces lower on the list that -will not show through at all will be removed. - -Interactively, reads the face name with the minibuffer. - -If the region is active (normally true except in Transient Mark mode) -and there is no prefix argument, this command sets the region to the -requested face. - -Otherwise, this command specifies the face for the next character -inserted. Moving point or switching buffers before -typing a character to insert cancels the specification." + "Apply FACE to the region or next character typed. + +If the region is active (normally true except in Transient +Mark mode) and nonempty, and there is no prefix argument, +this command applies FACE to the region. Otherwise, it applies FACE +to the faces to use for the next character +inserted. (Moving point or switching buffers before typing +a character to insert cancels the specification.) + +If FACE is `default', to \"apply\" it means clearing +the list of faces to be used. For any other value of FACE, +to \"apply\" it means putting FACE at the front of the list +of faces to be used, and removing any faces further +along in the list that would be completely overridden by +preceding faces (including FACE). + +This command can also add FACE to the menu of faces, +if `facemenu-listed-faces' says to do that." (interactive (list (progn (barf-if-buffer-read-only) (read-face-name "Use face")) @@ -612,7 +623,12 @@ effect. See `facemenu-remove-face-function'." (cons face (if (listp prev) prev - (list prev))))))) + (list prev))) + ;; Specify the selected frame + ;; because nil would mean to use + ;; the new-frame default settings, + ;; and those are usually nil. + (selected-frame))))) (setq part-start part-end))) (setq self-insert-face (if (eq last-command self-insert-face-command) (cons face (if (listp self-insert-face) @@ -655,9 +671,8 @@ use the selected frame. If t, then the global, non-frame faces are used." (nreverse active-list))) (defun facemenu-add-new-face (face) - "Add FACE (a face) to the Face menu. - -This is called whenever you create a new face." + "Add FACE (a face) to the Face menu if `facemenu-listed-faces' says so. +This is called whenever you create a new face, and at other times." (let* (name symbol menu docstring diff --git a/lisp/faces.el b/lisp/faces.el index f501e0054d..c893e47ca7 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2075,7 +2075,7 @@ terminal type to a different value." ;; red4 is too dark, but some say blue is too loud. ;; brown seems to work ok. -- rms. (t :foreground "brown")) - "Face for characters displayed as ^-sequences or \-sequences." + "Face for characters displayed as sequences using `^' or `\\'." :group 'basic-faces :version "22.1") diff --git a/lisp/files.el b/lisp/files.el index 2b1446683b..e099d30a01 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -540,13 +540,21 @@ is a valid DOS file name, but c:/bar/c:/foo is not. This function's standard definition is trivial; it just returns the argument. However, on Windows and DOS, replace invalid -characters. On DOS, make sure to obey the 8.3 limitations. On -Windows, turn Cygwin names into native names, and also turn -slashes into backslashes if the shell requires it (see +characters. On DOS, make sure to obey the 8.3 limitations. +In the native Windows build, turn Cygwin names into native names, +and also turn slashes into backslashes if the shell requires it (see `w32-shell-dos-semantics'). See Info node `(elisp)Standard File Names' for more details." - filename) + (if (eq system-type 'cygwin) + (let ((name (copy-sequence filename)) + (start 0)) + ;; Replace invalid filename characters with ! + (while (string-match "[?*:<>|\"\000-\037]" name start) + (aset name (match-beginning 0) ?!) + (setq start (match-end 0))) + name) + filename)) (defun read-directory-name (prompt &optional dir default-dirname mustmatch initial) "Read directory name, prompting with PROMPT and completing in directory DIR. @@ -4369,7 +4377,7 @@ See also `auto-save-file-name-p'." "#"))) ;; Make sure auto-save file names don't contain characters ;; invalid for the underlying filesystem. - (if (and (memq system-type '(ms-dos windows-nt)) + (if (and (memq system-type '(ms-dos windows-nt cygwin)) ;; Don't modify remote (ange-ftp) filenames (not (string-match "^/\\w+@[-A-Za-z0-9._]+:" result))) (convert-standard-filename result) @@ -4404,7 +4412,7 @@ See also `auto-save-file-name-p'." ((file-writable-p default-directory) default-directory) ((file-writable-p "/var/tmp/") "/var/tmp/") ("~/"))))) - (if (and (memq system-type '(ms-dos windows-nt)) + (if (and (memq system-type '(ms-dos windows-nt cygwin)) ;; Don't modify remote (ange-ftp) filenames (not (string-match "^/\\w+@[-A-Za-z0-9._]+:" fname))) ;; The call to convert-standard-filename is in case diff --git a/lisp/filesets.el b/lisp/filesets.el index 4ca5a9d142..eb8cdb0261 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -1798,7 +1798,7 @@ User will be queried, if no fileset name is provided." filesets-data nil))) (entry (or (assoc name filesets-data) (when (y-or-n-p - (format "Fileset %s does not exist. Create it?" + (format "Fileset %s does not exist. Create it? " name)) (progn (add-to-list 'filesets-data (list name '(:files))) diff --git a/lisp/font-core.el b/lisp/font-core.el index d2cb8dccd1..85bbf60f0d 100644 --- a/lisp/font-core.el +++ b/lisp/font-core.el @@ -83,34 +83,6 @@ where MAJOR-MODE is a symbol and FONT-LOCK-DEFAULTS is a list of default settings. See the variable `font-lock-defaults', which takes precedence.") (make-obsolete-variable 'font-lock-defaults-alist 'font-lock-defaults) -(defvar font-lock-extend-region-function nil - "A function that determines the region to fontify after a change. - -This buffer-local variable is either nil, or is a function that determines the -region to fontify. It is usually set by the major mode. The currently active -font-lock after-change function calls this function after each buffer change. - -The function is given three parameters, the standard BEG, END, and OLD-LEN -from after-change-functions. It should return either a cons of the beginning -and end buffer positions \(in that order) of the region to fontify, or nil -\(which directs the caller to fontify a default region). This function need -not preserve point or the match-data, but must preserve the current -restriction. The region it returns may start or end in the middle of a -line.") -(make-variable-buffer-local 'font-lock-extend-region-function) - -(defun font-lock-extend-region (beg end old-len) - "Determine the region to fontify after a buffer change. - -BEG END and OLD-LEN are the standard parameters from after-change-functions. -The return value is either nil \(which directs the caller to chose the region -itself), or a cons of the beginning and end \(in that order) of the region. -The region returned may start or end in the middle of a line." - (if font-lock-extend-region-function - (save-match-data - (save-excursion - (funcall font-lock-extend-region-function beg end old-len))))) - (defvar font-lock-function 'font-lock-default-function "A function which is called when `font-lock-mode' is toggled. It will be passed one argument, which is the current value of diff --git a/lisp/font-lock.el b/lisp/font-lock.el index f001a0bfaa..093780c391 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -893,7 +893,11 @@ The value of this variable is used when Font Lock mode is turned on." (set (make-local-variable 'font-lock-fontified) t) ;; Use jit-lock. (jit-lock-register 'font-lock-fontify-region - (not font-lock-keywords-only)))))) + (not font-lock-keywords-only)) + ;; Tell jit-lock how we extend the region to refontify. + (add-hook 'jit-lock-after-change-extend-region-functions + 'font-lock-extend-jit-lock-region-after-change + nil t))))) (defun font-lock-turn-off-thing-lock () (cond ((and (boundp 'fast-lock-mode) fast-lock-mode) @@ -971,6 +975,21 @@ The value of this variable is used when Font Lock mode is turned on." ;; directives correctly and cleanly. (It is the same problem as fontifying ;; multi-line strings and comments; regexps are not appropriate for the job.) +(defvar font-lock-extend-after-change-region-function nil + "A function that determines the region to refontify after a change. + +This variable is either nil, or is a function that determines the +region to refontify after a change. +It is usually set by the major mode via `font-lock-defaults'. +Font-lock calls this function after each buffer change. + +The function is given three parameters, the standard BEG, END, and OLD-LEN +from `after-change-functions'. It should return either a cons of the beginning +and end buffer positions \(in that order) of the region to refontify, or nil +\(which directs the caller to fontify a default region). +This function should preserve the match-data. +The region it returns may start or end in the middle of a line.") + (defun font-lock-fontify-buffer () "Fontify the current buffer the way the function `font-lock-mode' would." (interactive) @@ -1021,6 +1040,59 @@ The value of this variable is used when Font Lock mode is turned on." Useful for things like RMAIL and Info where the whole buffer is not a very meaningful entity to highlight.") + +(defvar font-lock-beg) (defvar font-lock-end) +(defvar font-lock-extend-region-functions + '(font-lock-extend-region-wholelines + ;; This use of font-lock-multiline property is unreliable but is just + ;; a handy heuristic: in case you don't have a function that does + ;; /identification/ of multiline elements, you may still occasionally + ;; discover them by accident (or you may /identify/ them but not in all + ;; cases), in which case the font-lock-multiline property can help make + ;; sure you will properly *re*identify them during refontification. + font-lock-extend-region-multiline) + "Special hook run just before proceeding to fontify a region. +This is used to allow major modes to help font-lock find safe buffer positions +as beginning and end of the fontified region. Its most common use is to solve +the problem of /identification/ of multiline elements by providing a function +that tries to find such elements and move the boundaries such that they do +not fall in the middle of one. +Each function is called with no argument; it is expected to adjust the +dynamically bound variables `font-lock-beg' and `font-lock-end'; and return +non-nil iff it did make such an adjustment. +These functions are run in turn repeatedly until they all return nil. +Put first the functions more likely to cause a change and cheaper to compute.") +;; Mark it as a special hook which doesn't use any global setting +;; (i.e. doesn't obey the element t in the buffer-local value). +(make-variable-buffer-local 'font-lock-extend-region-functions) + +(defun font-lock-extend-region-multiline () + "Move fontification boundaries away from any `font-lock-multiline' property." + (let ((changed nil)) + (when (and (> font-lock-beg (point-min)) + (get-text-property (1- font-lock-beg) 'font-lock-multiline)) + (setq changed t) + (setq font-lock-beg (or (previous-single-property-change + font-lock-beg 'font-lock-multiline) + (point-min)))) + ;; + (when (get-text-property font-lock-end 'font-lock-multiline) + (setq changed t) + (setq font-lock-end (or (text-property-any font-lock-end (point-max) + 'font-lock-multiline nil) + (point-max)))) + changed)) + + +(defun font-lock-extend-region-wholelines () + "Move fontification boundaries to beginning of lines." + (let ((changed nil)) + (goto-char font-lock-beg) + (unless (bolp) (setq changed t font-lock-beg (line-beginning-position))) + (goto-char font-lock-end) + (unless (bolp) (setq changed t font-lock-end (line-beginning-position 2))) + changed)) + (defun font-lock-default-fontify-region (beg end loudly) (save-buffer-state ((parse-sexp-lookup-properties @@ -1032,24 +1104,21 @@ a very meaningful entity to highlight.") ;; Use the fontification syntax table, if any. (when font-lock-syntax-table (set-syntax-table font-lock-syntax-table)) - (goto-char beg) - (setq beg (line-beginning-position)) - ;; check to see if we should expand the beg/end area for - ;; proper multiline matches - (when (and (> beg (point-min)) - (get-text-property (1- beg) 'font-lock-multiline)) - ;; We are just after or in a multiline match. - (setq beg (or (previous-single-property-change - beg 'font-lock-multiline) - (point-min))) - (goto-char beg) - (setq beg (line-beginning-position))) - (setq end (or (text-property-any end (point-max) - 'font-lock-multiline nil) - (point-max))) - (goto-char end) - ;; Round up to a whole line. - (unless (bolp) (setq end (line-beginning-position 2))) + ;; Extend the region to fontify so that it starts and ends at + ;; safe places. + (let ((funs font-lock-extend-region-functions) + (font-lock-beg beg) + (font-lock-end end)) + (while funs + (setq funs (if (or (not (funcall (car funs))) + (eq funs font-lock-extend-region-functions)) + (cdr funs) + ;; If there's been a change, we should go through + ;; the list again since this new position may + ;; warrant a different answer from one of the fun + ;; we've already seen. + font-lock-extend-region-functions))) + (setq beg font-lock-beg end font-lock-end)) ;; Now do the fontification. (font-lock-unfontify-region beg end) (when font-lock-syntactic-keywords @@ -1083,19 +1152,77 @@ what properties to clear before refontifying a region.") ;; Called when any modification is made to buffer text. (defun font-lock-after-change-function (beg end old-len) - (let ((inhibit-point-motion-hooks t) - (inhibit-quit t) - (region (font-lock-extend-region beg end old-len))) - (save-excursion + (save-excursion + (let ((inhibit-point-motion-hooks t) + (inhibit-quit t) + (region (if font-lock-extend-after-change-region-function + (funcall font-lock-extend-after-change-region-function + beg end old-len)))) (save-match-data (if region ;; Fontify the region the major mode has specified. (setq beg (car region) end (cdr region)) ;; Fontify the whole lines which enclose the region. - (setq beg (progn (goto-char beg) (line-beginning-position)) - end (progn (goto-char end) (line-beginning-position 2)))) + ;; Actually, this is not needed because + ;; font-lock-default-fontify-region already rounds up to a whole + ;; number of lines. + ;; (setq beg (progn (goto-char beg) (line-beginning-position)) + ;; end (progn (goto-char end) (line-beginning-position 2))) + ) (font-lock-fontify-region beg end))))) +(defvar jit-lock-start) (defvar jit-lock-end) +(defun font-lock-extend-jit-lock-region-after-change (beg end old-len) + "Function meant for `jit-lock-after-change-extend-region-functions'. +This function does 2 things: +- extend the region so that it not only includes the part that was modified + but also the surrounding text whose highlighting may change as a consequence. +- anticipate (part of) the region extension that will happen later in + `font-lock-default-fontify-region', in order to avoid the need for + double-redisplay in `jit-lock-fontify-now'." + (save-excursion + ;; First extend the region as font-lock-after-change-function would. + (let ((region (if font-lock-extend-after-change-region-function + (funcall font-lock-extend-after-change-region-function + beg end old-len)))) + (if region + (setq beg (min jit-lock-start (car region)) + end (max jit-lock-end (cdr region)))) + ;; Then extend the region obeying font-lock-multiline properties, + ;; indicating which part of the buffer needs to be refontified. + ;; !!! This is the *main* user of font-lock-multiline property !!! + ;; font-lock-after-change-function could/should also do that, but it + ;; doesn't need to because font-lock-default-fontify-region does + ;; it anyway. Here OTOH we have no guarantee that + ;; font-lock-default-fontify-region will be executed on this region + ;; any time soon. + ;; Note: contrary to font-lock-default-fontify-region, we do not do + ;; any loop here because we are not looking for a safe spot: we just + ;; mark the text whose appearance may need to change as a result of + ;; the buffer modification. + (when (and (> beg (point-min)) + (get-text-property (1- beg) 'font-lock-multiline)) + (setq beg (or (previous-single-property-change + beg 'font-lock-multiline) + (point-min)))) + (setq end (or (text-property-any end (point-max) + 'font-lock-multiline nil) + (point-max))) + ;; Finally, pre-enlarge the region to a whole number of lines, to try + ;; and anticipate what font-lock-default-fontify-region will do, so as to + ;; avoid double-redisplay. + ;; We could just run `font-lock-extend-region-functions', but since + ;; the only purpose is to avoid the double-redisplay, we prefer to + ;; do here only the part that is cheap and most likely to be useful. + (when (memq 'font-lock-extend-region-wholelines + font-lock-extend-region-functions) + (goto-char beg) + (forward-line 0) + (setq jit-lock-start (min jit-lock-start (point))) + (goto-char end) + (forward-line 1) + (setq jit-lock-end (max jit-lock-end (point))))))) + (defun font-lock-fontify-block (&optional arg) "Fontify some lines the way `font-lock-fontify-buffer' would. The lines could be a function or paragraph, or a specified number of lines. diff --git a/lisp/format.el b/lisp/format.el index 58c69575d3..66eca0c2ac 100644 --- a/lisp/format.el +++ b/lisp/format.el @@ -117,17 +117,17 @@ DOC-STR should be a single line providing more information about the REGEXP is a regular expression to match against the beginning of the file; it should match only files in that format. Use nil to avoid - matching at all for formats for which this isn't appropriate to + matching at all for formats for which it isn't appropriate to require explicit encoding/decoding. -FROM-FN is called to decode files in that format; it gets two args, BEGIN +FROM-FN is called to decode files in that format; it takes two args, BEGIN and END, and can make any modifications it likes, returning the new end. It must make sure that the beginning of the file no longer matches REGEXP, or else it will get called again. Alternatively, FROM-FN can be a string, which specifies a shell command (including options) to be used as a filter to perform the conversion. -TO-FN is called to encode a region into that format; it is passed three +TO-FN is called to encode a region into that format; it takes three arguments: BEGIN, END, and BUFFER. BUFFER is the original buffer that the data being written came from, which the function could use, for example, to find the values of local variables. TO-FN should either @@ -142,7 +142,7 @@ MODIFY, if non-nil, means the TO-FN wants to modify the region. If nil, MODE-FN, if specified, is called when visiting a file with that format. It is called with a single positive argument, on the assumption - that it turns on some Emacs mode. + that this would turn on some minor mode. PRESERVE, if non-nil, means that `format-write-file' should not remove this format from `buffer-file-formats'.") @@ -150,8 +150,8 @@ PRESERVE, if non-nil, means that `format-write-file' should not remove ;;; Basic Functions (called from Lisp) (defun format-encode-run-method (method from to &optional buffer) - "Translate using function or shell script METHOD the text from FROM to TO. -If METHOD is a string, it is a shell command; + "Translate using METHOD the text from FROM to TO. +If METHOD is a string, it is a shell command (including options); otherwise, it should be a Lisp function. BUFFER should be the buffer that the output originally came from." (if (stringp method) @@ -173,9 +173,9 @@ BUFFER should be the buffer that the output originally came from." (funcall method from to buffer))) (defun format-decode-run-method (method from to &optional buffer) - "Decode using function or shell script METHOD the text from FROM to TO. -If METHOD is a string, it is a shell command; otherwise, it should be -a Lisp function. Decoding is done for the given BUFFER." + "Decode using METHOD the text from FROM to TO. +If METHOD is a string, it is a shell command (including options); otherwise, +it should be a Lisp function. Decoding is done for the given BUFFER." (if (stringp method) (let ((error-buff (get-buffer-create "*Format Errors*")) (coding-system-for-write 'no-conversion) @@ -200,15 +200,15 @@ a Lisp function. Decoding is done for the given BUFFER." (defun format-annotate-function (format from to orig-buf format-count) "Return annotations for writing region as FORMAT. -FORMAT is a symbol naming one of the formats defined in `format-alist', -it must be a single symbol, not a list like `buffer-file-format'. +FORMAT is a symbol naming one of the formats defined in `format-alist'. +It must be a single symbol, not a list like `buffer-file-format'. FROM and TO delimit the region to be operated on in the current buffer. ORIG-BUF is the original buffer that the data came from. FORMAT-COUNT is an integer specifying how many times this function has been called in the process of decoding ORIG-BUF. -This function works like a function on `write-region-annotate-functions': +This function works like a function in `write-region-annotate-functions': it either returns a list of annotations, or returns with a different buffer current, which contains the modified text to write. In the latter case, this function's value is nil. @@ -253,7 +253,7 @@ If optional third arg VISIT-FLAG is true, set `buffer-file-format' to the reverted list of formats used, and call any mode functions defined for those formats. -Returns the new length of the decoded region. +Return the new length of the decoded region. For most purposes, consider using `format-decode-region' instead." (let ((mod (buffer-modified-p)) @@ -312,9 +312,9 @@ For most purposes, consider using `format-decode-region' instead." (defun format-decode-buffer (&optional format) "Translate the buffer from some FORMAT. -If the format is not specified, this function attempts to guess. -`buffer-file-format' is set to the format used, and any mode-functions -for the format are called." +If the format is not specified, attempt a regexp-based guess. +Set `buffer-file-format' to the format used, and call any +format-specific mode functions." (interactive (list (format-read "Translate buffer from format (default guess): "))) (save-excursion @@ -343,7 +343,7 @@ formats defined in `format-alist', or a list of such symbols." (defun format-encode-region (beg end &optional format) "Translate the region into some FORMAT. -FORMAT defaults to `buffer-file-format', it is a symbol naming +FORMAT defaults to `buffer-file-format'. It is a symbol naming one of the formats defined in `format-alist', or a list of such symbols." (interactive (list (region-beginning) (region-end) @@ -374,9 +374,9 @@ Make buffer visit that file and set the format as the default for future saves. If the buffer is already visiting a file, you can specify a directory name as FILENAME, to write a file of the same old name in that directory. -If optional third arg CONFIRM is non-nil, this function asks for -confirmation before overwriting an existing file. Interactively, -confirmation is required unless you supply a prefix argument." +If optional third arg CONFIRM is non-nil, ask for confirmation before +overwriting an existing file. Interactively, confirmation is required +unless you supply a prefix argument." (interactive ;; Same interactive spec as write-file, plus format question. (let* ((file (if buffer-file-name @@ -419,7 +419,7 @@ If FORMAT is nil then do not do any format conversion." "Insert the contents of file FILENAME using data format FORMAT. If FORMAT is nil then do not do any format conversion. The optional third and fourth arguments BEG and END specify -the part of the file to read. +the part (in bytes) of the file to read. The return value is like the value of `insert-file-contents': a list (ABSOLUTE-FILE-NAME SIZE)." @@ -456,10 +456,10 @@ Formats are defined in `format-alist'. Optional arg is the PROMPT to use." (defun format-replace-strings (alist &optional reverse beg end) "Do multiple replacements on the buffer. ALIST is a list of (FROM . TO) pairs, which should be proper arguments to -`search-forward' and `replace-match' respectively. -Optional 2nd arg REVERSE, if non-nil, means the pairs are (TO . FROM), so that -you can use the same list in both directions if it contains only literal -strings. +`search-forward' and `replace-match', respectively. +Optional second arg REVERSE, if non-nil, means the pairs are (TO . FROM), +so that you can use the same list in both directions if it contains only +literal strings. Optional args BEG and END specify a region of the buffer on which to operate." (save-excursion (save-restriction @@ -497,7 +497,7 @@ the value of `foo'." (defun format-make-relatively-unique (a b) "Delete common elements of lists A and B, return as pair. -Compares using `equal'." +Compare using `equal'." (let* ((acopy (copy-sequence a)) (bcopy (copy-sequence b)) (tail acopy)) @@ -511,9 +511,9 @@ Compares using `equal'." (defun format-common-tail (a b) "Given two lists that have a common tail, return it. -Compares with `equal', and returns the part of A that is equal to the +Compare with `equal', and return the part of A that is equal to the equivalent part of B. If even the last items of the two are not equal, -returns nil." +return nil." (let ((la (length a)) (lb (length b))) ;; Make sure they are the same length @@ -534,9 +534,9 @@ A proper list is a list ending with a nil cdr, not with an atom " (null list))) (defun format-reorder (items order) - "Arrange ITEMS to following partial ORDER. -Elements of ITEMS equal to elements of ORDER will be rearranged to follow the -ORDER. Unmatched items will go last." + "Arrange ITEMS to follow partial ORDER. +Elements of ITEMS equal to elements of ORDER will be rearranged +to follow the ORDER. Unmatched items will go last." (if order (let ((item (member (car order) items))) (if item @@ -793,7 +793,7 @@ yet known. ;; next-single-property-change instead of text-property-not-all, but then ;; we have to see if we passed TO. (defun format-property-increment-region (from to prop delta default) - "Over the region between FROM and TO increment property PROP by amount DELTA. + "In the region from FROM to TO increment property PROP by amount DELTA. DELTA may be negative. If property PROP is nil anywhere in the region, it is treated as though it were DEFAULT." (let ((cur from) val newval next) @@ -810,7 +810,7 @@ in the region, it is treated as though it were DEFAULT." (defun format-insert-annotations (list &optional offset) "Apply list of annotations to buffer as `write-region' would. -Inserts each element of the given LIST of buffer annotations at its +Insert each element of the given LIST of buffer annotations at its appropriate place. Use second arg OFFSET if the annotations' locations are not relative to the beginning of the buffer: annotations will be inserted at their location-OFFSET+1 \(ie, the offset is treated as the position of @@ -834,7 +834,7 @@ property is the name of the annotation that you want to use, as it is for the (defun format-annotate-region (from to translations format-fn ignore) "Generate annotations for text properties in the region. -Searches for changes between FROM and TO, and describes them with a list of +Search for changes between FROM and TO, and describe them with a list of annotations as defined by alist TRANSLATIONS and FORMAT-FN. IGNORE lists text properties not to consider; any text properties that are neither ignored nor listed in TRANSLATIONS are warned about. @@ -975,9 +975,9 @@ either strings, or lists of the form (PARAMETER VALUE)." "Return annotations for property PROP changing from OLD to NEW. These are searched for in the translations alist TRANSLATIONS (see `format-annotate-region' for the format). -If NEW does not appear in the list, but there is a default function, then that -function is called. -Returns a cons of the form (CLOSE . OPEN) +If NEW does not appear in the list, but there is a default function, +then call that function. +Return a cons of the form (CLOSE . OPEN) where CLOSE is a list of annotations to close and OPEN is a list of annotations to open. @@ -1016,7 +1016,7 @@ either strings, or lists of the form (PARAMETER VALUE)." (format-annotate-atomic-property-change prop-alist old new))))) (defun format-annotate-atomic-property-change (prop-alist old new) - "Internal function annotate a single property change. + "Internal function to annotate a single property change. PROP-ALIST is the relevant element of a TRANSLATIONS list. OLD and NEW are the values." (let (num-ann) diff --git a/lisp/frame.el b/lisp/frame.el index e965007c8b..1ad42e387a 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1362,49 +1362,19 @@ The function `blink-cursor-start' is called when the timer fires.") This timer calls `blink-cursor-timer-function' every `blink-cursor-interval' seconds.") -(define-minor-mode blink-cursor-mode - "Toggle blinking cursor mode. -With a numeric argument, turn blinking cursor mode on iff ARG is positive. -When blinking cursor mode is enabled, the cursor of the selected -window blinks. - -Note that this command is effective only when Emacs -displays through a window system, because then Emacs does its own -cursor display. On a text-only terminal, this is not implemented." - :init-value (not (or noninteractive - no-blinking-cursor - (eq system-type 'ms-dos) - (not (memq initial-window-system '(x w32 mac))))) - :initialize 'custom-initialize-safe-default - :group 'cursor - :global t - (if blink-cursor-idle-timer (cancel-timer blink-cursor-idle-timer)) - (if blink-cursor-timer (cancel-timer blink-cursor-timer)) - (setq blink-cursor-idle-timer nil - blink-cursor-timer nil) - (if blink-cursor-mode - (progn - ;; Hide the cursor. - ;;(internal-show-cursor nil nil) - (setq blink-cursor-idle-timer - (run-with-idle-timer blink-cursor-delay - blink-cursor-delay - 'blink-cursor-start))) - (internal-show-cursor nil t))) - -(define-obsolete-variable-alias 'blink-cursor 'blink-cursor-mode "22.1") - (defun blink-cursor-start () "Timer function called from the timer `blink-cursor-idle-timer'. This starts the timer `blink-cursor-timer', which makes the cursor blink if appropriate. It also arranges to cancel that timer when the next command starts, by installing a pre-command hook." (when (null blink-cursor-timer) - (add-hook 'pre-command-hook 'blink-cursor-end) - (internal-show-cursor nil nil) + ;; Set up the timer first, so that if this signals an error, + ;; blink-cursor-end is not added to pre-command-hook. (setq blink-cursor-timer (run-with-timer blink-cursor-interval blink-cursor-interval - 'blink-cursor-timer-function)))) + 'blink-cursor-timer-function)) + (add-hook 'pre-command-hook 'blink-cursor-end) + (internal-show-cursor nil nil))) (defun blink-cursor-timer-function () "Timer function of timer `blink-cursor-timer'." @@ -1417,10 +1387,38 @@ When run, it cancels the timer `blink-cursor-timer' and removes itself as a pre-command hook." (remove-hook 'pre-command-hook 'blink-cursor-end) (internal-show-cursor nil t) - (cancel-timer blink-cursor-timer) - (setq blink-cursor-timer nil)) + (when blink-cursor-timer + (cancel-timer blink-cursor-timer) + (setq blink-cursor-timer nil))) +(define-minor-mode blink-cursor-mode + "Toggle blinking cursor mode. +With a numeric argument, turn blinking cursor mode on iff ARG is positive. +When blinking cursor mode is enabled, the cursor of the selected +window blinks. +Note that this command is effective only when Emacs +displays through a window system, because then Emacs does its own +cursor display. On a text-only terminal, this is not implemented." + :init-value (not (or noninteractive + no-blinking-cursor + (eq system-type 'ms-dos) + (not (memq window-system '(x w32 mac))))) + :initialize 'custom-initialize-safe-default + :group 'cursor + :global t + (if blink-cursor-idle-timer (cancel-timer blink-cursor-idle-timer)) + (setq blink-cursor-idle-timer nil) + (blink-cursor-end) + (when blink-cursor-mode + ;; Hide the cursor. + ;;(internal-show-cursor nil nil) + (setq blink-cursor-idle-timer + (run-with-idle-timer blink-cursor-delay + blink-cursor-delay + 'blink-cursor-start)))) + +(define-obsolete-variable-alias 'blink-cursor 'blink-cursor-mode "22.1") ;; Hourglass pointer diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index beccd918c3..6927e3bfba 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,47 @@ +2006-08-23 Andreas Seltenreich <[email protected]> + + [ Backported bug fix from No Gnus. ] + + * gnus.el (gnus-find-method-for-group): On killed/unknown groups, try + looking up the method using GROUP's prefix before inventing a new one. + It is used on killed/unknown groups in various places where returning + an all-new method isn't expected by the caller. + + * gnus-util.el (gnus-group-server): Copy required macro from No Gnus. + +2006-08-13 Romain Francoise <[email protected]> + + * mm-extern.el (mm-extern-mail-server): End `y-or-n-p' prompt with a + space. + +2006-08-09 Katsumi Yamaoka <[email protected]> + + * compface.el (uncompface): Use binary rather than raw-text-unix. + +2006-08-09 Katsumi Yamaoka <[email protected]> + + * compface.el (uncompface): Make sure the eol conversion doesn't take + place when communicating with the external programs. Reported by + ARISAWA Akihiro <[email protected]>. + +2006-07-31 Katsumi Yamaoka <[email protected]> + + * nnheader.el (nnheader-insert-head): Fix typo in comment. + +2006-07-31 Andreas Seltenreich <[email protected]> + + * nnweb.el (nnweb-google-parse-1): Update regexp for author and date. + Make it more robust by parsing author and date independently. + +2006-07-28 Katsumi Yamaoka <[email protected]> + + * nnheader.el (nnheader-insert-head): Make it work with Mac as well. + +2006-07-27 Katsumi Yamaoka <[email protected]> + + * nnheader.el (nnheader-insert-head): Make it work even if the file + uses CRLF for the line-break code. + 2006-07-19 Andreas Seltenreich <[email protected]> * mm-url.el (mm-url-insert-file-contents): Inhibit Connection: close diff --git a/lisp/gnus/compface.el b/lisp/gnus/compface.el index f6bd9bfd72..33e05046e8 100644 --- a/lisp/gnus/compface.el +++ b/lisp/gnus/compface.el @@ -34,24 +34,28 @@ GNU/Linux system these might be in packages with names like `compface' or `faces-xface' and `netpbm' or `libgr-progs', for instance." (with-temp-buffer (insert face) - (and (eq 0 (apply 'call-process-region (point-min) (point-max) - "uncompface" - 'delete '(t nil) nil)) - (progn - (goto-char (point-min)) - (insert "/* Width=48, Height=48 */\n") - ;; I just can't get "icontopbm" to work correctly on its - ;; own in XEmacs. And Emacs doesn't understand un-raw pbm - ;; files. - (if (not (featurep 'xemacs)) - (eq 0 (call-process-region (point-min) (point-max) - "icontopbm" - 'delete '(t nil))) - (shell-command-on-region (point-min) (point-max) - "icontopbm | pnmnoraw" - (current-buffer) t) - t)) - (buffer-string)))) + (let ((coding-system-for-read 'raw-text) + ;; At least "icontopbm" doesn't work with Windows because + ;; the line-break code is converted into CRLF by default. + (coding-system-for-write 'binary)) + (and (eq 0 (apply 'call-process-region (point-min) (point-max) + "uncompface" + 'delete '(t nil) nil)) + (progn + (goto-char (point-min)) + (insert "/* Width=48, Height=48 */\n") + ;; I just can't get "icontopbm" to work correctly on its + ;; own in XEmacs. And Emacs doesn't understand un-raw pbm + ;; files. + (if (not (featurep 'xemacs)) + (eq 0 (call-process-region (point-min) (point-max) + "icontopbm" + 'delete '(t nil))) + (shell-command-on-region (point-min) (point-max) + "icontopbm | pnmnoraw" + (current-buffer) t) + t)) + (buffer-string))))) (provide 'compface) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 6b525fc490..6f706fabce 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -607,6 +607,17 @@ If N, return the Nth ancestor instead." (substring gname (match-end 0)) gname))) +(defmacro gnus-group-server (group) + "Find the server name of a foreign newsgroup. +For example, (gnus-group-server \"nnimap+yxa:INBOX.foo\") would +yield \"nnimap:yxa\"." + `(let ((gname ,group)) + (if (string-match "^\\([^:+]+\\)\\(?:\\+\\([^:]*\\)\\)?:" gname) + (format "%s:%s" (match-string 1 gname) (or + (match-string 2 gname) + "")) + (format "%s:%s" (car gnus-select-method) (cadr gnus-select-method))))) + (defun gnus-make-sort-function (funs) "Return a composite sort condition based on the functions in FUNS." (cond diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 7a04c61151..8554b1332f 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -4079,8 +4079,13 @@ If NEWSGROUP is nil, return the global kill file name instead." (or gnus-override-method (and (not group) gnus-select-method) - (and (not (gnus-group-entry group)) ;; a new group - (gnus-group-name-to-method group)) + (and (not (gnus-group-entry group)) + ;; Killed or otherwise unknown group. + (or + ;; If we know a virtual server by that name, return its method. + (gnus-server-to-method (gnus-group-server group)) + ;; Guess a new method as last resort. + (gnus-group-name-to-method group))) (let ((info (or info (gnus-get-info group))) method) (if (or (not info) diff --git a/lisp/gnus/mm-extern.el b/lisp/gnus/mm-extern.el index c574bd6156..f4c728541e 100644 --- a/lisp/gnus/mm-extern.el +++ b/lisp/gnus/mm-extern.el @@ -97,7 +97,7 @@ (subject (or (cdr (assq 'subject params)) "none")) (buf (current-buffer)) info) - (if (y-or-n-p (format "Send a request message to %s?" server)) + (if (y-or-n-p (format "Send a request message to %s? " server)) (save-window-excursion (message-mail server subject) (message-goto-body) diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index d564d42414..82e1d3ab55 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -586,17 +586,27 @@ the line could be found." (if (eq nnheader-max-head-length t) ;; Just read the entire file. (nnheader-insert-file-contents file) - ;; Read 1K blocks until we find a separator. + ;; Read blocks of the size specified by `nnheader-head-chop-length' + ;; until we find a separator. (let ((beg 0) - format-alist) + (start (point)) + ;; Use `binary' to prevent the contents from being decoded, + ;; or it will change the number of characters that + ;; `insert-file-contents' returns. + (coding-system-for-read 'binary)) (while (and (eq nnheader-head-chop-length - (nth 1 (nnheader-insert-file-contents + (nth 1 (mm-insert-file-contents file nil beg (incf beg nnheader-head-chop-length)))) - (prog1 (not (search-forward "\n\n" nil t)) + ;; CRLF or CR might be used for the line-break code. + (prog1 (not (re-search-forward "\n\r?\n\\|\r\r" nil t)) (goto-char (point-max))) (or (null nnheader-max-head-length) - (< beg nnheader-max-head-length)))))) + (< beg nnheader-max-head-length)))) + ;; Finally decode the contents. + (when (mm-coding-system-p nnheader-file-coding-system) + (mm-decode-coding-region start (point-max) + nnheader-file-coding-system)))) t)) (defun nnheader-article-p () diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el index 7c0c8e0e44..d020d533ae 100644 --- a/lisp/gnus/nnweb.el +++ b/lisp/gnus/nnweb.el @@ -366,14 +366,15 @@ Valid types include `google', `dejanews', and `gmane'.") (mm-url-decode-entities) (search-backward " - ") (when (looking-at - " - \\([a-zA-Z]+\\) \\([0-9]+\\)\\(?: \\([0-9]\\{4\\}\\)\\)?[^\n]+by ?\n?\\([^<\n]+\\)\n") - (setq From (match-string 4) - Date (format "%s %s 00:00:00 %s" + "\\W+\\(\\w+\\) \\([0-9]+\\)\\(?: \\([0-9]\\{4\\}\\)\\)?") + (setq Date (format "%s %s 00:00:00 %s" (match-string 1) (match-string 2) (or (match-string 3) - (substring (current-time-string) -4))))) - + (substring (current-time-string) -4)))) + (goto-char (match-end 0))) + (when (looking-at "[^b]+by\\W+\\([^<\n]+\\)") + (setq From (match-string 1))) (widen) (forward-line 1) (incf i) diff --git a/lisp/help.el b/lisp/help.el index 4d92f69ceb..db76efb01a 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -822,16 +822,13 @@ whose documentation describes the minor mode." (sort minor-modes (lambda (a b) (string-lessp (cadr a) (cadr b))))) (when minor-modes - (princ "Summary of minor modes:\n") + (princ "Enabled minor modes:\n") (make-local-variable 'help-button-cache) (with-current-buffer standard-output (dolist (mode minor-modes) (let ((mode-function (nth 0 mode)) (pretty-minor-mode (nth 1 mode)) (indicator (nth 2 mode))) - (setq indicator (if (zerop (length indicator)) - "no indicator" - (format "indicator%s" indicator))) (add-text-properties 0 (length pretty-minor-mode) '(face bold) pretty-minor-mode) (save-excursion @@ -840,16 +837,22 @@ whose documentation describes the minor mode." (push (point-marker) help-button-cache) ;; Document the minor modes fully. (insert pretty-minor-mode) - (princ (format " minor mode (%s):\n" indicator)) + (princ (format " minor mode (%s):\n" + (if (zerop (length indicator)) + "no indicator" + (format "indicator%s" + indicator)))) (princ (documentation mode-function))) - (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" indicator))))) - (princ "\n(Full information about these minor modes -follows the description of the major mode.)\n\n")) + (newline))) + (forward-line -1) + (fill-paragraph nil) + (forward-line 1)) + + (princ "\n(Information about these minor modes follows the major mode info.)\n\n")) ;; Document the major mode. (let ((mode mode-name)) (with-current-buffer standard-output diff --git a/lisp/ido.el b/lisp/ido.el index be1cba62f2..2d531728b6 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -1840,6 +1840,7 @@ If INITIAL is non-nil, it specifies the initial input string." (and d (cdr d))))))) (if (member ido-default-item ido-ignore-item-temp-list) (setq ido-default-item nil)) + (ido-trace "new default" ido-default-item) (setq ido-set-default-item nil)) (if ido-process-ignore-lists-inhibit @@ -3528,37 +3529,40 @@ for first matching file." (let* ((case-fold-search ido-case-fold) (slash (and (not ido-enable-prefix) (ido-final-slash ido-text))) (text (if slash (substring ido-text 0 -1) ido-text)) - (rexq (concat (if ido-enable-regexp text (regexp-quote text)) (if slash ".*/" ""))) + (rex0 (if ido-enable-regexp text (regexp-quote text))) + (rexq (concat rex0 (if slash ".*/" ""))) (re (if ido-enable-prefix (concat "\\`" rexq) rexq)) - (full-re (and do-full (not ido-enable-regexp) (not (string-match "\$\\'" re)) - (concat "\\`" re "\\'"))) + (full-re (and do-full (not ido-enable-regexp) (not (string-match "\$\\'" rex0)) + (concat "\\`" rex0 (if slash "/" "") "\\'"))) + (suffix-re (and do-full slash + (not ido-enable-regexp) (not (string-match "\$\\'" rex0)) + (concat rex0 "/\\'"))) (prefix-re (and full-re (not ido-enable-prefix) (concat "\\`" rexq))) (non-prefix-dot (or (not ido-enable-dot-prefix) (not ido-process-ignore-lists) ido-enable-prefix (= (length ido-text) 0))) - - full-matches - prefix-matches - matches) + full-matches suffix-matches prefix-matches matches) (setq ido-incomplete-regexp nil) (condition-case error (mapcar (lambda (item) (let ((name (ido-name item))) - (if (and (or non-prefix-dot - (if (= (aref ido-text 0) ?.) - (= (aref name 0) ?.) - (/= (aref name 0) ?.))) - (string-match re name)) - (cond - ((and full-re (string-match full-re name)) - (setq full-matches (cons item full-matches))) - ((and prefix-re (string-match prefix-re name)) - (setq prefix-matches (cons item prefix-matches))) - (t (setq matches (cons item matches)))))) - t) + (if (and (or non-prefix-dot + (if (= (aref ido-text 0) ?.) + (= (aref name 0) ?.) + (/= (aref name 0) ?.))) + (string-match re name)) + (cond + ((and full-re (string-match full-re name)) + (setq full-matches (cons item full-matches))) + ((and suffix-re (string-match suffix-re name)) + (setq suffix-matches (cons item suffix-matches))) + ((and prefix-re (string-match prefix-re name)) + (setq prefix-matches (cons item prefix-matches))) + (t (setq matches (cons item matches)))))) + t) items) (invalid-regexp (setq ido-incomplete-regexp t @@ -3566,10 +3570,15 @@ for first matching file." ;; special-case single match, and handle appropriately ;; elsewhere. matches (cdr error)))) - (if prefix-matches - (setq matches (nconc prefix-matches matches))) - (if full-matches - (setq matches (nconc full-matches matches))) + (when prefix-matches + (ido-trace "prefix match" prefix-matches) + (setq matches (nconc prefix-matches matches))) + (when suffix-matches + (ido-trace "suffix match" (list text suffix-re suffix-matches)) + (setq matches (nconc suffix-matches matches))) + (when full-matches + (ido-trace "full match" (list text full-re full-matches)) + (setq matches (nconc full-matches matches))) (when (and (null matches) ido-enable-flex-matching (> (length ido-text) 1) @@ -4096,12 +4105,13 @@ For details of keybindings, do `\\[describe-function] ido-find-file'." try-single-dir-match refresh) - (ido-trace "\nexhibit" this-command) - (ido-trace "dir" ido-current-directory) - (ido-trace "contents" contents) - (ido-trace "list" ido-cur-list) - (ido-trace "matches" ido-matches) - (ido-trace "rescan" ido-rescan) + (when ido-trace-enable + (ido-trace "\nexhibit" this-command) + (ido-trace "dir" ido-current-directory) + (ido-trace "contents" contents) + (ido-trace "list" ido-cur-list) + (ido-trace "matches" ido-matches) + (ido-trace "rescan" ido-rescan)) (save-excursion (goto-char (point-max)) diff --git a/lisp/info.el b/lisp/info.el index 87327d8656..dc08557e28 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -3805,6 +3805,8 @@ the variable `Info-file-list-for-emacs'." (setq other-tag (cond ((save-match-data (looking-back "\\<see")) "") + ((save-match-data (looking-back "\\<in")) + "") ((memq (char-before) '(nil ?\. ?! ??)) "See ") ((save-match-data diff --git a/lisp/international/latexenc.el b/lisp/international/latexenc.el index 25d56c1e92..58e8d6c88e 100644 --- a/lisp/international/latexenc.el +++ b/lisp/international/latexenc.el @@ -138,8 +138,14 @@ coding system names is determined from `latex-inputenc-coding-alist'." ((and (require 'code-pages nil t) (coding-system-p sym)) sym) (t 'undecided))) ;; else try to find it in the master/main file - (let ((default-directory (file-name-directory (nth 1 arg-list))) - latexenc-main-file) + + ;; Fixme: If the current file is in an archive (e.g. tar, + ;; zip), we should find the master file in that archive. + ;; But, that is not yet implemented. -- K.Handa + (let ((default-directory (if (stringp (nth 1 arg-list)) + (file-name-directory (nth 1 arg-list)) + default-directory)) + latexenc-main-file) ;; Is there a TeX-master or tex-main-file in the local variables ;; section? (unless latexenc-dont-use-TeX-master-flag diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el index 0a2e5a7c32..57b77249ba 100644 --- a/lisp/international/mule-diag.el +++ b/lisp/international/mule-diag.el @@ -1039,18 +1039,28 @@ but still contains full information about each coding system." ;;;###autoload (defun describe-font (fontname) - "Display information about fonts which partially match FONTNAME." - (interactive "sFontname (default current choice for ASCII chars): ") + "Display information about a font whose name is FONTNAME. +The font must be already used by Emacs." + (interactive "sFont name (default current choice for ASCII chars): ") (or (and window-system (fboundp 'fontset-list)) - (error "No fontsets being used")) - (when (or (not fontname) (= (length fontname) 0)) - (setq fontname (cdr (assq 'font (frame-parameters)))) - (if (query-fontset fontname) - (setq fontname - (nth 1 (assq 'ascii (aref (fontset-info fontname) 2)))))) - (let ((font-info (font-info fontname))) + (error "No fonts being used")) + (let (fontset font-info) + (when (or (not fontname) (= (length fontname) 0)) + (setq fontname (frame-parameter nil 'font)) + ;; Check if FONTNAME is a fontset. + (if (query-fontset fontname) + (setq fontset fontname + fontname (nth 1 (assq 'ascii + (aref (fontset-info fontname) 2)))))) + (setq font-info (font-info fontname)) (if (null font-info) - (message "No matching font") + (if fontset + ;; The font should be surely used. So, there's some + ;; problem about getting information about it. It is + ;; better to print the fontname to show which font has + ;; this problem. + (message "No information about \"%s\"" fontname) + (message "No matching font being used")) (with-output-to-temp-buffer "*Help*" (describe-font-internal font-info 'verbose))))) diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el index 0e131b665e..89959ad852 100644 --- a/lisp/jit-lock.el +++ b/lisp/jit-lock.el @@ -31,6 +31,8 @@ (eval-when-compile + (require 'cl) + (defmacro with-buffer-unmodified (&rest body) "Eval BODY, preserving the current buffer's modified state." (declare (debug t)) @@ -169,6 +171,8 @@ If nil, contextual fontification is disabled.") (defvar jit-lock-stealth-timer nil "Timer for stealth fontification in Just-in-time Lock mode.") +(defvar jit-lock-stealth-repeat-timer nil + "Timer for repeated stealth fontification in Just-in-time Lock mode.") (defvar jit-lock-context-timer nil "Timer for context fontification in Just-in-time Lock mode.") (defvar jit-lock-defer-timer nil @@ -176,6 +180,8 @@ If nil, contextual fontification is disabled.") (defvar jit-lock-defer-buffers nil "List of buffers with pending deferred fontification.") +(defvar jit-lock-stealth-buffers nil + "List of buffers that are being fontified stealthily.") ;;; JIT lock mode @@ -223,6 +229,13 @@ the variable `jit-lock-stealth-nice'." (run-with-idle-timer jit-lock-stealth-time t 'jit-lock-stealth-fontify))) + ;; Create, but do not activate, the idle timer for repeated + ;; stealth fontification. + (when (and jit-lock-stealth-time (null jit-lock-stealth-repeat-timer)) + (setq jit-lock-stealth-repeat-timer (timer-create)) + (timer-set-function jit-lock-stealth-repeat-timer + 'jit-lock-stealth-fontify '(t))) + ;; Init deferred fontification timer. (when (and jit-lock-defer-time (null jit-lock-defer-timer)) (setq jit-lock-defer-timer @@ -331,7 +344,7 @@ Defaults to the whole buffer. END can be out of bounds." ;; from the end of a buffer to its start, can do repeated ;; `parse-partial-sexp' starting from `point-min', which can ;; take a long time in a large buffer. - (let (next) + (let ((orig-start start) next) (save-match-data ;; Fontify chunks beginning at START. The end of a ;; chunk is either `end', or the start of a region @@ -374,6 +387,26 @@ Defaults to the whole buffer. END can be out of bounds." (quit (put-text-property start next 'fontified nil) (funcall 'signal (car err) (cdr err)))) + ;; The redisplay engine has already rendered the buffer up-to + ;; `orig-start' and won't notice if the above jit-lock-functions + ;; changed the appearance of any part of the buffer prior + ;; to that. So if `start' is before `orig-start', we need to + ;; cause a new redisplay cycle after this one so that any changes + ;; are properly reflected on screen. + ;; To make such repeated redisplay happen less often, we can + ;; eagerly extend the refontified region with + ;; jit-lock-after-change-extend-region-functions. + (when (< start orig-start) + (lexical-let ((start start) + (orig-start orig-start) + (buf (current-buffer))) + (run-with-timer + 0 nil (lambda () + (with-current-buffer buf + (with-buffer-prepared-for-jit-lock + (put-text-property start orig-start + 'fontified t))))))) + ;; Find the start of the next chunk, if any. (setq start (text-property-any next end 'fontified nil)))))))) @@ -421,71 +454,55 @@ Value is nil if there is nothing more to fontify." (t next)))) result)))) - -(defun jit-lock-stealth-fontify () +(defun jit-lock-stealth-fontify (&optional repeat) "Fontify buffers stealthily. -This functions is called after Emacs has been idle for -`jit-lock-stealth-time' seconds." - ;; I used to check `inhibit-read-only' here, but I can't remember why. -stef +This function is called repeatedly after Emacs has become idle for +`jit-lock-stealth-time' seconds. Optional argument REPEAT is expected +non-nil in a repeated invocation of this function." + ;; Cancel timer for repeated invocations. + (unless repeat + (cancel-timer jit-lock-stealth-repeat-timer)) (unless (or executing-kbd-macro memory-full - (window-minibuffer-p (selected-window))) - (let ((buffers (buffer-list)) - (outer-buffer (current-buffer)) + (window-minibuffer-p (selected-window)) + ;; For first invocation set up `jit-lock-stealth-buffers'. + ;; In repeated invocations it's already been set up. + (null (if repeat + jit-lock-stealth-buffers + (setq jit-lock-stealth-buffers (buffer-list))))) + (let ((buffer (car jit-lock-stealth-buffers)) + (delay 0) minibuffer-auto-raise - message-log-max) - (with-local-quit - (while (and buffers (not (input-pending-p))) - (with-current-buffer (pop buffers) - (when jit-lock-mode - ;; This is funny. Calling sit-for with 3rd arg non-nil - ;; so that it doesn't redisplay, internally calls - ;; wait_reading_process_input also with a parameter - ;; saying "don't redisplay." Since this function here - ;; is called periodically, this effectively leads to - ;; process output not being redisplayed at all because - ;; redisplay_internal is never called. (That didn't - ;; work in the old redisplay either.) So, we learn that - ;; we mustn't call sit-for that way here. But then, we - ;; have to be cautious not to call sit-for in a widened - ;; buffer, since this could display hidden parts of that - ;; buffer. This explains the seemingly weird use of - ;; save-restriction/widen here. - - (with-temp-message (if jit-lock-stealth-verbose - (concat "JIT stealth lock " - (buffer-name))) - - ;; In the following code, the `sit-for' calls cause a - ;; redisplay, so it's required that the - ;; buffer-modified flag of a buffer that is displayed - ;; has the right value---otherwise the mode line of - ;; an unmodified buffer would show a `*'. - (let (start - (nice (or jit-lock-stealth-nice 0)) - (point (point-min))) - (while (and (setq start - (jit-lock-stealth-chunk-start point)) - ;; In case sit-for runs any timers, - ;; give them the expected current buffer. - (with-current-buffer outer-buffer - (sit-for nice))) - - ;; fontify a block. - (jit-lock-fontify-now start (+ start jit-lock-chunk-size)) - ;; If stealth jit-locking is done backwards, this leads to - ;; excessive O(n^2) refontification. -stef - ;; (when (>= jit-lock-context-unfontify-pos start) - ;; (setq jit-lock-context-unfontify-pos end)) - - ;; Wait a little if load is too high. - (when (and jit-lock-stealth-load - (> (car (load-average)) jit-lock-stealth-load)) - ;; In case sit-for runs any timers, - ;; give them the expected current buffer. - (with-current-buffer outer-buffer - (sit-for (or jit-lock-stealth-time 30)))))))))))))) - + message-log-max + start) + (if (and jit-lock-stealth-load + (> (car (load-average)) jit-lock-stealth-load)) + ;; Wait a little if load is too high. + (setq delay jit-lock-stealth-time) + (if (buffer-live-p buffer) + (with-current-buffer buffer + (if (and jit-lock-mode + (setq start (jit-lock-stealth-chunk-start (point)))) + ;; Fontify one block of at most `jit-lock-chunk-size' + ;; characters. + (with-temp-message (if jit-lock-stealth-verbose + (concat "JIT stealth lock " + (buffer-name))) + (jit-lock-fontify-now start + (+ start jit-lock-chunk-size)) + ;; Run again after `jit-lock-stealth-nice' seconds. + (setq delay (or jit-lock-stealth-nice 0))) + ;; Nothing to fontify here. Remove this buffer from + ;; `jit-lock-stealth-buffers' and run again immediately. + (setq jit-lock-stealth-buffers (cdr jit-lock-stealth-buffers)))) + ;; Buffer is no longer live. Remove it from + ;; `jit-lock-stealth-buffers' and run again immediately. + (setq jit-lock-stealth-buffers (cdr jit-lock-stealth-buffers)))) + ;; Call us again. + (when jit-lock-stealth-buffers + (timer-set-idle-time jit-lock-stealth-repeat-timer (current-idle-time)) + (timer-inc-time jit-lock-stealth-repeat-timer delay) + (timer-activate-when-idle jit-lock-stealth-repeat-timer t))))) ;;; Deferred fontification. @@ -548,6 +565,19 @@ This functions is called after Emacs has been idle for '(fontified nil jit-lock-defer-multiline nil))) (setq jit-lock-context-unfontify-pos (point-max))))))))) +(defvar jit-lock-start) (defvar jit-lock-end) ; Dynamically scoped variables. +(defvar jit-lock-after-change-extend-region-functions nil + "Hook that can extend the text to refontify after a change. +This is run after every buffer change. The functions are called with +the three arguments of `after-change-functions': START END OLD-LEN. +The extended region to refontify is returned indirectly by modifying +the variables `jit-lock-start' and `jit-lock-end'. + +Note that extending the region this way is not strictly necessary, except +that the nature of the redisplay code tends to otherwise leave some of +the rehighlighted text displayed with the old highlight until the next +redisplay (see comment about repeated redisplay in `jit-lock-fontify-now').") + (defun jit-lock-after-change (start end old-len) "Mark the rest of the buffer as not fontified after a change. Installed on `after-change-functions'. @@ -557,44 +587,24 @@ This function ensures that lines following the change will be refontified in case the syntax of those lines has changed. Refontification will take place when text is fontified stealthily." (when (and jit-lock-mode (not memory-full)) - (let ((region (font-lock-extend-region start end old-len))) - (save-excursion - (with-buffer-prepared-for-jit-lock - ;; It's important that the `fontified' property be set from the - ;; beginning of the line, else font-lock will properly change the - ;; text's face, but the display will have been done already and will - ;; be inconsistent with the buffer's content. - ;; - ;; FIXME!!! (Alan Mackenzie, 2006-03-14): If start isn't at a BOL, - ;; expanding the region to BOL might mis-fontify, should the BOL not - ;; be at a "safe" position. - (setq start (if region - (car region) - (goto-char start) - (line-beginning-position))) - - ;; If we're in text that matches a multi-line font-lock pattern, - ;; make sure the whole text will be redisplayed. - ;; I'm not sure this is ever necessary and/or sufficient. -stef - (when (get-text-property start 'font-lock-multiline) - (setq start (or (previous-single-property-change - start 'font-lock-multiline) - (point-min)))) - - (if region (setq end (cdr region))) - ;; Make sure we change at least one char (in case of deletions). - (setq end (min (max end (1+ start)) (point-max))) - ;; Request refontification. - (put-text-property start end 'fontified nil)) - ;; Mark the change for deferred contextual refontification. - (when jit-lock-context-unfontify-pos - (setq jit-lock-context-unfontify-pos - ;; Here we use `start' because nothing guarantees that the - ;; text between start and end will be otherwise refontified: - ;; usually it will be refontified by virtue of being - ;; displayed, but if it's outside of any displayed area in the - ;; buffer, only jit-lock-context-* will re-fontify it. - (min jit-lock-context-unfontify-pos start))))))) + (let ((jit-lock-start start) + (jit-lock-end end)) + (with-buffer-prepared-for-jit-lock + (run-hook-with-args 'jit-lock-after-change-extend-region-functions + start end old-len) + ;; Make sure we change at least one char (in case of deletions). + (setq jit-lock-end (min (max jit-lock-end (1+ start)) (point-max))) + ;; Request refontification. + (put-text-property jit-lock-start jit-lock-end 'fontified nil)) + ;; Mark the change for deferred contextual refontification. + (when jit-lock-context-unfontify-pos + (setq jit-lock-context-unfontify-pos + ;; Here we use `start' because nothing guarantees that the + ;; text between start and end will be otherwise refontified: + ;; usually it will be refontified by virtue of being + ;; displayed, but if it's outside of any displayed area in the + ;; buffer, only jit-lock-context-* will re-fontify it. + (min jit-lock-context-unfontify-pos jit-lock-start)))))) (provide 'jit-lock) diff --git a/lisp/kmacro.el b/lisp/kmacro.el index d3db76fcc8..2d1f5f3384 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -409,7 +409,7 @@ Optional arg EMPTY is message to print if no macros are defined." (defun kmacro-repeat-on-last-key (keys) - "Process kmacro commands keys immidiately after cycling the ring." + "Process kmacro commands keys immediately after cycling the ring." (setq keys (vconcat keys)) (let ((n (1- (length keys))) cmd done repeat) diff --git a/lisp/loadhist.el b/lisp/loadhist.el index 635059f93e..61f15c8ef1 100644 --- a/lisp/loadhist.el +++ b/lisp/loadhist.el @@ -222,8 +222,8 @@ such as redefining an Emacs function." (if aload (fset fun (cons 'autoload aload)) (fmakunbound fun)))))) - (require nil) - (t (message "Unexpected element %s in load-history" x))) + ((t require) nil) + (t (message "Unexpected element %s in load-history" x))) ;; Kill local values as much as possible. (dolist (buf (buffer-list)) (with-current-buffer buf diff --git a/lisp/longlines.el b/lisp/longlines.el index 9da3de217a..77e0b41534 100644 --- a/lisp/longlines.el +++ b/lisp/longlines.el @@ -44,7 +44,7 @@ :group 'fill) (defcustom longlines-auto-wrap t - "*Non-nil means long lines are automatically wrapped after each command. + "Non-nil means long lines are automatically wrapped after each command. Otherwise, you can perform filling using `fill-paragraph' or `auto-fill-mode'. In any case, the soft newlines will be removed when the file is saved to disk." @@ -52,7 +52,7 @@ when the file is saved to disk." :type 'boolean) (defcustom longlines-wrap-follows-window-size nil - "*Non-nil means wrapping and filling happen at the edge of the window. + "Non-nil means wrapping and filling happen at the edge of the window. Otherwise, `fill-column' is used, regardless of the window size. This does not work well when the buffer is displayed in multiple windows with differing widths." @@ -60,7 +60,7 @@ with differing widths." :type 'boolean) (defcustom longlines-show-hard-newlines nil - "*Non-nil means each hard newline is marked on the screen. + "Non-nil means each hard newline is marked on the screen. \(The variable `longlines-show-effect' controls what they look like.) You can also enable the display temporarily, using the command `longlines-show-hard-newlines'" @@ -68,7 +68,7 @@ You can also enable the display temporarily, using the command :type 'boolean) (defcustom longlines-show-effect (propertize "|\n" 'face 'escape-glyph) - "*A string to display when showing hard newlines. + "A string to display when showing hard newlines. This is used when `longlines-show-hard-newlines' is on." :group 'longlines :type 'string) @@ -202,7 +202,8 @@ With optional argument ARG, make the hard newlines invisible again." "Make hard newlines between BEG and END visible." (let* ((pmin (min beg end)) (pmax (max beg end)) - (pos (text-property-not-all pmin pmax 'hard nil))) + (pos (text-property-not-all pmin pmax 'hard nil)) + (inhibit-read-only t)) (while pos (put-text-property pos (1+ pos) 'display (copy-sequence longlines-show-effect)) diff --git a/lisp/mouse.el b/lisp/mouse.el index 043c78578d..4e11b1d4c9 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -2398,6 +2398,8 @@ and selects that window." (global-set-key [right-fringe mouse-1] 'mouse-set-point) (global-set-key [mouse-2] 'mouse-yank-at-click) +;; Allow yanking also when the corresponding cursor is "in the fringe". +(global-set-key [right-fringe mouse-2] [mouse-2]) (global-set-key [mouse-3] 'mouse-save-then-kill) ;; By binding these to down-going events, we let the user use the up-going diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 1f051ffa9f..c34ac7dcf7 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -40,6 +40,8 @@ ;; Open a new irc connection with: ;; M-x irc RET +;;; Todo: + ;;; Code: (require 'ring) @@ -140,6 +142,10 @@ number. If zero or nil, no truncating is done." (integer :tag "Number of lines")) :group 'rcirc) +(defcustom rcirc-show-maximum-output t + "*If non-nil, scroll buffer to keep the point at the bottom of +the window.") + (defcustom rcirc-authinfo nil "List of authentication passwords. Each element of the list is a list with a SERVER-REGEXP string @@ -297,6 +303,7 @@ and the cdr part is used for encoding." (defvar rcirc-urls nil "List of urls seen in the current buffer.") +(put 'rcirc-urls 'permanent-local t) (defvar rcirc-keepalive-seconds 60 "Number of seconds between keepalive pings. @@ -539,7 +546,10 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") (defun rcirc-buffer-process (&optional buffer) "Return the process associated with channel BUFFER. With no argument or nil as argument, use the current buffer." - (get-buffer-process (or buffer rcirc-server-buffer))) + (get-buffer-process (if buffer + (with-current-buffer buffer + rcirc-server-buffer) + rcirc-server-buffer))) (defun rcirc-server-name (process) "Return PROCESS server name, given by the 001 response." @@ -601,10 +611,11 @@ If NOTICEP is non-nil, send a notice instead of privmsg." (defvar rcirc-nick-completions nil) (defvar rcirc-nick-completion-start-offset nil) + (defun rcirc-complete-nick () "Cycle through nick completions from list of nicks in channel." (interactive) - (if (eq last-command 'rcirc-complete-nick) + (if (eq last-command this-command) (setq rcirc-nick-completions (append (cdr rcirc-nick-completions) (list (car rcirc-nick-completions)))) @@ -626,9 +637,10 @@ If NOTICEP is non-nil, send a notice instead of privmsg." rcirc-target)))))) (let ((completion (car rcirc-nick-completions))) (when completion + (rcirc-put-nick-channel (rcirc-buffer-process) completion rcirc-target) (delete-region (+ rcirc-prompt-end-marker - rcirc-nick-completion-start-offset) - (point)) + rcirc-nick-completion-start-offset) + (point)) (insert (concat completion (if (= (+ rcirc-prompt-end-marker rcirc-nick-completion-start-offset) @@ -709,7 +721,6 @@ If NOTICEP is non-nil, send a notice instead of privmsg." (make-local-variable 'rcirc-short-buffer-name) (setq rcirc-short-buffer-name nil) (make-local-variable 'rcirc-urls) - (setq rcirc-urls nil) (setq use-hard-newlines t) (make-local-variable 'rcirc-decode-coding-system) @@ -742,6 +753,9 @@ If NOTICEP is non-nil, send a notice instead of privmsg." (make-local-variable 'kill-buffer-hook) (add-hook 'kill-buffer-hook 'rcirc-kill-buffer-hook) + (make-local-variable 'window-scroll-functions) + (add-hook 'window-scroll-functions 'rcirc-scroll-to-bottom) + ;; add to buffer list, and update buffer abbrevs (when target ; skip server buffer (let ((buffer (current-buffer))) @@ -1144,6 +1158,15 @@ is found by looking up RESPONSE in `rcirc-response-formats'." (make-variable-buffer-local 'rcirc-last-sender) (defvar rcirc-gray-toggle nil) (make-variable-buffer-local 'rcirc-gray-toggle) + +(defun rcirc-scroll-to-bottom (window display-start) + "Scroll window to show maximum output if `rcirc-show-maximum-output' is +non-nil." + (when rcirc-show-maximum-output + (with-selected-window window + (when (>= (window-point) rcirc-prompt-end-marker) + (recenter -1))))) + (defun rcirc-print (process sender response target text &optional activity) "Print TEXT in the buffer associated with TARGET. Format based on SENDER and RESPONSE. If ACTIVITY is non-nil, @@ -1240,16 +1263,19 @@ record activity." ;; record modeline activity (when activity (let ((nick-match - (string-match (concat "\\b" - (regexp-quote (rcirc-nick process)) - "\\b") - text))) + (with-syntax-table rcirc-nick-syntax-table + (string-match (concat "\\b" + (regexp-quote (rcirc-nick process)) + "\\b") + text)))) (when (if rcirc-ignore-buffer-activity-flag ;; - Always notice when our nick is mentioned nick-match - ;; - Never bother us if a dim-nick spoke - (not (and rcirc-dim-nick-regexp sender - (string-match rcirc-dim-nick-regexp sender)))) + ;; - unless our nick is mentioned, don't bother us + ;; - with dim-nicks + (or nick-match + (not (and rcirc-dim-nick-regexp sender + (string-match rcirc-dim-nick-regexp sender))))) (rcirc-record-activity (current-buffer) (when (or nick-match (and (not (rcirc-channel-p rcirc-target)) @@ -1504,18 +1530,20 @@ activity. Only run if the buffer is not visible and (lopri (car pair)) (hipri (cdr pair))) (setq rcirc-activity-string - (if (or hipri lopri) - (concat "-" - (and hipri "[") - (rcirc-activity-string hipri) - (and hipri lopri ",") - (and lopri - (concat "(" - (rcirc-activity-string lopri) - ")")) - (and hipri "]") - "-") - "-[]-")))) + (cond ((or hipri lopri) + (concat "-" + (and hipri "[") + (rcirc-activity-string hipri) + (and hipri lopri ",") + (and lopri + (concat "(" + (rcirc-activity-string lopri) + ")")) + (and hipri "]") + "-")) + ((not (null (rcirc-process-list))) + "-[]-") + (t ""))))) (defun rcirc-activity-string (buffers) (mapconcat (lambda (b) @@ -1771,7 +1799,7 @@ nicks when no NICK is given. When listing ignored nicks, the ones added to the list automatically are marked with an asterisk." (interactive "sToggle ignoring of nick: ") (when (not (string= "" nick)) - (if (member nick rcirc-ignore-list) + (if (member-ignore-case nick rcirc-ignore-list) (setq rcirc-ignore-list (delete nick rcirc-ignore-list)) (setq rcirc-ignore-list (cons nick rcirc-ignore-list)))) (rcirc-print process (rcirc-nick process) "IGNORE" target @@ -1800,6 +1828,7 @@ ones added to the list automatically are marked with an asterisk." "://") "www.") (1+ (char "-a-zA-Z0-9_.")) + (1+ (char "-a-zA-Z0-9_")) (optional ":" (1+ (char "0-9")))) (and (1+ (char "-a-zA-Z0-9_.")) (or ".com" ".net" ".org") @@ -1823,7 +1852,7 @@ ones added to the list automatically are marked with an asterisk." (defun rcirc-browse-url-at-point (point) "Send URL at point to `browse-url'." (interactive "d") - (let ((beg (previous-single-property-change point 'mouse-face)) + (let ((beg (previous-single-property-change (1+ point) 'mouse-face)) (end (next-single-property-change point 'mouse-face))) (browse-url (buffer-substring-no-properties beg end)))) diff --git a/lisp/net/zone-mode.el b/lisp/net/zone-mode.el deleted file mode 100644 index 441ef143f9..0000000000 --- a/lisp/net/zone-mode.el +++ /dev/null @@ -1,120 +0,0 @@ -;;; zone-mode.el --- major mode for editing DNS zone files - -;; Copyright (C) 1998, 2002, 2003, 2004, 2005, -;; 2006 Free Software Foundation, Inc. - -;; Author: John Heidemann <[email protected]> -;; Keywords: DNS, languages - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;; -;;; See the comments in ``define-derived-mode zone-mode'' -;;; (the last function in this file) -;;; for what this mode is and how to use it automatically. -;;; - -;;; -;;; Credits: -;;; Zone-mode was written by John Heidemann <[email protected]>, -;;; with bug fixes from Simon Leinen <[email protected]>. -;;; - -;;; Code: - -(defun zone-mode-update-serial () - "Update the serial number in a zone." - (interactive) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "\\b\\([0-9]+\\)\\([0-9][0-9]\\)\\([ \t]+;[ \t]+[Ss]erial\\)" (point-max) t) - (let* ((old-date (match-string 1)) - (old-seq (match-string 2)) - (old-seq-num (string-to-number (match-string 2))) - (old-flag (match-string 3)) - (cur-date (format-time-string "%Y%m%d")) - (new-seq - (cond - ((not (string= old-date cur-date)) - "00") ;; reset sequence number - ((>= old-seq-num 99) - (error "Serial number's sequence cannot increment beyond 99")) - (t - (format "%02d" (1+ old-seq-num))))) - (old-serial (concat old-date old-seq)) - (new-serial (concat cur-date new-seq))) - (if (string-lessp new-serial old-serial) - (error "Serial numbers want to move backwards from %s to %s" old-serial new-serial) - (replace-match (concat cur-date new-seq old-flag) t t)))))) - -;;;###autoload -(defun zone-mode-update-serial-hook () - "Update the serial number in a zone if the file was modified." - (interactive) - (if (buffer-modified-p (current-buffer)) - (zone-mode-update-serial)) - nil ;; so we can run from write-file-hooks - ) - -(defvar zone-mode-syntax-table nil - "Zone-mode's syntax table.") - -(defun zone-mode-load-time-setup () - "Initialize `zone-mode' stuff." - (setq zone-mode-syntax-table (make-syntax-table)) - (modify-syntax-entry ?\; "<" zone-mode-syntax-table) - (modify-syntax-entry ?\n ">" zone-mode-syntax-table)) - -;;;###autoload -(define-derived-mode zone-mode fundamental-mode "zone" - "A mode for editing DNS zone files. - -Zone-mode does two things: - - - automatically update the serial number for a zone - when saving the file - - - fontification" - - (add-hook 'write-file-functions 'zone-mode-update-serial-hook nil t) - - (if (null zone-mode-syntax-table) - (zone-mode-load-time-setup)) ;; should have been run at load-time - - ;; font-lock support: - (set-syntax-table zone-mode-syntax-table) - (make-local-variable 'comment-start) - (setq comment-start ";") - (make-local-variable 'comment-start-skip) - ;; Look within the line for a ; following an even number of backslashes - ;; after either a non-backslash or the line beginning. - (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+[ \t]*") - (make-local-variable 'comment-column) - (setq comment-column 40) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults - '(nil nil nil nil beginning-of-line))) - -(zone-mode-load-time-setup) - -(provide 'zone-mode) - -;;; arch-tag: 6a2940ef-fd4f-4de7-b979-b027b09821fe -;;; zone-mode.el ends here diff --git a/lisp/newcomment.el b/lisp/newcomment.el index 5dfa1eb895..0cf0160afb 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el @@ -299,7 +299,7 @@ the variables are properly set." (substring comment-start 1))) ;; Hasn't been necessary yet. ;; (unless (string-match comment-start-skip comment-continue) - ;; (kill-local-variable 'comment-continue)) + ;; (kill-local-variable 'comment-continue)) ) ;; comment-skip regexps (unless (and comment-start-skip @@ -599,11 +599,16 @@ If CONTINUE is non-nil, use the `comment-continue' markers if any." (if (and other (<= other max) (> other min)) ;; There is a comment and it's in the range: bingo. (setq indent other)))))))) + ;; Update INDENT to leave at least one space + ;; after other nonwhite text on the line. + (save-excursion + (skip-chars-backward " \t") + (unless (bolp) + (setq indent (max indent (1+ (current-column)))))) + ;; If that's different from comment's current position, change it. (unless (= (current-column) indent) - ;; If that's different from current, change it. (delete-region (point) (progn (skip-chars-backward " \t") (point))) - (indent-to (if (bolp) indent - (max indent (1+ (current-column))))))) + (indent-to indent))) (goto-char cpos) (set-marker cpos nil)))) @@ -764,7 +769,7 @@ comment markers." (box-equal nil)) ;Whether we might be using `=' for boxes. (save-restriction (narrow-to-region spt ept) - + ;; Remove the comment-start. (goto-char ipt) (skip-syntax-backward " ") @@ -793,7 +798,7 @@ comment markers." ;; If there's something left but it doesn't look like ;; a comment-start any more, just remove it. (delete-region (point-min) (point)))) - + ;; Remove the end-comment (and leading padding and such). (goto-char (point-max)) (comment-enter-backward) ;; Check for special `=' used sometimes in comment-box. @@ -1057,11 +1062,13 @@ The strings used as comment starts are built from lines (nth 3 style)))))) +;;;###autoload (defun comment-box (beg end &optional arg) "Comment out the BEG .. END region, putting it inside a box. The numeric prefix ARG specifies how many characters to add to begin- and end- comment markers additionally to what `comment-add' already specifies." (interactive "*r\np") + (comment-normalize-vars) (let ((comment-style (if (cadr (assoc comment-style comment-styles)) 'box-multi 'box))) (comment-region beg end (+ comment-add arg)))) diff --git a/lisp/pcvs-parse.el b/lisp/pcvs-parse.el index 0193939606..bd49312653 100644 --- a/lisp/pcvs-parse.el +++ b/lisp/pcvs-parse.el @@ -285,7 +285,8 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'." (and (cvs-or (cvs-match "warning: \\(.*\\) is not (any longer) pertinent$" (file 1)) - (cvs-match "\\(.*\\) is no longer in the repository$" (file 1))) + (cvs-match "`\\(.*\\)' is no longer in the repository$" (file 1)) + (cvs-match "\\(.*\\) is no longer in the repository$" (file 1))) (cvs-parsed-fileinfo (if dont-change-disc '(NEED-UPDATE . REMOVED) 'DEAD) file)) diff --git a/lisp/pcvs-util.el b/lisp/pcvs-util.el index cb18fc83d5..84ce2e117b 100644 --- a/lisp/pcvs-util.el +++ b/lisp/pcvs-util.el @@ -126,7 +126,9 @@ with `create-file-buffer' and will probably get another name than NAME. In such a case, the search for another buffer with the same name doesn't use the buffer name but the buffer's `list-buffers-directory' variable. If NOREUSE is non-nil, always return a new buffer." - (or (and (not (file-name-absolute-p name)) (get-buffer-create name)) + (or (and (not (file-name-absolute-p name)) + (if noreuse (generate-new-buffer name) + (get-buffer-create name))) (unless noreuse (dolist (buf (buffer-list)) (with-current-buffer buf diff --git a/lisp/pcvs.el b/lisp/pcvs.el index 89aeef53b8..a9105227bf 100644 --- a/lisp/pcvs.el +++ b/lisp/pcvs.el @@ -2287,7 +2287,7 @@ this file, or a list of arguments to send to the program." (interactive "DNew repository: ") (if (or (file-directory-p (expand-file-name "CVSROOT" newroot)) (y-or-n-p (concat "Warning: no CVSROOT found inside repository." - " Change cvs-cvsroot anyhow?"))) + " Change cvs-cvsroot anyhow? "))) (setq cvs-cvsroot newroot))) ;;;; diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el index dca6fa16df..f45bb2fe52 100644 --- a/lisp/progmodes/gdb-ui.el +++ b/lisp/progmodes/gdb-ui.el @@ -115,6 +115,7 @@ address for root variables.") (defvar gdb-main-file nil "Source file from which program execution begins.") (defvar gud-old-arrow nil) (defvar gdb-overlay-arrow-position nil) +(defvar gdb-stack-position nil) (defvar gdb-server-prefix nil) (defvar gdb-flush-pending-output nil) (defvar gdb-location-alist nil @@ -314,14 +315,14 @@ Also display the main routine in the disassembly buffer if present." "Nil means just pop up the GUD buffer unless `gdb-show-main' is t. In this case it starts with two windows: one displaying the GUD buffer and the other with the source file with the main routine -of the inferior. Non-nil means display the layout shown for +of the debugged program. Non-nil means display the layout shown for `gdba'." :type 'boolean :group 'gud :version "22.1") (defcustom gdb-use-separate-io-buffer nil - "Non-nil means display output from the inferior in a separate buffer." + "Non-nil means display output from the debugged program in a separate buffer." :type 'boolean :group 'gud :version "22.1") @@ -353,14 +354,14 @@ With arg, display additional buffers iff arg is positive." (error nil)))) (defun gdb-use-separate-io-buffer (arg) - "Toggle separate IO for inferior. + "Toggle separate IO for debugged program. With arg, use separate IO iff arg is positive." (interactive "P") (setq gdb-use-separate-io-buffer (if (null arg) (not gdb-use-separate-io-buffer) (> (prefix-numeric-value arg) 0))) - (message (format "Separate inferior IO %sabled" + (message (format "Separate IO %sabled" (if gdb-use-separate-io-buffer "en" "dis"))) (if (and gud-comint-buffer (buffer-name gud-comint-buffer)) @@ -383,8 +384,7 @@ With arg, use separate IO iff arg is positive." (list t nil) nil "-c" (concat gdb-cpp-define-alist-program " " gdb-cpp-define-alist-flags))))) - (define-list (split-string output "\n" t)) - (name)) + (define-list (split-string output "\n" t)) (name)) (setq gdb-define-alist nil) (dolist (define define-list) (setq name (nth 1 (split-string define "[( ]"))) @@ -1030,7 +1030,7 @@ The key should be one of the cars in `gdb-buffer-rules-assoc'." (minibuffer . nil))) (defun gdb-frame-separate-io-buffer () - "Display IO of inferior in a new frame." + "Display IO of debugged program in a new frame." (interactive) (if gdb-use-separate-io-buffer (let ((special-display-regexps (append special-display-regexps '(".*"))) @@ -1290,12 +1290,14 @@ not GDB." (progn (setq gud-running t) (setq gdb-inferior-status "running") + (setq gdb-signalled nil) (gdb-force-mode-line-update (propertize gdb-inferior-status 'face font-lock-type-face)) (gdb-remove-text-properties) (setq gud-old-arrow gud-overlay-arrow-position) (setq gud-overlay-arrow-position nil) (setq gdb-overlay-arrow-position nil) + (setq gdb-stack-position nil) (if gdb-use-separate-io-buffer (setq gdb-output-sink 'inferior)))) (t @@ -1330,6 +1332,7 @@ directives." (setq gdb-active-process nil) (setq gud-overlay-arrow-position nil) (setq gdb-overlay-arrow-position nil) + (setq gdb-stack-position nil) (setq gud-old-arrow nil) (setq gdb-inferior-status "exited") (gdb-force-mode-line-update @@ -1358,6 +1361,23 @@ directives." :type 'boolean :version "22.1") +(defcustom gdb-find-source-frame nil + "Non-nil means try to find a source frame further up stack e.g after signal." + :group 'gud + :type 'boolean + :version "22.1") + +(defun gdb-find-source-frame (arg) + "Toggle trying to find a source frame further up stack. +With arg, look for a source frame further up stack iff arg is positive." + (interactive "P") + (setq gdb-find-source-frame + (if (null arg) + (not gdb-find-source-frame) + (> (prefix-numeric-value arg) 0))) + (message (format "Looking for source frame %sabled" + (if gdb-find-source-frame "en" "dis")))) + (defun gdb-stopped (ignored) "An annotation handler for `stopped'. It is just like `gdb-stopping', except that if we already set the output @@ -1371,14 +1391,15 @@ sink to `user' in `gdb-stopping', that is fine." (if gdb-same-frame (gdb-display-gdb-buffer) (gdb-frame-gdb-buffer)) + (if gdb-find-source-frame ;;Try to find source further up stack e.g after signal. - (setq gdb-look-up-stack - (if (gdb-get-buffer 'gdb-stack-buffer) - 'keep - (progn - (gdb-get-buffer-create 'gdb-stack-buffer) - (gdb-invalidate-frames) - 'delete))))) + (setq gdb-look-up-stack + (if (gdb-get-buffer 'gdb-stack-buffer) + 'keep + (progn + (gdb-get-buffer-create 'gdb-stack-buffer) + (gdb-invalidate-frames) + 'delete)))))) (unless (member gdb-inferior-status '("exited" "signal")) (setq gdb-inferior-status "stopped") (gdb-force-mode-line-update @@ -1754,52 +1775,69 @@ static char *magick[] = { (gdb-remove-breakpoint-icons (point-min) (point-max))))) (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer) (save-excursion + (let ((buffer-read-only nil)) (goto-char (point-min)) (while (< (point) (- (point-max) 1)) (forward-line 1) - (if (looking-at "[^\t].*?breakpoint") + (if (looking-at gdb-breakpoint-regexp) (progn - (looking-at "\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+\\(.\\)") (setq bptno (match-string 1)) (setq flag (char-after (match-beginning 2))) - (beginning-of-line) - (if (re-search-forward " in \\(.*\\) at\\s-+" nil t) - (progn - (let ((buffer-read-only nil)) - (add-text-properties (match-beginning 1) (match-end 1) - '(face font-lock-function-name-face))) - (looking-at "\\(\\S-+\\):\\([0-9]+\\)") - (let ((line (match-string 2)) (buffer-read-only nil) - (file (match-string 1))) - (add-text-properties (line-beginning-position) - (line-end-position) - '(mouse-face highlight - help-echo "mouse-2, RET: visit breakpoint")) - (unless (file-exists-p file) - (setq file (cdr (assoc bptno gdb-location-alist)))) - (if (and file - (not (string-equal file "File not found"))) - (with-current-buffer - (find-file-noselect file 'nowarn) - (set (make-local-variable 'gud-minor-mode) - 'gdba) - (set (make-local-variable 'tool-bar-map) - gud-tool-bar-map) - ;; Only want one breakpoint icon at each - ;; location. - (save-excursion - (goto-line (string-to-number line)) - (gdb-put-breakpoint-icon (eq flag ?y) bptno))) - (gdb-enqueue-input - (list - (concat gdb-server-prefix "list " - (match-string-no-properties 1) ":1\n") - 'ignore)) - (gdb-enqueue-input - (list (concat gdb-server-prefix "info source\n") - `(lambda () (gdb-get-location - ,bptno ,line ,flag)))))))))) - (end-of-line))))) + (add-text-properties + (match-beginning 2) (match-end 2) + (if (eq flag ?y) + '(face font-lock-warning-face) + '(face font-lock-type-face))) + (let ((bl (point)) + (el (line-end-position))) + (if (re-search-forward " in \\(.*\\) at\\s-+" el t) + (progn + (add-text-properties + (match-beginning 1) (match-end 1) + '(face font-lock-function-name-face)) + (looking-at "\\(\\S-+\\):\\([0-9]+\\)") + (let ((line (match-string 2)) + (file (match-string 1))) + (add-text-properties bl el + '(mouse-face highlight + help-echo "mouse-2, RET: visit breakpoint")) + (unless (file-exists-p file) + (setq file (cdr (assoc bptno gdb-location-alist)))) + (if (and file + (not (string-equal file "File not found"))) + (with-current-buffer + (find-file-noselect file 'nowarn) + (set (make-local-variable 'gud-minor-mode) + 'gdba) + (set (make-local-variable 'tool-bar-map) + gud-tool-bar-map) + ;; Only want one breakpoint icon at each + ;; location. + (save-excursion + (goto-line (string-to-number line)) + (gdb-put-breakpoint-icon (eq flag ?y) bptno))) + (gdb-enqueue-input + (list + (concat gdb-server-prefix "list " + (match-string-no-properties 1) ":1\n") + 'ignore)) + (gdb-enqueue-input + (list (concat gdb-server-prefix "info source\n") + `(lambda () (gdb-get-location + ,bptno ,line ,flag))))))) + (if (re-search-forward + "<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>" + el t) + (add-text-properties + (match-beginning 1) (match-end 1) + '(face font-lock-function-name-face)) + (end-of-line) + (re-search-backward "\\s-\\(\\S-*\\)" + bl t) + (add-text-properties + (match-beginning 1) (match-end 1) + '(face font-lock-variable-name-face))))))) + (end-of-line)))))) (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom))) (defun gdb-mouse-set-clear-breakpoint (event) @@ -2002,8 +2040,14 @@ static char *magick[] = { (goto-char bl) (when (looking-at "^#\\([0-9]+\\)") (when (string-equal (match-string 1) gdb-frame-number) - (put-text-property bl (+ bl 4) - 'face '(:inverse-video t))) + (if (> (car (window-fringes)) 0) + (progn + (or gdb-stack-position + (setq gdb-stack-position (make-marker))) + (set-marker gdb-stack-position (point))) + (set-marker gdb-stack-position nil) + (put-text-property bl (+ bl 4) + 'face '(:inverse-video t)))) (when (re-search-forward (concat (if (string-equal (match-string 1) "0") "" " in ") @@ -2036,9 +2080,10 @@ static char *magick[] = { (setq gdb-look-up-stack nil)) (defun gdb-set-hollow () - (with-current-buffer (gud-find-file (car gud-last-last-frame)) - (setq fringe-indicator-alist - '((overlay-arrow . hollow-right-triangle))))) + (if gud-last-last-frame + (with-current-buffer (gud-find-file (car gud-last-last-frame)) + (setq fringe-indicator-alist + '((overlay-arrow . hollow-right-triangle)))))) (defun gdb-stack-buffer-name () (with-current-buffer gud-comint-buffer @@ -2073,6 +2118,8 @@ static char *magick[] = { (kill-all-local-variables) (setq major-mode 'gdb-frames-mode) (setq mode-name "Frames") + (setq gdb-stack-position nil) + (add-to-list 'overlay-arrow-variable-list 'gdb-stack-position) (setq buffer-read-only t) (use-local-map gdb-frames-mode-map) (run-mode-hooks 'gdb-frames-mode-hook) @@ -2524,18 +2571,18 @@ corresponding to the mode line clicked." 'local-map (gdb-make-header-line-mouse-map 'mouse-1 - #'(lambda () (interactive) - (let ((gdb-memory-address - ;; Let GDB do the arithmetic. - (concat - gdb-memory-address " - " - (number-to-string - (* gdb-memory-repeat-count - (cond ((string= gdb-memory-unit "b") 1) - ((string= gdb-memory-unit "h") 2) - ((string= gdb-memory-unit "w") 4) - ((string= gdb-memory-unit "g") 8))))))) - (gdb-invalidate-memory))))) + (lambda () (interactive) + (let ((gdb-memory-address + ;; Let GDB do the arithmetic. + (concat + gdb-memory-address " - " + (number-to-string + (* gdb-memory-repeat-count + (cond ((string= gdb-memory-unit "b") 1) + ((string= gdb-memory-unit "h") 2) + ((string= gdb-memory-unit "w") 4) + ((string= gdb-memory-unit "g") 8))))))) + (gdb-invalidate-memory))))) "|" (propertize "+" 'face font-lock-warning-face @@ -2543,9 +2590,9 @@ corresponding to the mode line clicked." 'mouse-face 'mode-line-highlight 'local-map (gdb-make-header-line-mouse-map 'mouse-1 - #'(lambda () (interactive) - (let ((gdb-memory-address nil)) - (gdb-invalidate-memory))))) + (lambda () (interactive) + (let ((gdb-memory-address nil)) + (gdb-invalidate-memory))))) "]: " (propertize gdb-memory-address 'face font-lock-warning-face @@ -2592,8 +2639,11 @@ corresponding to the mode line clicked." (defun gdb-frame-memory-buffer () "Display memory contents in a new frame." (interactive) - (let ((special-display-regexps (append special-display-regexps '(".*"))) - (special-display-frame-alist gdb-frame-parameters)) + (let* ((special-display-regexps (append special-display-regexps '(".*"))) + (special-display-frame-alist + (cons '(left-fringe . 0) + (cons '(right-fringe . 0) + (cons '(width . 83) gdb-frame-parameters))))) (display-buffer (gdb-get-buffer-create 'gdb-memory-buffer)))) @@ -2610,13 +2660,14 @@ corresponding to the mode line clicked." (defvar gdb-locals-watch-map (let ((map (make-sparse-keymap))) - (define-key map "\r" '(lambda () (interactive) - (beginning-of-line) - (gud-watch))) - (define-key map [mouse-2] '(lambda (event) (interactive "e") - (mouse-set-point event) - (beginning-of-line) - (gud-watch))) + (suppress-keymap map) + (define-key map "\r" (lambda () (interactive) + (beginning-of-line) + (gud-watch))) + (define-key map [mouse-2] (lambda (event) (interactive "e") + (mouse-set-point event) + (beginning-of-line) + (gud-watch))) map) "Keymap to create watch expression of a complex data type local variable.") @@ -2739,7 +2790,7 @@ corresponding to the mode line clicked." (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer)) (define-key menu [threads] '("Threads" . gdb-display-threads-buffer)) (define-key menu [inferior] - '(menu-item "Inferior IO" gdb-display-separate-io-buffer + '(menu-item "Separate IO" gdb-display-separate-io-buffer :enable gdb-use-separate-io-buffer)) (define-key menu [memory] '("Memory" . gdb-display-memory-buffer)) (define-key menu [registers] '("Registers" . gdb-display-registers-buffer)) @@ -2758,7 +2809,7 @@ corresponding to the mode line clicked." (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer)) (define-key menu [memory] '("Memory" . gdb-frame-memory-buffer)) (define-key menu [inferior] - '(menu-item "Inferior IO" gdb-frame-separate-io-buffer + '(menu-item "Separate IO" gdb-frame-separate-io-buffer :enable gdb-use-separate-io-buffer)) (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer)) (define-key menu [disassembly] '("Disassembly" . gdb-frame-assembler-buffer)) @@ -2771,10 +2822,15 @@ corresponding to the mode line clicked." (define-key gud-menu-map [ui] `(menu-item (if (eq gud-minor-mode 'gdba) "GDB-UI" "GDB-MI") ,menu :visible (memq gud-minor-mode '(gdbmi gdba)))) + (define-key menu [gdb-find-source-frame] + '(menu-item "Look For Source Frame" gdb-find-source-frame + :visible (eq gud-minor-mode 'gdba) + :help "Toggle look for source frame." + :button (:toggle . gdb-find-source-frame))) (define-key menu [gdb-use-separate-io] - '(menu-item "Separate inferior IO" gdb-use-separate-io-buffer + '(menu-item "Separate IO" gdb-use-separate-io-buffer :visible (eq gud-minor-mode 'gdba) - :help "Toggle separate IO for inferior." + :help "Toggle separate IO for debugged program." :button (:toggle . gdb-use-separate-io-buffer))) (define-key menu [gdb-many-windows] '(menu-item "Display Other Windows" gdb-many-windows @@ -2871,12 +2927,13 @@ Kills the gdb buffers, and resets variables and the source buffers." (setq gud-minor-mode nil) (kill-local-variable 'tool-bar-map) (kill-local-variable 'gdb-define-alist)))))) - (when (markerp gdb-overlay-arrow-position) - (move-marker gdb-overlay-arrow-position nil) - (setq gdb-overlay-arrow-position nil)) + (setq gdb-overlay-arrow-position nil) (setq overlay-arrow-variable-list (delq 'gdb-overlay-arrow-position overlay-arrow-variable-list)) (setq fringe-indicator-alist '((overlay-arrow . right-triangle))) + (setq gdb-stack-position nil) + (setq overlay-arrow-variable-list + (delq 'gdb-stack-position overlay-arrow-variable-list)) (if (boundp 'speedbar-frame) (speedbar-timer-fn)) (setq gud-running nil) (setq gdb-active-process nil) @@ -3098,8 +3155,7 @@ BUFFER nil or omitted means use the current buffer." '((overlay-arrow . hollow-right-triangle)))) (or gdb-overlay-arrow-position (setq gdb-overlay-arrow-position (make-marker))) - (set-marker gdb-overlay-arrow-position - (point) (current-buffer)))))) + (set-marker gdb-overlay-arrow-position (point)))))) ;; remove all breakpoint-icons in assembler buffer before updating. (gdb-remove-breakpoint-icons (point-min) (point-max)))) (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer) @@ -3460,10 +3516,32 @@ in_scope=\"\\(.*?\\)\".*?}") (defvar gdb-locals-watch-map-1 (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (define-key map "\r" 'gud-watch) (define-key map [mouse-2] 'gud-watch) map) "Keymap to create watch expression of a complex data type local variable.") +(defvar gdb-edit-locals-map-1 + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (define-key map "\r" 'gdb-edit-locals-value) + (define-key map [mouse-2] 'gdb-edit-locals-value) + map) + "Keymap to edit value of a simple data type local variable.") + +(defun gdb-edit-locals-value (&optional event) + "Assign a value to a variable displayed in the locals buffer." + (interactive (list last-input-event)) + (save-excursion + (if event (posn-set-point (event-end event))) + (beginning-of-line) + (let* ((var (current-word)) + (value (read-string (format "New value (%s): " var)))) + (gdb-enqueue-input + (list (concat gdb-server-prefix"set variable " var " = " value "\n") + 'ignore))))) + ;; Dont display values of arrays or structures. ;; These can be expanded using gud-watch. (defun gdb-stack-list-locals-handler () @@ -3491,20 +3569,26 @@ in_scope=\"\\(.*?\\)\".*?}") (let* ((window (get-buffer-window buf 0)) (start (window-start window)) (p (window-point window)) - (buffer-read-only nil)) + (buffer-read-only nil) (name) (value)) (erase-buffer) (dolist (local locals-list) (setq name (car local)) - (if (or (not (nth 2 local)) - (string-match "^\\0x" (nth 2 local))) + (setq value (nth 2 local)) + (if (or (not value) + (string-match "^\\0x" value)) (add-text-properties 0 (length name) `(mouse-face highlight help-echo "mouse-2: create watch expression" local-map ,gdb-locals-watch-map-1) - name)) + name) + (add-text-properties 0 (length value) + `(mouse-face highlight + help-echo "mouse-2: edit value" + local-map ,gdb-edit-locals-map-1) + value)) (insert (concat name "\t" (nth 1 local) - "\t" (nth 2 local) "\n"))) + "\t" value "\n"))) (set-window-start window start) (set-window-point window p)))))))) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index e7d85910a6..48692f9742 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -335,7 +335,7 @@ This variable's value takes effect when `grep-compute-defaults' is called.") (defvar grep-find-use-xargs nil "Whether \\[grep-find] uses the `xargs' utility by default. -If nil, it uses `find -exec'; if `gnu', it uses `find -print0' and `xargs -0'; +If `exec', it uses `find -exec'; if `gnu', it uses `find -print0' and `xargs -0'; if not nil and not `gnu', it uses `find -print' and `xargs'. This variable's value takes effect when `grep-compute-defaults' is called.") @@ -419,21 +419,29 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'." (format "%s <C> %s <R> <F>" grep-program grep-options))) (unless grep-find-use-xargs (setq grep-find-use-xargs - (if (and - (grep-probe find-program `(nil nil nil ,null-device "-print0")) - (grep-probe "xargs" `(nil nil nil "-0" "-e" "echo"))) - 'gnu))) + (cond + ((and + (grep-probe find-program `(nil nil nil ,null-device "-print0")) + (grep-probe "xargs" `(nil nil nil "-0" "-e" "echo"))) + 'gnu) + (t + 'exec)))) (unless grep-find-command (setq grep-find-command (cond ((eq grep-find-use-xargs 'gnu) (format "%s . -type f -print0 | xargs -0 -e %s" find-program grep-command)) - (grep-find-use-xargs + ((eq grep-find-use-xargs 'exec) + (let ((cmd0 (format "%s . -type f -exec %s" + find-program grep-command))) + (cons + (format "%s {} %s %s" + cmd0 null-device + (shell-quote-argument ";")) + (1+ (length cmd0))))) + (t (format "%s . -type f -print | xargs %s" - find-program grep-command)) - (t (cons (format "%s . -type f -exec %s {} %s \\;" - find-program grep-command null-device) - (+ 22 (length grep-command))))))) + find-program grep-command))))) (unless grep-find-template (setq grep-find-template (let ((gcmd (format "%s <C> %s <R>" @@ -441,11 +449,13 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'." (cond ((eq grep-find-use-xargs 'gnu) (format "%s . <X> -type f <F> -print0 | xargs -0 -e %s" find-program gcmd)) - (grep-find-use-xargs + ((eq grep-find-use-xargs 'exec) + (format "%s . <X> -type f <F> -exec %s {} %s %s" + find-program gcmd null-device + (shell-quote-argument ";"))) + (t (format "%s . <X> -type f <F> -print | xargs %s" - find-program gcmd)) - (t (format "%s . <X> -type f <F> -exec %s {} %s \\;" - find-program gcmd null-device)))))))) + find-program gcmd)))))))) (unless (or (not grep-highlight-matches) (eq grep-highlight-matches t)) (setq grep-highlight-matches (with-temp-buffer @@ -455,34 +465,48 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'." (search-forward "--color" nil t)) t))))) +(defun grep-tag-default () + (or (and transient-mark-mode mark-active + (/= (point) (mark)) + (buffer-substring-no-properties (point) (mark))) + (funcall (or find-tag-default-function + (get major-mode 'find-tag-default-function) + 'find-tag-default)) + "")) + (defun grep-default-command () - (let ((tag-default - (shell-quote-argument - (or (funcall (or find-tag-default-function - (get major-mode 'find-tag-default-function) - 'find-tag-default)) - ""))) + "Compute the default grep command for C-u M-x grep to offer." + (let ((tag-default (shell-quote-argument (grep-tag-default))) + ;; This a regexp to match single shell arguments. + ;; Could someone please add comments explaining it? (sh-arg-re "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)") (grep-default (or (car grep-history) grep-command))) - ;; Replace the thing matching for with that around cursor. + ;; In the default command, find the arg that specifies the pattern. (when (or (string-match (concat "[^ ]+\\s +\\(?:-[^ ]+\\s +\\)*" sh-arg-re "\\(\\s +\\(\\S +\\)\\)?") grep-default) ;; If the string is not yet complete. (string-match "\\(\\)\\'" grep-default)) - (unless (or (not (stringp buffer-file-name)) - (when (match-beginning 2) - (save-match-data - (string-match - (wildcard-to-regexp - (file-name-nondirectory - (match-string 3 grep-default))) - (file-name-nondirectory buffer-file-name))))) - (setq grep-default (concat (substring grep-default - 0 (match-beginning 2)) - " *." - (file-name-extension buffer-file-name)))) + ;; Maybe we will replace the pattern with the default tag. + ;; But first, maybe replace the file name pattern. + (condition-case nil + (unless (or (not (stringp buffer-file-name)) + (when (match-beginning 2) + (save-match-data + (string-match + (wildcard-to-regexp + (file-name-nondirectory + (match-string 3 grep-default))) + (file-name-nondirectory buffer-file-name))))) + (setq grep-default (concat (substring grep-default + 0 (match-beginning 2)) + " *." + (file-name-extension buffer-file-name)))) + ;; In case wildcard-to-regexp gets an error + ;; from invalid data. + (error nil)) + ;; Now replace the pattern with the default tag. (replace-match tag-default t t grep-default 1)))) @@ -590,15 +614,11 @@ substitution string. Note dynamic scoping of variables.") (defun grep-read-regexp () "Read regexp arg for interactive grep." - (let ((default - (or (funcall (or find-tag-default-function - (get major-mode 'find-tag-default-function) - 'find-tag-default)) - ""))) + (let ((default (grep-tag-default))) (read-string (concat "Search for" (if (and default (> (length default) 0)) - (format " (default %s): " default) ": ")) + (format " (default \"%s\"): " default) ": ")) nil 'grep-regexp-history default))) (defun grep-read-files (regexp) @@ -620,7 +640,9 @@ substitution string. Note dynamic scoping of variables.") (cdr alias))) (and fn (let ((ext (file-name-extension fn))) - (and ext (concat "*." ext)))))) + (and ext (concat "*." ext)))) + (car grep-files-history) + (car (car grep-files-aliases)))) (files (read-string (concat "Search for \"" regexp "\" in files" @@ -724,18 +746,26 @@ This command shares argument histories with \\[lgrep] and \\[grep-find]." (let ((command (grep-expand-template grep-find-template regexp - (concat "\\( -name " + (concat (shell-quote-argument "(") + " -name " (mapconcat #'shell-quote-argument (split-string files) " -o -name ") - " \\)") + " " + (shell-quote-argument ")")) dir (and grep-find-ignored-directories - (concat "\\( -path '*/" - (mapconcat #'identity + (concat (shell-quote-argument "(") + ;; we should use shell-quote-argument here + " -path " + (mapconcat #'(lambda (dir) + (shell-quote-argument + (concat "*/" dir))) grep-find-ignored-directories - "' -o -path '*/") - "' \\) -prune -o "))))) + " -o -path ") + " " + (shell-quote-argument ")") + " -prune -o "))))) (when command (if current-prefix-arg (setq command diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 97e54135a6..84b40e8ba8 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -3180,7 +3180,15 @@ class of the file (using s to separate nested class ids)." (defvar gdb-script-font-lock-syntactic-keywords '(("^document\\s-.*\\(\n\\)" (1 "< b")) ;; It would be best to change the \n in front, but it's more difficult. - ("^en\\(d\\)\\>" (1 "> b")))) + ("^end\\>" + (0 (progn + (unless (eq (match-beginning 0) (point-min)) + (put-text-property (1- (match-beginning 0)) (match-beginning 0) + 'syntax-table (eval-when-compile + (string-to-syntax "> b"))) + (put-text-property (1- (match-beginning 0)) (match-end 0) + 'font-lock-multiline t) + nil)))))) (defun gdb-script-font-lock-syntactic-face (state) (cond diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 9636f7eaea..c38a6e82f8 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -9,19 +9,19 @@ ;; This file is part of GNU Emacs. -;; This file is free software; you can redistribute it and/or modify +;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. -;; This file is distributed in the hope that it will be useful, +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -32,41 +32,44 @@ ;; maintained with Python. That isn't covered by an FSF copyright ;; assignment, unlike this code, and seems not to be well-maintained ;; for Emacs (though I've submitted fixes). This mode is rather -;; simpler and is, perhaps, better in other ways. In particular, -;; using the syntax functions with text properties maintained by -;; font-lock should make it more correct with arbitrary string and -;; comment contents. +;; simpler and is better in other ways. In particular, using the +;; syntax functions with text properties maintained by font-lock makes +;; it more correct with arbitrary string and comment contents. ;; This doesn't implement all the facilities of python-mode.el. Some ;; just need doing, e.g. catching exceptions in the inferior Python ;; buffer (but see M-x pdb for debugging). [Actually, the use of -;; `compilation-minor-mode' now is probably enough for that.] Others -;; don't seem appropriate. For instance, `forward-into-nomenclature' -;; should be done separately, since it's not specific to Python, and -;; I've installed a minor mode to do the job properly in Emacs 22. +;; `compilation-shell-minor-mode' now is probably enough for that.] +;; Others don't seem appropriate. For instance, +;; `forward-into-nomenclature' should be done separately, since it's +;; not specific to Python, and I've installed a minor mode to do the +;; job properly in Emacs 23. [CC mode 5.31 contains an incompatible +;; feature, `c-subword-mode' which is intended to have a similar +;; effect, but actually only affects word-oriented keybindings.] + ;; Other things seem more natural or canonical here, e.g. the ;; {beginning,end}-of-defun implementation dealing with nested -;; definitions, and the inferior mode following `cmuscheme'. The +;; definitions, and the inferior mode following `cmuscheme'. (The ;; inferior mode can find the source of errors from -;; `python-send-region' & al via `compilation-minor-mode'. Successive -;; TABs cycle between possible indentations for the line. There is -;; symbol completion using lookup in Python. +;; `python-send-region' & al via `compilation-shell-minor-mode'.) +;; There is (limited) symbol completion using lookup in Python and +;; Eldoc support also using the inferior process. Successive TABs +;; cycle between possible indentations for the line. -;; Even where it has similar facilities, this is incompatible with -;; python-mode.el in various respects. For instance, various key -;; bindings are changed to obey Emacs conventions, and things like -;; marking blocks and `beginning-of-defun' behave differently. +;; Even where it has similar facilities, this mode is incompatible +;; with python-mode.el in some respects. For instance, various key +;; bindings are changed to obey Emacs conventions. ;; TODO: See various Fixmes below. ;;; Code: -;; It's messy to autoload the relevant comint functions so that comint -;; is only required when inferior Python is used. -(require 'comint) (eval-when-compile + (require 'cl) (require 'compile) - (autoload 'info-lookup-maybe-add-help "info-look")) + (require 'comint)) + +(autoload 'comint-mode "comint") (defgroup python nil "Silly walks in the Python language." @@ -84,31 +87,37 @@ ;;;; Font lock (defvar python-font-lock-keywords - `(,(rx (and word-start - ;; From v 2.3 reference. - ;; def and class dealt with separately below - (or "and" "assert" "break" "continue" "del" "elif" "else" - "except" "exec" "finally" "for" "from" "global" "if" - "import" "in" "is" "lambda" "not" "or" "pass" "print" - "raise" "return" "try" "while" "yield" - ;; Future keywords - "as" "None") - word-end)) - (,(rx (and word-start (group "class") (1+ space) (group (1+ word)))) - (1 font-lock-keyword-face) (2 font-lock-type-face)) - (,(rx (and word-start (group "def") (1+ space) (group (1+ word)))) - (1 font-lock-keyword-face) (2 font-lock-function-name-face)))) + `(,(rx symbol-start + ;; From v 2.4 reference. + ;; def and class dealt with separately below + (or "and" "assert" "break" "continue" "del" "elif" "else" + "except" "exec" "finally" "for" "from" "global" "if" + "import" "in" "is" "lambda" "not" "or" "pass" "print" + "raise" "return" "try" "while" "yield" + ;; Future keywords + "as" "None") + symbol-end) + ;; Definitions + (,(rx symbol-start (group "class") (1+ space) (group (1+ (or word ?_)))) + (1 font-lock-keyword-face) (2 font-lock-type-face)) + (,(rx symbol-start (group "def") (1+ space) (group (1+ (or word ?_)))) + (1 font-lock-keyword-face) (2 font-lock-function-name-face)) + ;; Top-level assignments are worth highlighting. + (,(rx line-start (group (1+ (or word ?_))) (0+ space) "=") + (1 font-lock-variable-name-face)) + (,(rx "@" (1+ (or word ?_))) ; decorators + (0 font-lock-preprocessor-face)))) (defconst python-font-lock-syntactic-keywords ;; Make outer chars of matching triple-quote sequences into generic ;; string delimiters. Fixme: Is there a better way? - `((,(rx (and (or line-start buffer-start (not (syntax escape))) ; avoid escaped - ; leading quote - (group (optional (any "uUrR"))) ; prefix gets syntax property - (optional (any "rR")) ; possible second prefix - (group (syntax string-quote)) ; maybe gets property - (backref 2) ; per first quote - (group (backref 2)))) ; maybe gets property + `((,(rx (or line-start buffer-start + (not (syntax escape))) ; avoid escaped leading quote + (group (optional (any "uUrR"))) ; prefix gets syntax property + (optional (any "rR")) ; possible second prefix + (group (syntax string-quote)) ; maybe gets property + (backref 2) ; per first quote + (group (backref 2))) ; maybe gets property (1 (python-quote-syntax 1)) (2 (python-quote-syntax 2)) (3 (python-quote-syntax 3))) @@ -132,6 +141,8 @@ Used for syntactic keywords. N is the match number (1, 2 or 3)." ;; x = ''' """ ' a ;; ''' ;; x '"""' x """ \"""" x + ;; Fixme: """""" goes wrong (due to syntax-ppss not getting the string + ;; fence context). (save-excursion (goto-char (match-beginning 0)) (cond @@ -140,19 +151,17 @@ Used for syntactic keywords. N is the match number (1, 2 or 3)." (let ((syntax (syntax-ppss))) (when (eq t (nth 3 syntax)) ; after unclosed fence (goto-char (nth 8 syntax)) ; fence position - ;; Skip any prefix. - (if (memq (char-after) '(?u ?U ?R ?r)) - (skip-chars-forward "uUrR")) + (skip-chars-forward "uUrR") ; skip any prefix ;; Is it a matching sequence? (if (eq (char-after) (char-after (match-beginning 2))) (eval-when-compile (string-to-syntax "|")))))) ;; Consider property for initial char, accounting for prefixes. - ((or (and (= n 2) ; not prefix + ((or (and (= n 2) ; leading quote (not prefix) (= (match-beginning 1) (match-end 1))) ; prefix is null (and (= n 1) ; prefix (/= (match-beginning 1) (match-end 1)))) ; non-empty (unless (eq 'string (syntax-ppss-context (syntax-ppss))) - (eval-when-compile (string-to-syntax "|")))) + (eval-when-compile (string-to-syntax "|")))) ;; Otherwise (we're in a non-matching string) the property is ;; nil, which is OK. ))) @@ -204,23 +213,37 @@ Used for syntactic keywords. N is the match number (1, 2 or 3)." (define-key map "\C-c\C-l" 'python-load-file) ; a la cmuscheme (substitute-key-definition 'complete-symbol 'python-complete-symbol map global-map) - ;; Fixme: Add :help to menu. + (define-key map "\C-c\C-i" 'python-find-imports) + (define-key map "\C-c\C-t" 'python-expand-template) (easy-menu-define python-menu map "Python Mode menu" - '("Python" - ["Shift region left" python-shift-left :active mark-active] - ["Shift region right" python-shift-right :active mark-active] + `("Python" + :help "Python-specific Features" + ["Shift region left" python-shift-left :active mark-active + :help "Shift by a single indentation step"] + ["Shift region right" python-shift-right :active mark-active + :help "Shift by a single indentation step"] "-" - ["Mark block" python-mark-block] + ["Mark block" python-mark-block + :help "Mark innermost block around point"] ["Mark def/class" mark-defun :help "Mark innermost definition around point"] "-" - ["Start of block" python-beginning-of-block] - ["End of block" python-end-of-block] + ["Start of block" python-beginning-of-block + :help "Go to start of innermost definition around point"] + ["End of block" python-end-of-block + :help "Go to end of innermost definition around point"] ["Start of def/class" beginning-of-defun :help "Go to start of innermost definition around point"] ["End of def/class" end-of-defun :help "Go to end of innermost definition around point"] "-" + ("Templates..." + :help "Expand templates for compound statements" + :filter (lambda (&rest junk) + (mapcar (lambda (elt) + (vector (car elt) (cdr elt) t)) + python-skeletons))) ; defined later + "-" ["Start interpreter" run-python :help "Run `inferior' Python in separate buffer"] ["Import/reload file" python-load-file @@ -233,12 +256,23 @@ Used for syntactic keywords. N is the match number (1, 2 or 3)." :help "Evaluate current definition in inferior Python session"] ["Switch to interpreter" python-switch-to-python :help "Switch to inferior Python buffer"] + ["Set default process" python-set-proc + :help "Make buffer's inferior process the default" + :active (buffer-live-p python-buffer)] ["Check file" python-check :help "Run pychecker"] ["Debugger" pdb :help "Run pdb under GUD"] "-" ["Help on symbol" python-describe-symbol - :help "Use pydoc on symbol at point"])) + :help "Use pydoc on symbol at point"] + ["Complete symbol" python-complete-symbol + :help "Complete (qualified) symbol before point"] + ["Update imports" python-find-imports + :help "Update list of top-level imports for completion"])) map)) +;; Fixme: add toolbar stuff for useful things like symbol help, send +;; region, at least. (Shouldn't be specific to Python, obviously.) +;; eric has items including: (un)indent, (un)comment, restart script, +;; run script, debug script; also things for profiling, unit testing. (defvar python-mode-syntax-table (let ((table (make-syntax-table))) @@ -263,7 +297,8 @@ Used for syntactic keywords. N is the match number (1, 2 or 3)." (defsubst python-in-string/comment () "Return non-nil if point is in a Python literal (a comment or string)." - (syntax-ppss-context (syntax-ppss))) + ;; We don't need to save the match data. + (nth 8 (syntax-ppss))) (defconst python-space-backslash-table (let ((table (copy-syntax-table python-mode-syntax-table))) @@ -273,13 +308,21 @@ Used for syntactic keywords. N is the match number (1, 2 or 3)." (defun python-skip-comments/blanks (&optional backward) "Skip comments and blank lines. -BACKWARD non-nil means go backwards, otherwise go forwards. Backslash is -treated as whitespace so that continued blank lines are skipped. -Doesn't move out of comments -- should be outside or at end of line." - (with-syntax-table python-space-backslash-table - (forward-comment (if backward - most-negative-fixnum - most-positive-fixnum)))) +BACKWARD non-nil means go backwards, otherwise go forwards. +Backslash is treated as whitespace so that continued blank lines +are skipped. Doesn't move out of comments -- should be outside +or at end of line." + (let ((arg (if backward + ;; If we're in a comment (including on the trailing + ;; newline), forward-comment doesn't move backwards out + ;; of it. Don't set the syntax table round this bit! + (let ((syntax (syntax-ppss))) + (if (nth 4 syntax) + (goto-char (nth 8 syntax))) + (- (point-max))) + (point-max)))) + (with-syntax-table python-space-backslash-table + (forward-comment arg)))) (defun python-backslash-continuation-line-p () "Non-nil if preceding line ends with backslash that is not in a comment." @@ -289,12 +332,17 @@ Doesn't move out of comments -- should be outside or at end of line." (defun python-continuation-line-p () "Return non-nil if current line continues a previous one. The criteria are that the previous line ends in a backslash outside -comments and strings, or that the bracket/paren nesting depth is nonzero." - (or (and (eq ?\\ (char-before (line-end-position 0))) - (not (syntax-ppss-context (syntax-ppss)))) - (< 0 (syntax-ppss-depth - (save-excursion ; syntax-ppss with arg changes point - (syntax-ppss (line-beginning-position))))))) +comments and strings, or that point is within brackets/parens." + (or (python-backslash-continuation-line-p) + (let ((depth (syntax-ppss-depth + (save-excursion ; syntax-ppss with arg changes point + (syntax-ppss (line-beginning-position)))))) + (or (> depth 0) + (if (< depth 0) ; Unbalanced brackets -- act locally + (save-excursion + (condition-case () + (progn (backward-up-list) t) ; actually within brackets + (error nil)))))))) (defun python-comment-line-p () "Return non-nil iff current line has only a comment." @@ -304,6 +352,12 @@ comments and strings, or that the bracket/paren nesting depth is nonzero." (back-to-indentation) (looking-at (rx (or (syntax comment-start) line-end)))))) +(defun python-blank-line-p () + "Return non-nil iff current line is blank." + (save-excursion + (beginning-of-line) + (looking-at "\\s-*$"))) + (defun python-beginning-of-string () "Go to beginning of string around point. Do nothing if not in string." @@ -316,83 +370,70 @@ Do nothing if not in string." BOS non-nil means point is known to be at beginning of statement." (save-excursion (unless bos (python-beginning-of-statement)) - (and (not (python-comment-line-p)) - (re-search-forward (rx (and ?: (0+ space) - (optional (and (syntax comment-start) - (0+ not-newline))) - line-end)) - (save-excursion (python-end-of-statement)) - t) - (not (progn (goto-char (match-beginning 0)) - (python-in-string/comment)))))) + (looking-at (rx (and (or "if" "else" "elif" "while" "for" "def" + "class" "try" "except" "finally") + symbol-end))))) (defun python-close-block-statement-p (&optional bos) "Return non-nil if current line is a statement closing a block. BOS non-nil means point is at beginning of statement. -The criteria are that the line isn't a comment or in string and starts with -keyword `raise', `break', `continue' or `pass'." +The criteria are that the line isn't a comment or in string and + starts with keyword `raise', `break', `continue' or `pass'." (save-excursion (unless bos (python-beginning-of-statement)) (back-to-indentation) - (looking-at (rx (and (or "return" "raise" "break" "continue" "pass") - symbol-end))))) + (looking-at (rx (or "return" "raise" "break" "continue" "pass") + symbol-end)))) (defun python-outdent-p () "Return non-nil if current line should outdent a level." (save-excursion (back-to-indentation) - (and (looking-at (rx (and (or (and (or "else" "finally") symbol-end) - (and (or "except" "elif") symbol-end - (1+ (not (any ?:))))) - (optional space) ":" (optional space) - (or (syntax comment-start) line-end)))) - (progn (end-of-line) - (not (python-in-string/comment))) + (and (looking-at (rx (and (or "else" "finally" "except" "elif") + symbol-end))) + (not (python-in-string/comment)) ;; Ensure there's a previous statement and move to it. (zerop (python-previous-statement)) (not (python-close-block-statement-p t)) ;; Fixme: check this - (not (looking-at (rx (and (or (and (or "if" "elif" "except" - "for" "while") - symbol-end (1+ (not (any ?:)))) - (and "try" symbol-end)) - (optional space) ":" (optional space) - (or (syntax comment-start) line-end))))) - (progn (end-of-line) - (not (python-in-string/comment)))))) + (not (python-open-block-statement-p))))) ;;;; Indentation. (defcustom python-indent 4 - "*Number of columns for a unit of indentation in Python mode. + "Number of columns for a unit of indentation in Python mode. See also `\\[python-guess-indent]'" :group 'python :type 'integer) (defcustom python-guess-indent t - "*Non-nil means Python mode guesses `python-indent' for the buffer." + "Non-nil means Python mode guesses `python-indent' for the buffer." :type 'boolean :group 'python) (defcustom python-indent-string-contents t - "*Non-nil means indent contents of multi-line strings together. + "Non-nil means indent contents of multi-line strings together. This means indent them the same as the preceding non-blank line. -Otherwise indent them to column zero." +Otherwise preserve their indentation. + +This only applies to `doc' strings, i.e. those that form statements; +the indentation is preserved in others." :type '(choice (const :tag "Align with preceding" t) - (const :tag "Indent to column 0" nil)) + (const :tag "Preserve indentation" nil)) :group 'python) (defcustom python-honour-comment-indentation nil "Non-nil means indent relative to preceding comment line. -Only do this for comments where the leading comment character is followed -by space. This doesn't apply to comment lines, which are always indented -in lines with preceding comments." +Only do this for comments where the leading comment character is +followed by space. This doesn't apply to comment lines, which +are always indented in lines with preceding comments." :type 'boolean :group 'python) (defcustom python-continuation-offset 4 - "*Number of columns of additional indentation for continuation lines. -Continuation lines follow a backslash-terminated line starting a statement." + "Number of columns of additional indentation for continuation lines. +Continuation lines follow a backslash-terminated line starting a +statement." :group 'python :type 'integer) @@ -406,9 +447,9 @@ Set `python-indent' locally to the value guessed." (goto-char (point-min)) (let (done indent) (while (and (not done) (not (eobp))) - (when (and (re-search-forward (rx (and ?: (0+ space) - (or (syntax comment-start) - line-end))) + (when (and (re-search-forward (rx ?: (0+ space) + (or (syntax comment-start) + line-end)) nil 'move) (python-open-block-statement-p)) (save-excursion @@ -425,8 +466,21 @@ Set `python-indent' locally to the value guessed." (setq indent-tabs-mode nil))) indent))))) +;; Alist of possible indentations and start of statement they would +;; close. Used in indentation cycling (below). +(defvar python-indent-list nil + "Internal use.") +;; Length of the above +(defvar python-indent-list-length nil + "Internal use.") +;; Current index into the alist. +(defvar python-indent-index nil + "Internal use.") + (defun python-calculate-indentation () "Calculate Python indentation for line at point." + (setq python-indent-list nil + python-indent-list-length 1) (save-excursion (beginning-of-line) (let ((syntax (syntax-ppss)) @@ -434,17 +488,25 @@ Set `python-indent' locally to the value guessed." (cond ((eq 'string (syntax-ppss-context syntax)) ; multi-line string (if (not python-indent-string-contents) - 0 - (save-excursion + (current-indentation) + ;; Only respect `python-indent-string-contents' in doc + ;; strings (defined as those which form statements). + (if (not (save-excursion + (python-beginning-of-statement) + (looking-at (rx (or (syntax string-delimiter) + (syntax string-quote)))))) + (current-indentation) ;; Find indentation of preceding non-blank line within string. (setq start (nth 8 syntax)) (forward-line -1) (while (and (< start (point)) (looking-at "\\s-*$")) (forward-line -1)) (current-indentation)))) - ((python-continuation-line-p) + ((python-continuation-line-p) ; after backslash, or bracketed (let ((point (point)) - (open-start (cadr syntax))) + (open-start (cadr syntax)) + (backslash (python-backslash-continuation-line-p)) + (colon (eq ?: (char-before (1- (line-beginning-position)))))) (if open-start ;; Inside bracketed expression. (progn @@ -458,7 +520,11 @@ Set `python-indent' locally to the value guessed." (backward-sexp) (< (point) point)) (error nil)))) - (current-column) + ;; Extra level if we're backslash-continued or + ;; following a key. + (if (or backslash colon) + (+ python-indent (current-column)) + (current-column)) ;; Otherwise indent relative to statement start, one ;; level per bracketing level. (goto-char (1+ open-start)) @@ -472,112 +538,153 @@ Set `python-indent' locally to the value guessed." (current-indentation) ;; First continuation line. Indent one step, with an ;; extra one if statement opens a block. - (save-excursion - (python-beginning-of-statement) - (+ (current-indentation) python-continuation-offset - (if (python-open-block-statement-p t) - python-indent - 0))))))) + (python-beginning-of-statement) + (+ (current-indentation) python-continuation-offset + (if (python-open-block-statement-p t) + python-indent + 0)))))) ((bobp) 0) ;; Fixme: Like python-mode.el; not convinced by this. - ((looking-at (rx (and (0+ space) (syntax comment-start) - (not (any " \t\n"))))) ; non-indentable comment + ((looking-at (rx (0+ space) (syntax comment-start) + (not (any " \t\n")))) ; non-indentable comment (current-indentation)) - (t (let ((point (point))) - (if python-honour-comment-indentation - ;; Back over whitespace, newlines, non-indentable comments. - (catch 'done - (while t - (if (cond ((bobp)) - ;; not at comment start - ((not (forward-comment -1)) - (python-beginning-of-statement) - t) - ;; trailing comment - ((/= (current-column) (current-indentation)) - (python-beginning-of-statement) - t) - ;; indentable comment like python-mode.el - ((and (looking-at (rx (and (syntax comment-start) - (or space line-end)))) - (/= 0 (current-column))))) - (throw 'done t)))) - ;; Else back over all comments. - (python-skip-comments/blanks t) - (python-beginning-of-statement)) - ;; don't lose on bogus outdent - (max 0 (+ (current-indentation) - (or (cond ((python-open-block-statement-p t) - python-indent) - ((python-close-block-statement-p t) - (- python-indent))) - (progn (goto-char point) - (if (python-outdent-p) - (- python-indent))) - 0))))))))) - -(defun python-comment-indent () - "`comment-indent-function' for Python." - ;; If previous non-blank line was a comment, use its indentation. - ;; FIXME: This seems unnecessary since the default code delegates to - ;; indent-according-to-mode. --Stef - (unless (bobp) - (save-excursion - (forward-comment -1) - (if (eq ?# (char-after)) (current-column))))) + (t (if python-honour-comment-indentation + ;; Back over whitespace, newlines, non-indentable comments. + (catch 'done + (while t + (if (cond ((bobp)) + ;; not at comment start + ((not (forward-comment -1)) + (python-beginning-of-statement) + t) + ;; trailing comment + ((/= (current-column) (current-indentation)) + (python-beginning-of-statement) + t) + ;; indentable comment like python-mode.el + ((and (looking-at (rx (syntax comment-start) + (or space line-end))) + (/= 0 (current-column))))) + (throw 'done t))))) + (python-indentation-levels) + ;; Prefer to indent comments with an immediately-following + ;; statement, e.g. + ;; ... + ;; # ... + ;; def ... + (when (and (> python-indent-list-length 1) + (python-comment-line-p)) + (forward-line) + (unless (python-comment-line-p) + (let ((elt (assq (current-indentation) python-indent-list))) + (setq python-indent-list + (nconc (delete elt python-indent-list) + (list elt)))))) + (caar (last python-indent-list))))))) ;;;; Cycling through the possible indentations with successive TABs. ;; These don't need to be buffer-local since they're only relevant ;; during a cycle. -;; Alist of possible indentations and start of statement they would close. -(defvar python-indent-list nil - "Internal use.") -;; Length of the above -(defvar python-indent-list-length nil - "Internal use.") -;; Current index into the alist. -(defvar python-indent-index nil - "Internal use.") - (defun python-initial-text () "Text of line following indentation and ignoring any trailing comment." - (buffer-substring (+ (line-beginning-position) (current-indentation)) - (save-excursion - (end-of-line) - (forward-comment -1) - (point)))) + (save-excursion + (buffer-substring (progn + (back-to-indentation) + (point)) + (progn + (end-of-line) + (forward-comment -1) + (point))))) + +(defconst python-block-pairs + '(("else" "if" "elif" "while" "for" "try" "except") + ("elif" "if" "elif") + ("except" "try" "except") + ("finally" "try")) + "Alist of keyword matches. +The car of an element is a keyword introducing a statement which +can close a block opened by a keyword in the cdr.") + +(defun python-first-word () + "Return first word (actually symbol) on the line." + (save-excursion + (back-to-indentation) + (current-word t))) (defun python-indentation-levels () "Return a list of possible indentations for this line. +It is assumed not to be a continuation line or in a multi-line string. Includes the default indentation and those which would close all -enclosing blocks. Assumes the line has already been indented per -`python-indent-line'. Elements of the list are actually pairs: +enclosing blocks. Elements of the list are actually pairs: \(INDENTATION . TEXT), where TEXT is the initial text of the corresponding block opening (or nil)." (save-excursion - (let ((levels (list (cons (current-indentation) - (save-excursion - (if (python-beginning-of-block) - (python-initial-text))))))) - ;; Only one possibility if we immediately follow a block open or - ;; are in a continuation line. - (unless (or (python-continuation-line-p) - (save-excursion (and (python-previous-statement) - (python-open-block-statement-p t)))) - (while (python-beginning-of-block) - (push (cons (current-indentation) (python-initial-text)) - levels))) - levels))) + (let ((initial "") + levels indent) + ;; Only one possibility immediately following a block open + ;; statement, assuming it doesn't have a `suite' on the same line. + (cond + ((save-excursion (and (python-previous-statement) + (python-open-block-statement-p t) + (setq indent (current-indentation)) + ;; Check we don't have something like: + ;; if ...: ... + (if (progn (python-end-of-statement) + (python-skip-comments/blanks t) + (eq ?: (char-before))) + (setq indent (+ python-indent indent))))) + (push (cons indent initial) levels)) + ;; Only one possibility for comment line immediately following + ;; another. + ((save-excursion + (when (python-comment-line-p) + (forward-line -1) + (if (python-comment-line-p) + (push (cons (current-indentation) initial) levels))))) + ;; Fixme: Maybe have a case here which indents (only) first + ;; line after a lambda. + (t + (let ((start (car (assoc (python-first-word) python-block-pairs)))) + (python-previous-statement) + ;; Is this a valid indentation for the line of interest? + (unless (or (if start ; potentially only outdentable + ;; Check for things like: + ;; if ...: ... + ;; else ...: + ;; where the second line need not be outdented. + (not (member (python-first-word) + (cdr (assoc start + python-block-pairs))))) + ;; Not sensible to indent to the same level as + ;; previous `return' &c. + (python-close-block-statement-p)) + (push (cons (current-indentation) (python-initial-text)) + levels)) + (while (python-beginning-of-block) + (when (or (not start) + (member (python-first-word) + (cdr (assoc start python-block-pairs)))) + (push (cons (current-indentation) (python-initial-text)) + levels)))))) + (prog1 (or levels (setq levels '((0 . "")))) + (setq python-indent-list levels + python-indent-list-length (length python-indent-list)))))) ;; This is basically what `python-indent-line' would be if we didn't ;; do the cycling. -(defun python-indent-line-1 () - "Subroutine of `python-indent-line'." +(defun python-indent-line-1 (&optional leave) + "Subroutine of `python-indent-line'. +Does non-repeated indentation. LEAVE non-nil means leave +indentation if it is valid, i.e. one of the positions returned by +`python-calculate-indentation'." (let ((target (python-calculate-indentation)) (pos (- (point-max) (point)))) - (if (= target (current-indentation)) + (if (or (= target (current-indentation)) + ;; Maybe keep a valid indentation. + (and leave python-indent-list + (assq (current-indentation) python-indent-list))) (if (< (current-column) (current-indentation)) (back-to-indentation)) (beginning-of-line) @@ -589,29 +696,41 @@ corresponding block opening (or nil)." (defun python-indent-line () "Indent current line as Python code. When invoked via `indent-for-tab-command', cycle through possible -indentations for current line. The cycle is broken by a command different -from `indent-for-tab-command', i.e. successive TABs do the cycling." +indentations for current line. The cycle is broken by a command +different from `indent-for-tab-command', i.e. successive TABs do +the cycling." (interactive) - ;; Don't do extra work if invoked via `indent-region', for instance. - (if (not (eq this-command 'indent-for-tab-command)) - (python-indent-line-1) - (if (eq last-command this-command) - (if (= 1 python-indent-list-length) - (message "Sole indentation") - (progn (setq python-indent-index (% (1+ python-indent-index) - python-indent-list-length)) - (beginning-of-line) - (delete-horizontal-space) - (indent-to (car (nth python-indent-index python-indent-list))) - (if (python-block-end-p) - (let ((text (cdr (nth python-indent-index - python-indent-list)))) - (if text - (message "Closes: %s" text)))))) - (python-indent-line-1) - (setq python-indent-list (python-indentation-levels) - python-indent-list-length (length python-indent-list) - python-indent-index (1- python-indent-list-length))))) + (if (and (eq this-command 'indent-for-tab-command) + (eq last-command this-command)) + (if (= 1 python-indent-list-length) + (message "Sole indentation") + (progn (setq python-indent-index + (% (1+ python-indent-index) python-indent-list-length)) + (beginning-of-line) + (delete-horizontal-space) + (indent-to (car (nth python-indent-index python-indent-list))) + (if (python-block-end-p) + (let ((text (cdr (nth python-indent-index + python-indent-list)))) + (if text + (message "Closes: %s" text)))))) + (python-indent-line-1) + (setq python-indent-index (1- python-indent-list-length)))) + +(defun python-indent-region (start end) + "`indent-region-function' for Python. +Leaves validly-indented lines alone, i.e. doesn't indent to +another valid position." + (save-excursion + (goto-char end) + (setq end (point-marker)) + (goto-char start) + (or (bolp) (forward-line 1)) + (while (< (point) end) + (or (and (bolp) (eolp)) + (python-indent-line-1 t)) + (forward-line 1)) + (move-marker end nil))) (defun python-block-end-p () "Non-nil if this is a line in a statement closing a block, @@ -622,40 +741,41 @@ or a blank line indented to where it would close a block." (save-excursion (python-previous-statement) (current-indentation)))))) - -;; Fixme: Define an indent-region-function. It should probably leave -;; lines alone if the indentation is already at one of the allowed -;; levels. Otherwise, M-C-\ typically keeps indenting more deeply -;; down a function. ;;;; Movement. +;; Fixme: Define {for,back}ward-sexp-function? Maybe skip units like +;; block, statement, depending on context. + (defun python-beginning-of-defun () "`beginning-of-defun-function' for Python. Finds beginning of innermost nested class or method definition. -Returns the name of the definition found at the end, or nil if reached -start of buffer." +Returns the name of the definition found at the end, or nil if +reached start of buffer." (let ((ci (current-indentation)) - (def-re (rx (and line-start (0+ space) (or "def" "class") - (1+ space) - (group (1+ (or word (syntax symbol))))))) - found lep def-line) + (def-re (rx line-start (0+ space) (or "def" "class") (1+ space) + (group (1+ (or word (syntax symbol)))))) + found lep) ;; def-line (if (python-comment-line-p) (setq ci most-positive-fixnum)) (while (and (not (bobp)) (not found)) ;; Treat bol at beginning of function as outside function so ;; that successive C-M-a makes progress backwards. - (setq def-line (looking-at def-re)) + ;;(setq def-line (looking-at def-re)) (unless (bolp) (end-of-line)) (setq lep (line-end-position)) (if (and (re-search-backward def-re nil 'move) ;; Must be less indented or matching top level, or ;; equally indented if we started on a definition line. (let ((in (current-indentation))) - (or (and (zerop ci) (zerop in)) - (= lep (line-end-position)) ; on initial line - (and def-line (= in ci)) - (< in ci))) + (or (and (zerop ci) (zerop in)) + (= lep (line-end-position)) ; on initial line + ;; Not sure why it was like this -- fails in case of + ;; last internal function followed by first + ;; non-def statement of the main body. + ;;(and def-line (= in ci)) + (= in ci) + (< in ci))) (not (python-in-string/comment))) (setq found t))))) @@ -663,7 +783,7 @@ start of buffer." "`end-of-defun-function' for Python. Finds end of innermost nested class or method definition." (let ((orig (point)) - (pattern (rx (and line-start (0+ space) (or "def" "class") space)))) + (pattern (rx line-start (0+ space) (or "def" "class") space))) ;; Go to start of current block and check whether it's at top ;; level. If it is, and not a block start, look forward for ;; definition statement. @@ -692,8 +812,9 @@ Finds end of innermost nested class or method definition." (python-end-of-block) ;; Count trailing space in defun (but not trailing comments). (skip-syntax-forward " >") - (beginning-of-line)) - ;; Catch pathological case like this, where the beginning-of-defun + (unless (eobp) ; e.g. missing final newline + (beginning-of-line))) + ;; Catch pathological cases like this, where the beginning-of-defun ;; skips to a definition we're not in: ;; if ...: ;; ... @@ -706,26 +827,43 @@ Finds end of innermost nested class or method definition." (defun python-beginning-of-statement () "Go to start of current statement. -Accounts for continuation lines, multi-line strings, and multi-line bracketed -expressions." +Accounts for continuation lines, multi-line strings, and +multi-line bracketed expressions." (beginning-of-line) (python-beginning-of-string) - (catch 'foo - (while (python-continuation-line-p) - (beginning-of-line) - (if (python-backslash-continuation-line-p) + (while (python-continuation-line-p) + (beginning-of-line) + (if (python-backslash-continuation-line-p) + (progn + (forward-line -1) (while (python-backslash-continuation-line-p) - (forward-line -1)) - (python-beginning-of-string) - ;; Skip forward out of nested brackets. - (condition-case () ; beware invalid syntax - (let ((depth (syntax-ppss-depth (syntax-ppss)))) - ;; Beware negative depths. - (if (> depth 0) (backward-up-list depth)) - t) - (error (throw 'foo nil)))))) + (forward-line -1))) + (python-beginning-of-string) + (python-skip-out))) (back-to-indentation)) +(defun python-skip-out (&optional forward syntax) + "Skip out of any nested brackets. +Skip forward if FORWARD is non-nil, else backward. +If SYNTAX is non-nil it is the state returned by `syntax-ppss' at point. +Return non-nil iff skipping was done." + (let ((depth (syntax-ppss-depth (or syntax (syntax-ppss)))) + (forward (if forward -1 1))) + (unless (zerop depth) + (if (> depth 0) + ;; Skip forward out of nested brackets. + (condition-case () ; beware invalid syntax + (progn (backward-up-list (* forward depth)) t) + (error nil)) + ;; Invalid syntax (too many closed brackets). + ;; Skip out of as many as possible. + (let (done) + (while (condition-case () + (progn (backward-up-list forward) + (setq done t)) + (error nil))) + done))))) + (defun python-end-of-statement () "Go to the end of the current statement and return point. Usually this is the start of the next line, but if this is a @@ -745,13 +883,7 @@ On a comment line, go to end of line." (condition-case () ; beware invalid syntax (progn (forward-sexp) t) (error (end-of-line)))) - ((> (syntax-ppss-depth s) 0) - ;; Skip forward out of nested brackets. - (condition-case () ; beware invalid syntax - (progn (backward-up-list - (- (syntax-ppss-depth s))) - t) - (error (end-of-line)))))) + ((python-skip-out t s)))) (end-of-line)) (unless comment (eq ?\\ (char-before)))) ; Line continued? @@ -785,7 +917,8 @@ Return count of statements left to move." (while (and (> count 0) (not (eobp))) (python-end-of-statement) (python-skip-comments/blanks) - (setq count (1- count))) + (unless (eobp) + (setq count (1- count)))) count)) (defun python-beginning-of-block (&optional arg) @@ -802,7 +935,8 @@ Otherwise return non-nil." ((< arg 0) (python-end-of-block (- arg))) (t (let ((point (point))) - (if (python-comment-line-p) + (if (or (python-comment-line-p) + (python-blank-line-p)) (python-skip-comments/blanks t)) (python-beginning-of-statement) (let ((ci (current-indentation))) @@ -830,32 +964,31 @@ Otherwise return non-nil." (defun python-end-of-block (&optional arg) "Go to end of current block. -With numeric arg, do it that many times. If ARG is negative, call -`python-beginning-of-block' instead. -If current statement is in column zero and doesn't open a block, don't -move and return nil. Otherwise return t." +With numeric arg, do it that many times. If ARG is negative, +call `python-beginning-of-block' instead. +If current statement is in column zero and doesn't open a block, +don't move and return nil. Otherwise return t." (interactive "p") (unless arg (setq arg 1)) (if (< arg 0) - (python-beginning-of-block (- arg))) - (while (and (> arg 0) - (let* ((point (point)) - (_ (if (python-comment-line-p) - (python-skip-comments/blanks t))) - (ci (current-indentation)) - (open (python-open-block-statement-p))) - (if (and (zerop ci) (not open)) - (not (goto-char point)) - (catch 'done - (while (zerop (python-next-statement)) - (when (or (and open (<= (current-indentation) ci)) - (< (current-indentation) ci)) - (python-skip-comments/blanks t) - (beginning-of-line 2) - (throw 'done t))) - (not (goto-char point)))))) - (setq arg (1- arg))) - (zerop arg)) + (python-beginning-of-block (- arg)) + (while (and (> arg 0) + (let* ((point (point)) + (_ (if (python-comment-line-p) + (python-skip-comments/blanks t))) + (ci (current-indentation)) + (open (python-open-block-statement-p))) + (if (and (zerop ci) (not open)) + (not (goto-char point)) + (catch 'done + (while (zerop (python-next-statement)) + (when (or (and open (<= (current-indentation) ci)) + (< (current-indentation) ci)) + (python-skip-comments/blanks t) + (beginning-of-line 2) + (throw 'done t))))))) + (setq arg (1- arg))) + (zerop arg))) ;;;; Imenu. @@ -868,14 +1001,23 @@ The nested menus are headed by an item referencing the outer definition; it has a space prepended to the name so that it sorts first with `imenu--sort-by-name' (though, unfortunately, sub-menus precede it)." - (unless (boundp 'python-recursing) ; dynamically bound below - (goto-char (point-min))) ; normal call from Imenu - (let (index-alist ; accumulated value to return - name) + (unless (boundp 'python-recursing) ; dynamically bound below + ;; Normal call from Imenu. + (goto-char (point-min)) + ;; Without this, we can get an infloop if the buffer isn't all + ;; fontified. I guess this is really a bug in syntax.el. OTOH, + ;; _with_ this, imenu doesn't immediately work; I can't figure out + ;; what's going on, but it must be something to do with timers in + ;; font-lock. + ;; This can't be right, especially not when jit-lock is not used. --Stef + ;; (unless (get-text-property (1- (point-max)) 'fontified) + ;; (font-lock-fontify-region (point-min) (point-max))) + ) + (let (index-alist) ; accumulated value to return (while (re-search-forward - (rx (and line-start (0+ space) ; leading space - (or (group "def") (group "class")) ; type - (1+ space) (group (1+ (or word ?_))))) ; name + (rx line-start (0+ space) ; leading space + (or (group "def") (group "class")) ; type + (1+ space) (group (1+ (or word ?_)))) ; name nil t) (unless (python-in-string/comment) (let ((pos (match-beginning 0)) @@ -890,7 +1032,22 @@ precede it)." (progn (push (cons (concat " " name) pos) sublist) (push (cons name sublist) index-alist)) (push (cons name pos) index-alist))))))) - (nreverse index-alist))) + (unless (boundp 'python-recursing) + ;; Look for module variables. + (let (vars) + (goto-char (point-min)) + (while (re-search-forward + (rx line-start (group (1+ (or word ?_))) (0+ space) "=") + nil t) + (unless (python-in-string/comment) + (push (cons (match-string 1) (match-beginning 1)) + vars))) + (setq index-alist (nreverse index-alist)) + (if vars + (push (cons "Module variables" + (nreverse vars)) + index-alist)))) + index-alist)) ;;;; `Electric' commands. @@ -910,20 +1067,26 @@ just insert a single colon." (defun python-backspace (arg) "Maybe delete a level of indentation on the current line. -If not at the end of line's indentation, or on a comment line, just call -`backward-delete-char-untabify'. With ARG, repeat that many times." +Do so if point is at the end of the line's indentation. +Otherwise just call `backward-delete-char-untabify'. +Repeat ARG times." (interactive "*p") (if (or (/= (current-indentation) (current-column)) (bolp) (python-continuation-line-p)) (backward-delete-char-untabify arg) - (let ((indent 0)) - (save-excursion - (while (and (> arg 0) (python-beginning-of-block)) - (setq arg (1- arg))) - (when (zerop arg) - (setq indent (current-indentation)) - (message "Closes %s" (python-initial-text)))) + ;; Look for the largest valid indentation which is smaller than + ;; the current indentation. + (let ((indent 0) + (ci (current-indentation)) + (indents (python-indentation-levels)) + initial) + (dolist (x indents) + (if (< (car x) ci) + (setq indent (max indent (car x))))) + (setq initial (cdr (assq indent indents))) + (if (> (length initial) 0) + (message "Closes %s" initial)) (delete-horizontal-space) (indent-to indent)))) (put 'python-backspace 'delete-selection 'supersede) @@ -931,7 +1094,7 @@ If not at the end of line's indentation, or on a comment line, just call ;;;; pychecker (defcustom python-check-command "pychecker --stdlib" - "*Command used to check a Python file." + "Command used to check a Python file." :type 'string :group 'python) @@ -963,66 +1126,54 @@ See `python-check-command' for the default." ;; Fixme: Make sure we can work with IPython. (defcustom python-python-command "python" - "*Shell command to run Python interpreter. + "Shell command to run Python interpreter. Any arguments can't contain whitespace. -Note that IPython may not work properly; it must at least be used with the -`-cl' flag, i.e. use `ipython -cl'." +Note that IPython may not work properly; it must at least be used +with the `-cl' flag, i.e. use `ipython -cl'." :group 'python :type 'string) (defcustom python-jython-command "jython" - "*Shell command to run Jython interpreter. + "Shell command to run Jython interpreter. Any arguments can't contain whitespace." :group 'python :type 'string) (defvar python-command python-python-command "Actual command used to run Python. -May be `python-python-command' or `python-jython-command'. -Additional arguments are added when the command is used by `run-python' -et al.") +May be `python-python-command' or `python-jython-command', possibly +modified by the user. Additional arguments are added when the command +is used by `run-python' et al.") (defvar python-buffer nil - "The current python process buffer." - ;; Fixme: a single process is currently assumed, so that this doc - ;; is misleading. - -;; "*The current python process buffer. -;; To run multiple Python processes, start the first with \\[run-python]. -;; It will be in a buffer named *Python*. Rename that with -;; \\[rename-buffer]. Now start a new process with \\[run-python]. It -;; will be in a new buffer, named *Python*. Switch between the different -;; process buffers with \\[switch-to-buffer]. - -;; Commands that send text from source buffers to Python processes have -;; to choose a process to send to. This is determined by global variable -;; `python-buffer'. Suppose you have three inferior Pythons running: -;; Buffer Process -;; foo python -;; bar python<2> -;; *Python* python<3> -;; If you do a \\[python-send-region-and-go] command on some Python source -;; code, what process does it go to? - -;; - In a process buffer (foo, bar, or *Python*), send it to that process. -;; - In some other buffer (e.g. a source file), send it to the process -;; attached to `python-buffer'. -;; Process selection is done by function `python-proc'. - -;; Whenever \\[run-python] starts a new process, it resets `python-buffer' -;; to be the new process's buffer. If you only run one process, this will -;; do the right thing. If you run multiple processes, you can change -;; `python-buffer' to another process buffer with \\[set-variable]." - ) + "*The current python process buffer. + +Commands that send text from source buffers to Python processes have +to choose a process to send to. This is determined by buffer-local +value of `python-buffer'. If its value in the current buffer, +i.e. both any local value and the default one, is nil, `run-python' +and commands that send to the Python process will start a new process. + +Whenever \\[run-python] starts a new process, it resets the default +value of `python-buffer' to be the new process's buffer and sets the +buffer-local value similarly if the current buffer is in Python mode +or Inferior Python mode, so that source buffer stays associated with a +specific sub-process. + +Use \\[python-set-proc] to set the default value from a buffer with a +local value.") +(make-variable-buffer-local 'python-buffer) (defconst python-compilation-regexp-alist ;; FIXME: maybe these should move to compilation-error-regexp-alist-alist. - `((,(rx (and line-start (1+ (any " \t")) "File \"" - (group (1+ (not (any "\"<")))) ; avoid `<stdin>' &c - "\", line " (group (1+ digit)))) + ;; The first already is (for CAML), but the second isn't. Anyhow, + ;; these are specific to the inferior buffer. -- fx + `((,(rx line-start (1+ (any " \t")) "File \"" + (group (1+ (not (any "\"<")))) ; avoid `<stdin>' &c + "\", line " (group (1+ digit))) 1 2) - (,(rx (and " in file " (group (1+ not-newline)) " on line " - (group (1+ digit)))) + (,(rx " in file " (group (1+ not-newline)) " on line " + (group (1+ digit))) 1 2)) "`compilation-error-regexp-alist' for inferior Python.") @@ -1040,9 +1191,9 @@ et al.") ;; (define-key map "\C-c\C-f" 'python-describe-symbol) map)) -;; Fixme: This should inherit some stuff from python-mode, but I'm not -;; sure how much: at least some keybindings, like C-c C-f; syntax?; -;; font-locking, e.g. for triple-quoted strings? +;; Fixme: This should inherit some stuff from `python-mode', but I'm +;; not sure how much: at least some keybindings, like C-c C-f; +;; syntax?; font-locking, e.g. for triple-quoted strings? (define-derived-mode inferior-python-mode comint-mode "Inferior Python" "Major mode for interacting with an inferior Python process. A Python process can be started with \\[run-python]. @@ -1050,14 +1201,15 @@ A Python process can be started with \\[run-python]. Hooks `comint-mode-hook' and `inferior-python-mode-hook' are run in that order. -You can send text to the inferior Python process from other buffers containing -Python source. - * `python-switch-to-python' switches the current buffer to the Python +You can send text to the inferior Python process from other buffers +containing Python source. + * \\[python-switch-to-python] switches the current buffer to the Python process buffer. - * `python-send-region' sends the current region to the Python process. - * `python-send-region-and-go' switches to the Python process buffer + * \\[python-send-region] sends the current region to the Python process. + * \\[python-send-region-and-go] switches to the Python process buffer after sending the text. -For running multiple processes in multiple buffers, see `python-buffer'. +For running multiple processes in multiple buffers, see `run-python' and +`python-buffer'. \\{inferior-python-mode-map}" :group 'python @@ -1069,13 +1221,13 @@ For running multiple processes in multiple buffers, see `python-buffer'. ;; Still required by `comint-redirect-send-command', for instance ;; (and we need to match things like `>>> ... >>> '): (set (make-local-variable 'comint-prompt-regexp) - (rx (and line-start (1+ (and (repeat 3 (any ">.")) ?\s))))) + (rx line-start (1+ (and (repeat 3 (any ">.")) " ")))) (set (make-local-variable 'compilation-error-regexp-alist) python-compilation-regexp-alist) (compilation-shell-minor-mode 1)) (defcustom inferior-python-filter-regexp "\\`\\s-*\\S-?\\S-?\\s-*\\'" - "*Input matching this regexp is not saved on the history list. + "Input matching this regexp is not saved on the history list. Default ignores all inputs of 0, 1, or 2 non-blank characters." :type 'regexp :group 'python) @@ -1098,98 +1250,134 @@ Don't save anything for STR matching `inferior-python-filter-regexp'." (defvar python-preoutput-result nil "Data from last `_emacs_out' line seen by the preoutput filter.") -(defvar python-preoutput-continuation nil - "If non-nil, funcall this when `python-preoutput-filter' sees `_emacs_ok'.") - (defvar python-preoutput-leftover nil) +(defvar python-preoutput-skip-next-prompt nil) ;; Using this stops us getting lines in the buffer like ;; >>> ... ... >>> -;; Also look for (and delete) an `_emacs_ok' string and call -;; `python-preoutput-continuation' if we get it. (defun python-preoutput-filter (s) "`comint-preoutput-filter-functions' function: ignore prompts not at bol." (when python-preoutput-leftover (setq s (concat python-preoutput-leftover s)) (setq python-preoutput-leftover nil)) - (cond ((and (string-match (rx (and string-start (repeat 3 (any ".>")) - " " string-end)) - s) - (/= (let ((inhibit-field-text-motion t)) - (line-beginning-position)) - (point))) - "") - ((string= s "_emacs_ok\n") - (when python-preoutput-continuation - (funcall python-preoutput-continuation) - (setq python-preoutput-continuation nil)) - "") - ((string-match "_emacs_out \\(.*\\)\n" s) - (setq python-preoutput-result (match-string 1 s)) - "") - ((string-match ".*\n" s) - s) - ((or (eq t (compare-strings s nil nil "_emacs_ok\n" nil (length s))) - (let ((end (min (length "_emacs_out ") (length s)))) - (eq t (compare-strings s nil end "_emacs_out " nil end)))) - (setq python-preoutput-leftover s) - "") - (t s))) + (let ((start 0) + (res "")) + ;; First process whole lines. + (while (string-match "\n" s start) + (let ((line (substring s start (setq start (match-end 0))))) + ;; Skip prompt if needed. + (when (and python-preoutput-skip-next-prompt + (string-match comint-prompt-regexp line)) + (setq python-preoutput-skip-next-prompt nil) + (setq line (substring line (match-end 0)))) + ;; Recognize special _emacs_out lines. + (if (and (string-match "\\`_emacs_out \\(.*\\)\n\\'" line) + (local-variable-p 'python-preoutput-result)) + (progn + (setq python-preoutput-result (match-string 1 line)) + (set (make-local-variable 'python-preoutput-skip-next-prompt) t)) + (setq res (concat res line))))) + ;; Then process the remaining partial line. + (unless (zerop start) (setq s (substring s start))) + (cond ((and (string-match comint-prompt-regexp s) + ;; Drop this prompt if it follows an _emacs_out... + (or python-preoutput-skip-next-prompt + ;; ... or if it's not gonna be inserted at BOL. + ;; Maybe we could be more selective here. + (if (zerop (length res)) + (not (bolp)) + (string-match res ".\\'")))) + ;; The need for this seems to be system-dependent: + ;; What is this all about, exactly? --Stef + ;; (if (and (eq ?. (aref s 0))) + ;; (accept-process-output (get-buffer-process (current-buffer)) 1)) + (setq python-preoutput-skip-next-prompt nil) + res) + ((let ((end (min (length "_emacs_out ") (length s)))) + (eq t (compare-strings s nil end "_emacs_out " nil end))) + ;; The leftover string is a prefix of _emacs_out so we don't know + ;; yet whether it's an _emacs_out or something else: wait until we + ;; get more output so we can resolve this ambiguity. + (set (make-local-variable 'python-preoutput-leftover) s) + res) + (t (concat res s))))) + +(autoload 'comint-check-proc "comint") ;;;###autoload -(defun run-python (&optional cmd noshow) +(defun run-python (&optional cmd noshow new) "Run an inferior Python process, input and output via buffer *Python*. CMD is the Python command to run. NOSHOW non-nil means don't show the buffer automatically. -If there is a process already running in `*Python*', switch to -that buffer. Interactively, a prefix arg allows you to edit the initial -command line (default is `python-command'); `-i' etc. args will be added -to this as appropriate. Runs the hook `inferior-python-mode-hook' -\(after the `comint-mode-hook' is run). -\(Type \\[describe-mode] in the process buffer for a list of commands.)" - (interactive (list (if current-prefix-arg - (read-string "Run Python: " python-command) - python-command))) + +Normally, if there is a process already running in `python-buffer', +switch to that buffer. Interactively, a prefix arg allows you to edit +the initial command line (default is `python-command'); `-i' etc. args +will be added to this as appropriate. A new process is started if: +one isn't running attached to `python-buffer', or interactively the +default `python-command', or argument NEW is non-nil. See also the +documentation for `python-buffer'. + +Runs the hook `inferior-python-mode-hook' \(after the +`comint-mode-hook' is run). \(Type \\[describe-mode] in the process +buffer for a list of commands.)" + (interactive (if current-prefix-arg + (list (read-string "Run Python: " python-command) nil t) + (list python-command))) (unless cmd (setq cmd python-python-command)) (setq python-command cmd) ;; Fixme: Consider making `python-buffer' buffer-local as a buffer ;; (not a name) in Python buffers from which `run-python' &c is ;; invoked. Would support multiple processes better. - (unless (comint-check-proc python-buffer) - (let* ((cmdlist (append (python-args-to-list cmd) '("-i"))) - (path (getenv "PYTHONPATH")) - (process-environment ; to import emacs.py - (cons (concat "PYTHONPATH=" data-directory - (if path (concat ":" path))) - process-environment))) - (set-buffer (apply 'make-comint "Python" (car cmdlist) nil - (cdr cmdlist))) - (setq python-buffer (buffer-name))) - (inferior-python-mode) - ;; Load function defintions we need. - ;; Before the preoutput function was used, this was done via -c in - ;; cmdlist, but that loses the banner and doesn't run the startup - ;; file. The code might be inline here, but there's enough that it - ;; seems worth putting in a separate file, and it's probably cleaner - ;; to put it in a module. - (python-send-string "import emacs")) - (unless noshow (pop-to-buffer python-buffer))) + (when (or new (not (comint-check-proc python-buffer))) + (save-current-buffer + (let* ((cmdlist (append (python-args-to-list cmd) '("-i"))) + (path (getenv "PYTHONPATH")) + (process-environment ; to import emacs.py + (cons (concat "PYTHONPATH=" data-directory + (if path (concat ":" path))) + process-environment))) + (set-buffer (apply 'make-comint-in-buffer "Python" + (generate-new-buffer "*Python*") + (car cmdlist) nil (cdr cmdlist))) + (setq-default python-buffer (current-buffer)) + (setq python-buffer (current-buffer))) + (accept-process-output (get-buffer-process python-buffer) 5) + (inferior-python-mode))) + (if (derived-mode-p 'python-mode) + (setq python-buffer (default-value 'python-buffer))) ; buffer-local + ;; Load function definitions we need. + ;; Before the preoutput function was used, this was done via -c in + ;; cmdlist, but that loses the banner and doesn't run the startup + ;; file. The code might be inline here, but there's enough that it + ;; seems worth putting in a separate file, and it's probably cleaner + ;; to put it in a module. + ;; Ensure we're at a prompt before doing anything else. + (python-send-receive "import emacs; print '_emacs_out ()'") + ;; Without this, help output goes into the inferior python buffer if + ;; the process isn't already running. + (sit-for 1 t) ;Should we use accept-process-output instead? --Stef + (unless noshow (pop-to-buffer python-buffer t))) ;; Fixme: We typically lose if the inferior isn't in the normal REPL, ;; e.g. prompt is `help> '. Probably raise an error if the form of -;; the prompt is unexpected; actually, it needs to be `>>> ', not +;; the prompt is unexpected. Actually, it needs to be `>>> ', not ;; `... ', i.e. we're not inputting a block &c. However, this may not -;; be the place to do it, e.g. we might actually want to send commands -;; having set up such a state. +;; be the place to check it, e.g. we might actually want to send +;; commands having set up such a state. (defun python-send-command (command) - "Like `python-send-string' but resets `compilation-minor-mode'." - (goto-char (point-max)) + "Like `python-send-string' but resets `compilation-shell-minor-mode'. +COMMAND should be a single statement." + (assert (not (string-match "\n" command))) (let ((end (marker-position (process-mark (python-proc))))) + (with-current-buffer python-buffer (goto-char (point-max))) (compilation-forget-errors) - (python-send-string command) - (set-marker compilation-parsing-end end) - (setq compilation-last-buffer (current-buffer)))) + ;; Must wait until this has completed before re-setting variables below. + (python-send-receive (concat command "; print '_emacs_out ()'")) + (with-current-buffer python-buffer + (set-marker compilation-parsing-end end) + (setq compilation-last-buffer (current-buffer))))) (defun python-send-region (start end) "Send the region to the inferior Python process." @@ -1202,8 +1390,8 @@ to this as appropriate. Runs the hook `inferior-python-mode-hook' ;; filter). This function also catches exceptions and truncates ;; tracebacks not to mention the frame of the function itself. ;; - ;; The compilation-minor-mode parsing takes care of relating the - ;; reference to the temporary file to the source. + ;; The `compilation-shell-minor-mode' parsing takes care of relating + ;; the reference to the temporary file to the source. ;; ;; Fixme: Write a `coding' header to the temp file if the region is ;; non-ASCII. @@ -1220,18 +1408,22 @@ to this as appropriate. Runs the hook `inferior-python-mode-hook' (set-marker orig-start (line-beginning-position 0))) (write-region "if True:\n" nil f nil 'nomsg)) (write-region start end f t 'nomsg) - (with-current-buffer (process-buffer (python-proc)) ;Runs python if needed. - (python-send-command command) + (python-send-command command) + (with-current-buffer (process-buffer (python-proc)) ;; Tell compile.el to redirect error locations in file `f' to ;; positions past marker `orig-start'. It has to be done *after* - ;; python-send-command's call to compilation-forget-errors. + ;; `python-send-command''s call to `compilation-forget-errors'. (compilation-fake-loc orig-start f)))) (defun python-send-string (string) "Evaluate STRING in inferior Python process." (interactive "sPython command: ") (comint-send-string (python-proc) string) - (comint-send-string (python-proc) "\n\n")) + (comint-send-string (python-proc) + ;; If the string is single-line or if it ends with \n, + ;; only add a single \n, otherwise add 2, so as to + ;; make sure we terminate the multiline instruction. + (if (string-match "\n.+\\'" string) "\n\n" "\n"))) (defun python-send-buffer () "Send the current buffer to the inferior Python process." @@ -1247,10 +1439,10 @@ to this as appropriate. Runs the hook `inferior-python-mode-hook' (progn (end-of-defun) (point))))) (defun python-switch-to-python (eob-p) - "Switch to the Python process buffer. + "Switch to the Python process buffer, maybe starting new process. With prefix arg, position cursor at end of buffer." (interactive "P") - (pop-to-buffer (process-buffer (python-proc))) ;Runs python if needed. + (pop-to-buffer (process-buffer (python-proc)) t) ;Runs python if needed. (when eob-p (push-mark) (goto-char (point-max)))) @@ -1263,10 +1455,10 @@ Then switch to the process buffer." (python-switch-to-python t)) (defcustom python-source-modes '(python-mode jython-mode) - "*Used to determine if a buffer contains Python source code. -If it's loaded into a buffer that is in one of these major modes, it's -considered a Python source file by `python-load-file'. -Used by these commands to determine defaults." + "Used to determine if a buffer contains Python source code. +If a file is loaded into a buffer that is in one of these major modes, +it is considered Python source by `python-load-file', which uses the +value to determine defaults." :type '(repeat function) :group 'python) @@ -1274,6 +1466,8 @@ Used by these commands to determine defaults." "Caches (directory . file) pair used in the last `python-load-file' command. Used for determining the default in the next one.") +(autoload 'comint-get-source "comint") + (defun python-load-file (file-name) "Load a Python file FILE-NAME into the inferior Python process. If the file has extension `.py' import or reload it as a module. @@ -1297,17 +1491,27 @@ module-qualified names." (format "execfile(%S)" file-name))) (message "%s loaded" file-name))) -;; Fixme: If we need to start the process, wait until we've got the OK -;; from the startup. (defun python-proc () "Return the current Python process. See variable `python-buffer'. Starts a new process if necessary." - (or (if python-buffer - (get-buffer-process (if (eq major-mode 'inferior-python-mode) - (current-buffer) - python-buffer))) - (progn (run-python nil t) - (python-proc)))) + ;; Fixme: Maybe should look for another active process if there + ;; isn't one for `python-buffer'. + (unless (comint-check-proc python-buffer) + (run-python nil t)) + (get-buffer-process (or (if (derived-mode-p 'inferior-python-mode) + (current-buffer) + python-buffer)))) + +(defun python-set-proc () + "Set the default value of `python-buffer' to correspond to this buffer. +If the current buffer has a local value of `python-buffer', set the +default (global) value to that. The associated Python process is +the one that gets input from \\[python-send-region] et al when used +in a buffer that doesn't have a local value of `python-buffer'." + (interactive) + (if (local-variable-p 'python-buffer) + (setq-default python-buffer python-buffer) + (error "No local value of `python-buffer'"))) ;;;; Context-sensitive help. @@ -1322,16 +1526,22 @@ Otherwise inherits from `python-mode-syntax-table'.") (defvar view-return-to-alist) (eval-when-compile (autoload 'help-buffer "help-fns")) +(defvar python-imports) ; forward declaration + ;; Fixme: Should this actually be used instead of info-look, i.e. be -;; bound to C-h S? Can we use other pydoc stuff before python 2.2? +;; bound to C-h S? [Probably not, since info-look may work in cases +;; where this doesn't.] (defun python-describe-symbol (symbol) "Get help on SYMBOL using `help'. Interactively, prompt for symbol. -Symbol may be anything recognized by the interpreter's `help' command -- -e.g. `CALLS' -- not just variables in scope. -This only works for Python version 2.2 or newer since earlier interpreters -don't support `help'." +Symbol may be anything recognized by the interpreter's `help' +command -- e.g. `CALLS' -- not just variables in scope in the +interpreter. This only works for Python version 2.2 or newer +since earlier interpreters don't support `help'. + +In some cases where this doesn't find documentation, \\[info-lookup-symbol] +will." ;; Note that we do this in the inferior process, not a separate one, to ;; ensure the environment is appropriate. (interactive @@ -1343,53 +1553,65 @@ don't support `help'." "Describe symbol: ") nil nil symbol)))) (if (equal symbol "") (error "No symbol")) - (let* ((func `(lambda () - (comint-redirect-send-command - (format "emacs.ehelp(%S, globals(), locals())\n" ,symbol) - "*Help*" nil)))) - ;; Ensure we have a suitable help buffer. - ;; Fixme: Maybe process `Related help topics' a la help xrefs and - ;; allow C-c C-f in help buffer. - (let ((temp-buffer-show-hook ; avoid xref stuff - (lambda () - (toggle-read-only 1) - (setq view-return-to-alist - (list (cons (selected-window) help-return-method)))))) - (help-setup-xref (list 'python-describe-symbol symbol) (interactive-p)) - (with-output-to-temp-buffer (help-buffer) - (with-current-buffer standard-output - (set (make-local-variable 'comint-redirect-subvert-readonly) t) - (print-help-return-message)))) - (if (and python-buffer (get-buffer python-buffer)) - (with-current-buffer python-buffer - (funcall func)) - (setq python-preoutput-continuation func) - (run-python nil t)))) + ;; Ensure we have a suitable help buffer. + ;; Fixme: Maybe process `Related help topics' a la help xrefs and + ;; allow C-c C-f in help buffer. + (let ((temp-buffer-show-hook ; avoid xref stuff + (lambda () + (toggle-read-only 1) + (setq view-return-to-alist + (list (cons (selected-window) help-return-method)))))) + (with-output-to-temp-buffer (help-buffer) + (with-current-buffer standard-output + ;; Fixme: Is this actually useful? + (help-setup-xref (list 'python-describe-symbol symbol) (interactive-p)) + (set (make-local-variable 'comint-redirect-subvert-readonly) t) + (print-help-return-message)))) + (comint-redirect-send-command-to-process (format "emacs.ehelp(%S, %s)" + symbol python-imports) + "*Help*" (python-proc) nil nil)) (add-to-list 'debug-ignored-errors "^No symbol") (defun python-send-receive (string) "Send STRING to inferior Python (if any) and return result. -The result is what follows `_emacs_out' in the output (or nil)." +The result is what follows `_emacs_out' in the output." + (python-send-string string) (let ((proc (python-proc))) - (python-send-string string) - (setq python-preoutput-result nil) - (while (progn - (accept-process-output proc 5) - python-preoutput-leftover)) - python-preoutput-result)) - -;; Fixme: try to make it work with point in the arglist. Also, is -;; there anything reasonable we can do with random methods? + (with-current-buffer (process-buffer proc) + (set (make-local-variable 'python-preoutput-result) nil) + (while (progn + (accept-process-output proc 5) + (null python-preoutput-result))) + (prog1 python-preoutput-result + (kill-local-variable 'python-preoutput-result))))) + +;; Fixme: Is there anything reasonable we can do with random methods? ;; (Currently only works with functions.) (defun python-eldoc-function () "`eldoc-print-current-symbol-info' for Python. -Only works when point is in a function name, not its arglist, for instance. -Assumes an inferior Python is running." +Only works when point is in a function name, not its arg list, for +instance. Assumes an inferior Python is running." (let ((symbol (with-syntax-table python-dotty-syntax-table (current-word)))) - (when symbol - (python-send-receive (format "emacs.eargs(%S)" symbol))))) + ;; First try the symbol we're on. + (or (and symbol + (python-send-receive (format "emacs.eargs(%S, %s)" + symbol python-imports))) + ;; Try moving to symbol before enclosing parens. + (let ((s (syntax-ppss))) + (unless (zerop (car s)) + (when (eq ?\( (char-after (nth 1 s))) + (save-excursion + (goto-char (nth 1 s)) + (skip-syntax-backward "-") + (let ((point (point))) + (skip-chars-backward "a-zA-Z._") + (if (< (point) point) + (python-send-receive + (format "emacs.eargs(%S, %s)" + (buffer-substring-no-properties (point) point) + python-imports))))))))))) ;;;; Info-look functionality. @@ -1443,7 +1665,7 @@ Used with `eval-after-load'." ("(python-lib)Miscellaneous Index" nil "")))))) (eval-after-load "info-look" '(python-after-info-look)) -;;;; Miscellancy. +;;;; Miscellany. (defcustom python-jython-packages '("java" "javax" "org" "com") "Packages implying `jython-mode'. @@ -1473,8 +1695,8 @@ The criterion is either a match for `jython-mode' via (jython-mode) (if (catch 'done (while (re-search-forward - (rx (and line-start (or "import" "from") (1+ space) - (group (1+ (not (any " \t\n.")))))) + (rx line-start (or "import" "from") (1+ space) + (group (1+ (not (any " \t\n."))))) (+ (point-min) 10000) ; Probably not worth customizing. t) (if (member (match-string 1) python-jython-packages) @@ -1562,7 +1784,7 @@ END lie." "`outline-level' function for Python mode. The level is the number of `python-indent' steps of indentation of current line." - (/ (current-indentation) python-indent)) + (1+ (/ (current-indentation) python-indent))) ;; Fixme: Consider top-level assignments, imports, &c. (defun python-current-defun () @@ -1577,10 +1799,8 @@ of current line." (python-beginning-of-block) (end-of-line) (beginning-of-defun) - (if (looking-at (rx (and (0+ space) (or "def" "class") (1+ space) - (group (1+ (or word (syntax symbol)))) - ;; Greediness makes this unnecessary? --Stef - symbol-end))) + (if (looking-at (rx (0+ space) (or "def" "class") (1+ space) + (group (1+ (or word (syntax symbol)))))) (push (match-string 1) accum))) (if accum (mapconcat 'identity accum "."))))) @@ -1593,17 +1813,68 @@ Uses `python-beginning-of-block', `python-end-of-block'." (push-mark (point) nil t) (python-end-of-block) (exchange-point-and-mark)) + +;; Fixme: Provide a find-function-like command to find source of a +;; definition (separate from BicycleRepairMan). Complicated by +;; finding the right qualified name. ;;;; Completion. +(defvar python-imports nil + "String of top-level import statements updated by `python-find-imports'.") +(make-variable-buffer-local 'python-imports) + +;; Fixme: Should font-lock try to run this when it deals with an import? +;; Maybe not a good idea if it gets run multiple times when the +;; statement is being edited, and is more likely to end up with +;; something syntactically incorrect. +;; However, what we should do is to trundle up the block tree from point +;; to extract imports that appear to be in scope, and add those. +(defun python-find-imports () + "Find top-level imports, updating `python-imports'." + (interactive) + (save-excursion + (let (lines) + (goto-char (point-min)) + (while (re-search-forward "^import\\>\\|^from\\>" nil t) + (unless (syntax-ppss-context (syntax-ppss)) + (push (buffer-substring (line-beginning-position) + (line-beginning-position 2)) + lines))) + (setq python-imports + (if lines + (apply #'concat +;; This is probably best left out since you're unlikely to need the +;; doc for a function in the buffer and the import will lose if the +;; Python sub-process' working directory isn't the same as the +;; buffer's. +;; (if buffer-file-name +;; (concat +;; "import " +;; (file-name-sans-extension +;; (file-name-nondirectory buffer-file-name)))) + (nreverse lines)) + "None")) + (when lines + (set-text-properties 0 (length python-imports) nil python-imports) + ;; The output ends up in the wrong place if the string we + ;; send contains newlines (from the imports). + (setq python-imports + (replace-regexp-in-string "\n" "\\n" + (format "%S" python-imports) t t)))))) + +;; Fixme: This fails the first time if the sub-process isn't already +;; running. Presumably a timing issue with i/o to the process. (defun python-symbol-completions (symbol) "Return a list of completions of the string SYMBOL from Python process. -The list is sorted." +The list is sorted. +Uses `python-imports' to load modules against which to complete." (when symbol (let ((completions (condition-case () - (car (read-from-string (python-send-receive - (format "emacs.complete(%S)" symbol)))) + (car (read-from-string + (python-send-receive + (format "emacs.complete(%S,%s)" symbol python-imports)))) (error nil)))) (sort ;; We can get duplicates from the above -- don't know why. @@ -1615,15 +1886,12 @@ The list is sorted." (let ((end (point)) (start (save-excursion (and (re-search-backward - (rx (and (or buffer-start (regexp "[^[:alnum:]._]")) - (group (1+ (regexp "[[:alnum:]._]"))) - point)) + (rx (or buffer-start (regexp "[^[:alnum:]._]")) + (group (1+ (regexp "[[:alnum:]._]"))) point) nil t) (match-beginning 1))))) (if start (buffer-substring-no-properties start end)))) -;; Fixme: We should have an abstraction of this sort of thing in the -;; core. (defun python-complete-symbol () "Perform completion on the Python symbol preceding point. Repeating the command scrolls the completion window." @@ -1658,11 +1926,9 @@ Repeating the command scrolls the completion window." (display-completion-list completions symbol)) (message "Making completion list...%s" "done")))))))) -(eval-when-compile (require 'hippie-exp)) - (defun python-try-complete (old) "Completion function for Python for use with `hippie-expand'." - (when (eq major-mode 'python-mode) ; though we only add it locally + (when (derived-mode-p 'python-mode) ; though we only add it locally (unless old (let ((symbol (python-partial-symbol))) (he-init-string (- (point) (length symbol)) (point)) @@ -1680,16 +1946,212 @@ Repeating the command scrolls the completion window." (if old (he-reset-string)) nil))) +;;;; FFAP support + +(defun python-module-path (module) + "Function for `ffap-alist' to return path to MODULE." + (python-send-receive (format "emacs.modpath (%S)" module))) + +(eval-after-load "ffap" + '(push '(python-mode . python-module-path) ffap-alist)) + +;;;; Skeletons + +(defvar python-skeletons nil + "Alist of named skeletons for Python mode. +Elements are of the form (NAME . EXPANDER-FUNCTION).") + +(defvar python-mode-abbrev-table nil + "Abbrev table for Python mode. +The default contents correspond to the elements of `python-skeletons'.") +(define-abbrev-table 'python-mode-abbrev-table ()) + +(eval-when-compile + ;; Define a user-level skeleton and add it to `python-skeletons' and + ;; the abbrev table. +(defmacro def-python-skeleton (name &rest elements) + (let* ((name (symbol-name name)) + (function (intern (concat "python-insert-" name)))) + `(progn + (add-to-list 'python-skeletons ',(cons name function)) + (define-abbrev python-mode-abbrev-table ,name "" ',function nil t) + (define-skeleton ,function + ,(format "Insert Python \"%s\" template." name) + ,@elements))))) +(put 'def-python-skeleton 'lisp-indent-function 2) + +;; From `skeleton-further-elements': +;; `<': outdent a level; +;; `^': delete indentation on current line and also previous newline. +;; Not quote like `delete-indentation'. Assumes point is at +;; beginning of indentation. + +(def-python-skeleton if + "Condition: " + "if " str ":" \n + > _ \n + ("other condition, %s: " + < ; Avoid wrong indentation after block opening. + "elif " str ":" \n + > _ \n nil) + (python-else) | ^) + +(define-skeleton python-else + "Auxiliary skeleton." + nil + (unless (eq ?y (read-char "Add `else' clause? (y for yes or RET for no) ")) + (signal 'quit t)) + < "else:" \n + > _ \n) + +(def-python-skeleton while + "Condition: " + "while " str ":" \n + > _ \n + (python-else) | ^) + +(def-python-skeleton for + "Target, %s: " + "for " str " in " (skeleton-read "Expression, %s: ") ":" \n + > _ \n + (python-else) | ^) + +(def-python-skeleton try/except + nil + "try:" \n + > _ \n + ("Exception, %s: " + < "except " str (python-target) ":" \n + > _ \n nil) + < "except:" \n + > _ \n + (python-else) | ^) + +(define-skeleton python-target + "Auxiliary skeleton." + "Target, %s: " ", " str | -2) + +(def-python-skeleton try/finally + nil + "try:" \n + > _ \n + < "finally:" \n + > _ \n) + +(def-python-skeleton def + "Name: " + "def " str " (" ("Parameter, %s: " (unless (equal ?\( (char-before)) ", ") + str) "):" \n + "\"\"\"" @ " \"\"\"" \n ; Fixme: syntaxification wrong for """""" + > _ \n) + +(def-python-skeleton class + "Name: " + "class " str " (" ("Inheritance, %s: " + (unless (equal ?\( (char-before)) ", ") + str) + & ")" | -2 ; close list or remove opening + ":" \n + "\"\"\"" @ " \"\"\"" \n + > _ \n) + +(defvar python-default-template "if" + "Default template to expand by `python-insert-template'. +Updated on each expansion.") + +(defun python-expand-template (name) + "Expand template named NAME. +Interactively, prompt for the name with completion." + (interactive + (list (completing-read (format "Template to expand (default %s): " + python-default-template) + python-skeletons nil t))) + (if (equal "" name) + (setq name python-default-template) + (setq python-default-template name)) + (let ((func (cdr (assoc name python-skeletons)))) + (if func + (funcall func) + (error "Undefined template: %s" name)))) + +;;;; Bicycle Repair Man support + +(autoload 'pymacs-load "pymacs" nil t) +(autoload 'brm-init "bikemacs") + +;; I'm not sure how useful BRM really is, and it's certainly dangerous +;; the way it modifies files outside Emacs... Also note that the +;; current BRM loses with tabs used for indentation -- I submitted a +;; fix <URL:http://www.loveshack.ukfsn.org/emacs/bikeemacs.py.diff>. +(defun python-setup-brm () + "Set up Bicycle Repair Man refactoring tool (if available). + +Note that the `refactoring' features change files independently of +Emacs and may modify and save the contents of the current buffer +without confirmation." + (interactive) + (condition-case data + (unless (fboundp 'brm-rename) + (pymacs-load "bikeemacs" "brm-") ; first line of normal recipe + (let ((py-mode-map (make-sparse-keymap)) ; it assumes this + (features (cons 'python-mode features))) ; and requires this + (brm-init)) ; second line of normal recipe + (remove-hook 'python-mode-hook ; undo this from `brm-init' + '(lambda () (easy-menu-add brm-menu))) + (easy-menu-define + python-brm-menu python-mode-map + "Bicycle Repair Man" + '("BicycleRepairMan" + :help "Interface to navigation and refactoring tool" + "Queries" + ["Find References" brm-find-references + :help "Find references to name at point in compilation buffer"] + ["Find Definition" brm-find-definition + :help "Find definition of name at point"] + "-" + "Refactoring" + ["Rename" brm-rename + :help "Replace name at point with a new name everywhere"] + ["Extract Method" brm-extract-method + :active (and mark-active (not buffer-read-only)) + :help "Replace statements in region with a method"] + ["Extract Local Variable" brm-extract-local-variable + :active (and mark-active (not buffer-read-only)) + :help "Replace expression in region with an assignment"] + ["Inline Local Variable" brm-inline-local-variable + :help + "Substitute uses of variable at point with its definition"] + ;; Fixme: Should check for anything to revert. + ["Undo Last Refactoring" brm-undo :help ""]))) + (error (error "Bicyclerepairman setup failed: %s" data)))) + ;;;; Modes. (defvar outline-heading-end-regexp) (defvar eldoc-documentation-function) +;; Stuff to allow expanding abbrevs with non-word constituents. +(defun python-abbrev-pc-hook () + "Set the syntax table before possibly expanding abbrevs." + (remove-hook 'post-command-hook 'python-abbrev-pc-hook t) + (set-syntax-table python-mode-syntax-table)) + +(defvar python-abbrev-syntax-table + (copy-syntax-table python-mode-syntax-table) + "Syntax table used when expanding abbrevs.") + +(defun python-pea-hook () + "Reset the syntax table after possibly expanding abbrevs." + (set-syntax-table python-abbrev-syntax-table) + (add-hook 'post-command-hook 'python-abbrev-pc-hook nil t)) +(modify-syntax-entry ?/ "w" python-abbrev-syntax-table) + +(defvar python-mode-running) ;Dynamically scoped var. + ;;;###autoload (define-derived-mode python-mode fundamental-mode "Python" "Major mode for editing Python files. -Turns on Font Lock mode unconditionally since it is required for correct -parsing of the source. +Font Lock mode is currently required for correct parsing of the source. See also `jython-mode', which is actually invoked if the buffer appears to contain Jython code. See also `run-python' and associated Python mode commands for running Python under Emacs. @@ -1703,21 +2165,27 @@ the end of definitions at that level, when they move up a level. Colon is electric: it outdents the line if appropriate, e.g. for an else statement. \\[python-backspace] at the beginning of an indented statement deletes a level of indentation to close the current block; otherwise it -deletes a charcter backward. TAB indents the current line relative to +deletes a character backward. TAB indents the current line relative to the preceding code. Successive TABs, with no intervening command, cycle through the possibilities for indentation on the basis of enclosing blocks. -\\[fill-paragraph] fills comments and multiline strings appropriately, but has no +\\[fill-paragraph] fills comments and multi-line strings appropriately, but has no effect outside them. Supports Eldoc mode (only for functions, using a Python process), Info-Look and Imenu. In Outline minor mode, `class' and `def' -lines count as headers. +lines count as headers. Symbol completion is available in the +same way as in the Python shell using the `rlcompleter' module +and this is added to the Hippie Expand functions locally if +Hippie Expand mode is turned on. Completion of symbols of the +form x.y only works if the components are literal +module/attribute names, not variables. An abbrev table is set up +with skeleton expansions for compound statement templates. \\{python-mode-map}" :group 'python (set (make-local-variable 'font-lock-defaults) - '(python-font-lock-keywords nil nil ((?_ . "w")) nil + '(python-font-lock-keywords nil nil nil nil (font-lock-syntactic-keywords . python-font-lock-syntactic-keywords) ;; This probably isn't worth it. @@ -1726,15 +2194,17 @@ lines count as headers. )) (set (make-local-variable 'parse-sexp-lookup-properties) t) (set (make-local-variable 'comment-start) "# ") - (set (make-local-variable 'comment-indent-function) #'python-comment-indent) (set (make-local-variable 'indent-line-function) #'python-indent-line) + (set (make-local-variable 'indent-region-function) #'python-indent-region) (set (make-local-variable 'paragraph-start) "\\s-*$") (set (make-local-variable 'fill-paragraph-function) 'python-fill-paragraph) (set (make-local-variable 'require-final-newline) mode-require-final-newline) (set (make-local-variable 'add-log-current-defun-function) #'python-current-defun) - ;; Fixme: Generalize to do all blocks? - (set (make-local-variable 'outline-regexp) "\\s-*\\(def\\|class\\)\\>") + (set (make-local-variable 'outline-regexp) + (rx (* space) (or "class" "def" "elif" "else" "except" "finally" + "for" "if" "try" "while") + symbol-end)) (set (make-local-variable 'outline-heading-end-regexp) ":\\s-*\n") (set (make-local-variable 'outline-level) #'python-outline-level) (set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil) @@ -1746,30 +2216,45 @@ lines count as headers. (set (make-local-variable 'eldoc-documentation-function) #'python-eldoc-function) (add-hook 'eldoc-mode-hook - '(lambda () (run-python nil t)) nil t) ; need it running - (unless (assoc 'python-mode hs-special-modes-alist) - (setq - hs-special-modes-alist - (cons (list - 'python-mode "^\\s-*def\\>" nil "#" - (lambda (arg)(python-end-of-defun)(skip-chars-backward " \t\n")) - nil) - hs-special-modes-alist))) + (lambda () (run-python nil t)) ; need it running + nil t) + ;; Fixme: should be in hideshow. This seems to be of limited use + ;; since it isn't (can't be) indentation-based. Also hide-level + ;; doesn't seem to work properly. + (add-to-list 'hs-special-modes-alist + `(python-mode "^\\s-*def\\>" nil "#" + ,(lambda (arg) + (python-end-of-defun) + (skip-chars-backward " \t\n")) + nil)) + (set (make-local-variable 'skeleton-further-elements) + '((< '(backward-delete-char-untabify (min python-indent + (current-column)))) + (^ '(- (1+ (current-indentation)))))) + (add-hook 'pre-abbrev-expand-hook 'python-pea-hook nil t) (if (featurep 'hippie-exp) (set (make-local-variable 'hippie-expand-try-functions-list) (cons 'python-try-complete hippie-expand-try-functions-list))) + ;; Python defines TABs as being 8-char wide. + (set (make-local-variable 'tab-width) 8) (when python-guess-indent (python-guess-indent)) + ;; Let's make it harder for the user to shoot himself in the foot. + (unless (= tab-width python-indent) + (setq indent-tabs-mode nil)) (set (make-local-variable 'python-command) python-python-command) + (python-find-imports) (unless (boundp 'python-mode-running) ; kill the recursion from jython-mode (let ((python-mode-running t)) (python-maybe-jython)))) (custom-add-option 'python-mode-hook 'imenu-add-menubar-index) (custom-add-option 'python-mode-hook - '(lambda () - "Turn on Indent Tabs mode." - (set (make-local-variable 'indent-tabs-mode) t))) + (lambda () + "Turn off Indent Tabs mode." + (set (make-local-variable 'indent-tabs-mode) nil))) (custom-add-option 'python-mode-hook 'turn-on-eldoc-mode) +(custom-add-option 'python-mode-hook 'abbrev-mode) +(custom-add-option 'python-mode-hook 'python-setup-brm) ;;;###autoload (define-derived-mode jython-mode python-mode "Jython" @@ -1780,5 +2265,6 @@ Runs `jython-mode-hook' after `python-mode-hook'." (set (make-local-variable 'python-command) python-jython-command)) (provide 'python) +(provide 'python-21) ;; arch-tag: 6fce1d99-a704-4de9-ba19-c6e4912b0554 ;;; python.el ends here diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 6098c8be06..f828c36917 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -986,7 +986,9 @@ subshells can nest." ;; FIXME: This can (and often does) match multiple lines, yet it makes no ;; effort to handle multiline cases correctly, so it ends up being ;; rather flakey. - (when (re-search-forward "\"\\(?:\\(?:.\\|\n\\)*?[^\\]\\(?:\\\\\\\\\\)*\\)??\\(\\$(\\|`\\)" limit t) + (when (and (re-search-forward "\"\\(?:\\(?:.\\|\n\\)*?[^\\]\\(?:\\\\\\\\\\)*\\)??\\(\\$(\\|`\\)" limit t) + ;; Make sure the " we matched is an opening quote. + (eq ?\" (nth 3 (syntax-ppss)))) ;; bingo we have a $( or a ` inside a "" (let ((char (char-after (point))) (continue t) @@ -1081,9 +1083,6 @@ This is used to flag quote characters in subshell constructs inside strings ("\\(\\\\\\)'" 1 ,sh-st-punc) ;; Make sure $@ and @? are correctly recognized as sexps. ("\\$\\([?@]\\)" 1 ,sh-st-symbol) - ;; highlight (possibly nested) subshells inside "" quoted regions correctly. - (sh-quoted-subshell - (1 (sh-apply-quoted-subshell) t t)) ;; Find HEREDOC starters and add a corresponding rule for the ender. (sh-font-lock-here-doc (2 (sh-font-lock-open-heredoc @@ -1093,7 +1092,11 @@ This is used to flag quote characters in subshell constructs inside strings (and (match-beginning 3) (/= (match-beginning 3) (match-end 3)))) nil t)) ;; Distinguish the special close-paren in `case'. - (")" 0 (sh-font-lock-paren (match-beginning 0))))) + (")" 0 (sh-font-lock-paren (match-beginning 0))) + ;; highlight (possibly nested) subshells inside "" quoted regions correctly. + ;; This should be at the very end because it uses syntax-ppss. + (sh-quoted-subshell + (1 (sh-apply-quoted-subshell) t t)))) (defun sh-font-lock-syntactic-face-function (state) (let ((q (nth 3 state))) diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 987b37cf2c..cf887394e6 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -14112,8 +14112,8 @@ if required." (defun vhdl-speedbar-display-directory (directory depth &optional rescan) "Display directory and hierarchy information in speedbar." (setq vhdl-speedbar-show-projects nil) - (setq speedbar-ignored-path-regexp - (speedbar-extension-list-to-regex speedbar-ignored-path-expressions)) + (setq speedbar-ignored-directory-regexp + (speedbar-extension-list-to-regex speedbar-ignored-directory-expressions)) (setq directory (abbreviate-file-name (file-name-as-directory directory))) (setq speedbar-last-selected-file nil) (speedbar-with-writable @@ -14133,7 +14133,7 @@ if required." (defun vhdl-speedbar-display-projects (project depth &optional rescan) "Display projects and hierarchy information in speedbar." (setq vhdl-speedbar-show-projects t) - (setq speedbar-ignored-path-regexp ".") + (setq speedbar-ignored-directory-regexp ".") (setq speedbar-last-selected-file nil) (setq vhdl-speedbar-last-selected-project nil) (speedbar-with-writable diff --git a/lisp/rect.el b/lisp/rect.el index be3a65ccd6..9515733ef2 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -181,12 +181,9 @@ the function is called." ;; this one is untouched --dv (defun spaces-string (n) + "Returns a string with N spaces." (if (<= n 8) (aref spaces-strings n) - (let ((val "")) - (while (> n 8) - (setq val (concat " " val) - n (- n 8))) - (concat val (aref spaces-strings n))))) + (make-string n ? ))) ;;;###autoload (defun delete-rectangle (start end &optional fill) diff --git a/lisp/simple.el b/lisp/simple.el index 67cd341bf1..f07006b5cc 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -887,7 +887,9 @@ and the greater of them is not at the start of a line." (defun line-number-at-pos (&optional pos) "Return (narrowed) buffer line number at position POS. -If POS is nil, use current buffer location." +If POS is nil, use current buffer location. +Counting starts at (point-min), so the value refers +to the contents of the accessible portion of the buffer." (let ((opoint (or pos (point))) start) (save-excursion (goto-char (point-min)) @@ -3689,7 +3691,10 @@ because what we really need is for `move-to-column' and `current-column' to be able to ignore invisible text." (if (zerop col) (beginning-of-line) - (move-to-column col)) + (let ((opoint (point))) + (move-to-column col) + ;; move-to-column doesn't respect field boundaries. + (goto-char (constrain-to-field (point) opoint)))) (when (and line-move-ignore-invisible (not (bolp)) (line-move-invisible-p (1- (point)))) @@ -3759,7 +3764,8 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." (interactive "p") (or arg (setq arg 1)) - (let ((orig (point))) + (let ((orig (point)) + start first-vis first-vis-field-value) ;; Move by lines, if ARG is not 1 (the default). (if (/= arg 1) @@ -3770,10 +3776,24 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." (while (and (not (bobp)) (line-move-invisible-p (1- (point)))) (goto-char (previous-char-property-change (point))) (skip-chars-backward "^\n")) - - ;; Take care of fields. - (goto-char (constrain-to-field (point) orig - (/= arg 1) t nil)))) + (setq start (point)) + + ;; Now find first visible char in the line + (while (and (not (eobp)) (line-move-invisible-p (point))) + (goto-char (next-char-property-change (point)))) + (setq first-vis (point)) + + ;; See if fields would stop us from reaching FIRST-VIS. + (setq first-vis-field-value + (constrain-to-field first-vis orig (/= arg 1) t nil)) + + (goto-char (if (/= first-vis-field-value first-vis) + ;; If yes, obey them. + first-vis-field-value + ;; Otherwise, move to START with attention to fields. + ;; (It is possible that fields never matter in this case.) + (constrain-to-field (point) orig + (/= arg 1) t nil))))) ;;; Many people have said they rarely use this feature, and often type diff --git a/lisp/startup.el b/lisp/startup.el index 5a6b408977..b96503603c 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1249,11 +1249,16 @@ where FACE is a valid face specification, as it can be used with "GNU Emacs is one component of the GNU/Linux operating system." "GNU Emacs is one component of the GNU operating system.")) (insert "\n") - (unless (equal (buffer-name fancy-splash-outer-buffer) "*scratch*") - (fancy-splash-insert :face 'variable-pitch - (substitute-command-keys - "Type \\[recenter] to begin editing your file.\n")))) - + (if fancy-splash-outer-buffer + (fancy-splash-insert + :face 'variable-pitch + (substitute-command-keys + (concat + "Type \\[recenter] to begin editing" + (if (equal (buffer-name fancy-splash-outer-buffer) + "*scratch*") + ".\n" + " your file.\n")))))) (defun fancy-splash-tail () "Insert the tail part of the splash screen into the current buffer." @@ -1333,55 +1338,74 @@ mouse." (if (frame-live-p frame) (run-at-time 0 nil 'fancy-splash-exit))) -(defun fancy-splash-screens () +(defun fancy-splash-screens (&optional hide-on-input) "Display fancy splash screens when Emacs starts." (setq fancy-splash-help-echo (startup-echo-area-message)) - (let ((old-hourglass display-hourglass) - (fancy-splash-outer-buffer (current-buffer)) - splash-buffer - (old-minor-mode-map-alist minor-mode-map-alist) - (old-emulation-mode-map-alists emulation-mode-map-alists) - (frame (fancy-splash-frame)) - timer) - (save-selected-window - (select-frame frame) - (switch-to-buffer "GNU Emacs") - (setq tab-width 20) - (setq splash-buffer (current-buffer)) - (catch 'stop-splashing - (unwind-protect - (let* ((map (make-sparse-keymap)) - (overriding-local-map map) - ;; Catch if our frame is deleted; the delete-frame - ;; event is unreliable and is handled by - ;; `special-event-map' anyway. - (delete-frame-functions (cons 'fancy-splash-delete-frame - delete-frame-functions))) - (define-key map [t] 'fancy-splash-default-action) - (define-key map [mouse-movement] 'ignore) - (define-key map [mode-line t] 'ignore) - (define-key map [select-window] 'ignore) - (setq cursor-type nil - display-hourglass nil - minor-mode-map-alist nil - emulation-mode-map-alists nil - buffer-undo-list t - mode-line-format (propertize "---- %b %-" - 'face 'mode-line-buffer-id) - fancy-splash-stop-time (+ (float-time) - fancy-splash-max-time) - timer (run-with-timer 0 fancy-splash-delay - #'fancy-splash-screens-1 - splash-buffer)) - (recursive-edit)) - (cancel-timer timer) - (setq display-hourglass old-hourglass - minor-mode-map-alist old-minor-mode-map-alist - emulation-mode-map-alists old-emulation-mode-map-alists) - (kill-buffer splash-buffer) - (when (frame-live-p frame) - (select-frame frame) - (switch-to-buffer fancy-splash-outer-buffer))))))) + (if hide-on-input + (let ((old-hourglass display-hourglass) + (fancy-splash-outer-buffer (current-buffer)) + splash-buffer + (old-minor-mode-map-alist minor-mode-map-alist) + (old-emulation-mode-map-alists emulation-mode-map-alists) + (frame (fancy-splash-frame)) + timer) + (save-selected-window + (select-frame frame) + (switch-to-buffer "GNU Emacs") + (setq tab-width 20) + (setq splash-buffer (current-buffer)) + (catch 'stop-splashing + (unwind-protect + (let* ((map (make-sparse-keymap)) + (overriding-local-map map) + ;; Catch if our frame is deleted; the delete-frame + ;; event is unreliable and is handled by + ;; `special-event-map' anyway. + (delete-frame-functions (cons 'fancy-splash-delete-frame + delete-frame-functions))) + (define-key map [t] 'fancy-splash-default-action) + (define-key map [mouse-movement] 'ignore) + (define-key map [mode-line t] 'ignore) + (define-key map [select-window] 'ignore) + (setq cursor-type nil + display-hourglass nil + minor-mode-map-alist nil + emulation-mode-map-alists nil + buffer-undo-list t + mode-line-format (propertize "---- %b %-" + 'face 'mode-line-buffer-id) + fancy-splash-stop-time (+ (float-time) + fancy-splash-max-time) + timer (run-with-timer 0 fancy-splash-delay + #'fancy-splash-screens-1 + splash-buffer)) + (recursive-edit)) + (cancel-timer timer) + (setq display-hourglass old-hourglass + minor-mode-map-alist old-minor-mode-map-alist + emulation-mode-map-alists old-emulation-mode-map-alists) + (kill-buffer splash-buffer) + (when (frame-live-p frame) + (select-frame frame) + (switch-to-buffer fancy-splash-outer-buffer)))))) + ;; If hide-on-input is non-nil, don't hide the buffer on input. + (if (or (window-minibuffer-p) + (window-dedicated-p (selected-window))) + (pop-to-buffer (current-buffer)) + (switch-to-buffer "GNU Emacs")) + (erase-buffer) + (if pure-space-overflow + (insert "\ +Warning Warning!!! Pure space overflow !!!Warning Warning +\(See the node Pure Storage in the Lisp manual for details.)\n")) + (let (fancy-splash-outer-buffer) + (fancy-splash-head) + (dolist (text fancy-splash-text) + (apply #'fancy-splash-insert text)) + (fancy-splash-tail) + (set-buffer-modified-p nil) + (goto-char (point-min))))) + (defun fancy-splash-frame () "Return the frame to use for the fancy splash screen. @@ -1412,14 +1436,16 @@ we put it on this frame." (> window-height (+ image-height 19))))))) -(defun normal-splash-screen () +(defun normal-splash-screen (&optional hide-on-input) "Display splash screen when Emacs starts." (let ((prev-buffer (current-buffer))) (unwind-protect (with-current-buffer (get-buffer-create "GNU Emacs") + (erase-buffer) (set (make-local-variable 'tab-width) 8) - (set (make-local-variable 'mode-line-format) - (propertize "---- %b %-" 'face 'mode-line-buffer-id)) + (if hide-on-input + (set (make-local-variable 'mode-line-format) + (propertize "---- %b %-" 'face 'mode-line-buffer-id))) (if pure-space-overflow (insert "\ @@ -1435,9 +1461,13 @@ Warning Warning!!! Pure space overflow !!!Warning Warning ", one component of the GNU/Linux operating system.\n" ", a part of the GNU operating system.\n")) - (unless (equal (buffer-name prev-buffer) "*scratch*") - (insert (substitute-command-keys - "\nType \\[recenter] to begin editing your file.\n"))) + (if hide-on-input + (insert (substitute-command-keys + (concat + "\nType \\[recenter] to begin editing" + (if (equal (buffer-name prev-buffer) "*scratch*") + ".\n" + " your file.\n"))))) (if (display-mouse-p) ;; The user can use the mouse to activate menus @@ -1548,20 +1578,23 @@ Type \\[describe-distribution] for information on getting the latest version.")) "type M-x recover-session RET\nto recover" " the files you were editing.")) - ;; Display the input that we set up in the buffer. - (set-buffer-modified-p nil) - (goto-char (point-min)) - (if (or (window-minibuffer-p) - (window-dedicated-p (selected-window))) - ;; There's no point is using pop-to-buffer since creating - ;; a new frame will generate enough events that the - ;; subsequent `sit-for' will immediately return anyway. - nil ;; (pop-to-buffer (current-buffer)) - (save-window-excursion - (switch-to-buffer (current-buffer)) - (sit-for 120)))) - ;; Unwind ... ensure splash buffer is killed - (kill-buffer "GNU Emacs")))) + ;; Display the input that we set up in the buffer. + (set-buffer-modified-p nil) + (goto-char (point-min)) + (if (or (window-minibuffer-p) + (window-dedicated-p (selected-window))) + ;; If hide-on-input is nil, creating a new frame will + ;; generate enough events that the subsequent `sit-for' + ;; will immediately return anyway. + (pop-to-buffer (current-buffer)) + (if hide-on-input + (save-window-excursion + (switch-to-buffer (current-buffer)) + (sit-for 120)) + (switch-to-buffer (current-buffer))))) + ;; Unwind ... ensure splash buffer is killed + (if hide-on-input + (kill-buffer "GNU Emacs"))))) (defun startup-echo-area-message () @@ -1615,7 +1648,7 @@ Type \\[describe-distribution] for information on getting the latest version.")) (message "%s" (startup-echo-area-message)))))) -(defun display-splash-screen () +(defun display-splash-screen (&optional hide-on-input) "Display splash screen according to display. Fancy splash screens are used on graphic displays, normal otherwise." @@ -1623,8 +1656,8 @@ normal otherwise." ;; Prevent recursive calls from server-process-filter. (if (not (get-buffer "GNU Emacs")) (if (use-fancy-splash-screens-p) - (fancy-splash-screens) - (normal-splash-screen)))) + (fancy-splash-screens hide-on-input) + (normal-splash-screen hide-on-input)))) (defun command-line-1 (command-line-args-left) (display-startup-echo-area-message) @@ -1888,7 +1921,7 @@ normal otherwise." ;; If user typed input during all that work, ;; abort the startup screen. Otherwise, display it now. (unless (input-pending-p) - (display-splash-screen)))) + (display-splash-screen t)))) (defun command-line-normalize-file-name (file) diff --git a/lisp/t-mouse.el b/lisp/t-mouse.el index 17d486749b..06b77840c0 100644 --- a/lisp/t-mouse.el +++ b/lisp/t-mouse.el @@ -292,9 +292,7 @@ Turn it on to use emacs mouse commands, and off to use t-mouse commands." "-f"))) (setq t-mouse-filter-accumulator "") (set-process-filter t-mouse-process 't-mouse-process-filter) -; use commented line instead for emacs 21.4 onwards - (process-kill-without-query t-mouse-process))) -; (set-process-query-on-exit-flag t-mouse-process nil))) + (set-process-query-on-exit-flag t-mouse-process nil))) ;; Turn it off (setq mouse-position-function nil) (delete-process t-mouse-process) diff --git a/lisp/term/mac-win.el b/lisp/term/mac-win.el index c66c59a088..9e3393b04a 100644 --- a/lisp/term/mac-win.el +++ b/lisp/term/mac-win.el @@ -1539,7 +1539,7 @@ in `selection-converter-alist', which see." (put 'autosave-now 'mac-apple-event-id "asav") ; kAEAutosaveNow ;; kAEInternetEventClass (put 'get-url 'mac-apple-event-id "GURL") ; kAEGetURL -;; Converted HICommand events +;; Converted HI command events (put 'about 'mac-apple-event-id "abou") ; kHICommandAbout (defmacro mac-event-spec (event) @@ -1739,7 +1739,7 @@ Currently the `mailto' scheme is supported." (define-key mac-apple-event-map [internet-event get-url] 'mac-ae-get-url) -(define-key mac-apple-event-map [hicommand about] 'display-splash-screen) +(define-key mac-apple-event-map [hi-command about] 'display-splash-screen) ;;; Converted Carbon Events (defun mac-handle-toolbar-switch-mode (event) @@ -2208,7 +2208,8 @@ See also `mac-dnd-known-types'." ;; If dropping in an ordinary window which we could use, ;; let dnd-open-file-other-window specify what to do. (progn - (goto-char (posn-point (event-start event))) + (when (not mouse-yank-at-point) + (goto-char (posn-point (event-start event)))) (funcall handler window action data)) ;; If we can't display the file here, ;; make a new window for it. @@ -2561,8 +2562,8 @@ ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman") ;; Initiate drag and drop -(global-set-key [drag-n-drop] 'mac-dnd-handle-drag-n-drop-event) -(global-set-key [M-drag-n-drop] 'mac-dnd-handle-drag-n-drop-event) +(define-key special-event-map [drag-n-drop] 'mac-dnd-handle-drag-n-drop-event) +(define-key special-event-map [M-drag-n-drop] 'mac-dnd-handle-drag-n-drop-event) ;;;; Non-toolkit Scroll bars diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 9730aca9b9..fe774a4125 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -2386,7 +2386,7 @@ order until succeed.") (defun x-clipboard-yank () "Insert the clipboard contents, or the last stretch of killed text." - (interactive) + (interactive "*") (let ((clipboard-text (x-selection-value 'CLIPBOARD)) (x-select-enable-clipboard t)) (if (and clipboard-text (> (length clipboard-text) 0)) @@ -2518,8 +2518,9 @@ order until succeed.") ;; Override Paste so it looks at CLIPBOARD first. (define-key menu-bar-edit-menu [paste] - (cons "Paste" (cons "Paste text from clipboard or kill ring" - 'x-clipboard-yank))) + '(menu-item "Paste" x-clipboard-yank + :enable (not buffer-read-only) + :help "Paste (yank) text most recently cut/copied")) (setq x-initialized t)) @@ -2531,7 +2532,7 @@ order until succeed.") ;; Initiate drag and drop (add-hook 'after-make-frame-functions 'x-dnd-init-frame) -(global-set-key [drag-n-drop] 'x-dnd-handle-drag-n-drop-event) +(define-key special-event-map [drag-n-drop] 'x-dnd-handle-drag-n-drop-event) ;; arch-tag: f1501302-db8b-4d95-88e3-116697d89f78 ;;; x-win.el ends here diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index 9c4b8b1190..2e498a8de8 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -159,8 +159,37 @@ (define-key xterm-function-map "\e[4~" [select]) (define-key xterm-function-map "\e[29~" [print]) -;; These keys are available in xterm starting from version 214 +;; These keys are available in xterm starting from version 216 ;; if the modifyOtherKeys resource is set to 1. + +(define-key xterm-function-map "\e[27;5;39~" [?\C-\']) +(define-key xterm-function-map "\e[27;5;45~" [?\C--]) + +(define-key xterm-function-map "\e[27;5;48~" [?\C-0]) +(define-key xterm-function-map "\e[27;5;49~" [?\C-1]) +;; Not all C-DIGIT keys have a distinct binding. +(define-key xterm-function-map "\e[27;5;57~" [?\C-9]) + +(define-key xterm-function-map "\e[27;5;59~" [?\C-\;]) +(define-key xterm-function-map "\e[27;5;61~" [?\C-=]) + + +(define-key xterm-function-map "\e[27;6;33~" [?\C-!]) +(define-key xterm-function-map "\e[27;6;34~" [?\C-\"]) +(define-key xterm-function-map "\e[27;6;35~" [?\C-#]) +(define-key xterm-function-map "\e[27;6;36~" [?\C-$]) +(define-key xterm-function-map "\e[27;6;37~" [?\C-%]) +(define-key xterm-function-map "\e[27;6;38~" [(C-&)]) +(define-key xterm-function-map "\e[27;6;40~" [?\C-(]) +(define-key xterm-function-map "\e[27;6;41~" [?\C-)]) +(define-key xterm-function-map "\e[27;6;42~" [?\C-*]) +(define-key xterm-function-map "\e[27;6;43~" [?\C-+]) + +(define-key xterm-function-map "\e[27;6;58~" [?\C-:]) +(define-key xterm-function-map "\e[27;6;60~" [?\C-<]) +(define-key xterm-function-map "\e[27;6;62~" [?\C->]) +(define-key xterm-function-map "\e[27;6;63~" [(C-\?)]) + (define-key xterm-function-map "\e[27;5;9~" [C-tab]) (define-key xterm-function-map "\e[27;5;13~" [C-return]) (define-key xterm-function-map "\e[27;5;44~" [?\C-,]) diff --git a/lisp/textmodes/dns-mode.el b/lisp/textmodes/dns-mode.el index a323d4c446..21fe137118 100644 --- a/lisp/textmodes/dns-mode.el +++ b/lisp/textmodes/dns-mode.el @@ -90,6 +90,18 @@ :type 'sexp :group 'dns-mode) +(defcustom dns-mode-soa-auto-increment-serial t + "Whether to increment the SOA serial number automatically. + +If this variable is t, the serial number is incremented upon each save of +the file. If it is `ask', Emacs asks for confirmation whether it should +increment the serial upon saving. If nil, serials must be incremented +manually with \\[dns-mode-soa-increment-serial]." + :type '(choice (const :tag "Always" t) + (const :tag "Ask" ask) + (const :tag "Never" nil)) + :group 'dns-mode) + ;; Syntax table. (defvar dns-mode-syntax-table @@ -135,8 +147,12 @@ Turning on DNS mode runs `dns-mode-hook'." (unless (featurep 'xemacs) (set (make-local-variable 'font-lock-defaults) '(dns-mode-font-lock-keywords nil nil ((?_ . "w"))))) + (add-hook 'before-save-hook 'dns-mode-soa-maybe-increment-serial + nil t) (easy-menu-add dns-mode-menu dns-mode-map)) +;;;###autoload (defalias 'zone-mode 'dns-mode) + ;; Tools. ;;;###autoload @@ -192,6 +208,21 @@ Turning on DNS mode runs `dns-mode-hook'." (message "Replaced old serial %s with %s" serial new)) (error "Cannot locate serial number in SOA record")))))) +(defun dns-mode-soa-maybe-increment-serial () + "Increment SOA serial if needed. + +This function is run from `before-save-hook'." + (when (and (buffer-modified-p) + dns-mode-soa-auto-increment-serial + (or (eq dns-mode-soa-auto-increment-serial t) + (y-or-n-p "Increment SOA serial? "))) + ;; If `dns-mode-soa-increment-serial' signals an error saving will + ;; fail but that probably means that the serial should be fixed to + ;; comply with the RFC anyway! -rfr + (progn (dns-mode-soa-increment-serial) + ;; We return nil in case this is used in write-contents-functions. + nil))) + ;;;###autoload(add-to-list 'auto-mode-alist '("\\.soa\\'" . dns-mode)) (provide 'dns-mode) diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el index 4cda0d6b3a..ecbcd86d04 100644 --- a/lisp/textmodes/org.el +++ b/lisp/textmodes/org.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <dominik at science dot uva dot nl> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ -;; Version: 4.43 +;; Version: 4.44 ;; ;; This file is part of GNU Emacs. ;; @@ -90,10 +90,12 @@ ;; ;; Recent changes ;; -------------- -;; Version 4.43 -;; - Big fixes +;; Version 4.44 +;; - Clock table can be done for a limited time interval. +;; - Obsolete support for the old outline mode has been removed. +;; - Bug fixes and code cleaning. ;; -;; Version 4.42 +;; Version 4.43 ;; - Bug fixes ;; - `s' key in the agenda saves all org-mode buffers. ;; @@ -212,16 +214,13 @@ ;;; Customization variables -(defvar org-version "4.43" +(defvar org-version "4.44" "The version number of the file org.el.") (defun org-version () (interactive) (message "Org-mode version %s" org-version)) -;; The following constant is for compatibility with different versions -;; of outline.el. -(defconst org-noutline-p (featurep 'noutline) - "Are we using the new outline mode?") +;; Compatibility constants (defconst org-xemacs-p (featurep 'xemacs)) ; not used by org.el itself (defconst org-format-transports-properties-p (let ((x "a")) @@ -1132,7 +1131,7 @@ files and the cdr the corresponding command. Possible values for the file identifier are \"ext\" A string identifying an extension `directory' Matches a directory - `remote' Matches a remove file, accessible through tramp or efs. + `remote' Matches a remote file, accessible through tramp or efs. Remote files most likely should be visited through emacs because external applications cannot handle such paths. t Default for all remaining files @@ -1831,6 +1830,7 @@ Org-mode files lives." (defcustom org-export-language-setup '(("en" "Author" "Date" "Table of Contents") + ("cs" "Autor" "Datum" "Obsah") ("da" "Ophavsmand" "Dato" "Indhold") ("de" "Autor" "Datum" "Inhaltsverzeichnis") ("es" "Autor" "Fecha" "\xccndice") @@ -2150,6 +2150,16 @@ you can \"misuse\" it to add arbitrary text to the header." :group 'org-export-html :type 'string) +(defcustom org-export-html-title-format "<h1 class=\"title\">%s</h1>\n" + "Format for typesetting the document title in HTML export." + :group 'org-export-html + :type 'string) + +(defcustom org-export-html-toplevel-hlevel 2 + "The <H> level for level 1 headings in HTML export." + :group 'org-export-html + :type 'string) + (defcustom org-export-html-link-org-files-as-html t "Non-nil means, make file links to `file.org' point to `file.html'. When org-mode is exporting an org-mode file to HTML, links to @@ -2694,6 +2704,10 @@ Also put tags into group 4 if tags are present.") (remove-text-properties 0 (length s) org-rm-props s) s) +(defsubst org-set-local (var value) + "Make VAR local in current buffer and set it to VALUE." + (set (make-variable-buffer-local var) value)) + (defsubst org-mode-p () "Check if the current buffer is in Org-mode." (eq major-mode 'org-mode)) @@ -2703,7 +2717,7 @@ Also put tags into group 4 if tags are present.") (when (org-mode-p) (let ((re (org-make-options-regexp '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" - "STARTUP" "ARCHIVE" "TAGS"))) + "STARTUP" "ARCHIVE" "TAGS" "CALC"))) (splitre "[ \t]+") kwds int key value cat arch tags) (save-excursion @@ -2755,10 +2769,10 @@ Also put tags into group 4 if tags are present.") (remove-text-properties 0 (length arch) '(face t fontified t) arch))) ))) - (and cat (set (make-local-variable 'org-category) cat)) - (and kwds (set (make-local-variable 'org-todo-keywords) kwds)) - (and arch (set (make-local-variable 'org-archive-location) arch)) - (and int (set (make-local-variable 'org-todo-interpretation) int)) + (and cat (org-set-local 'org-category cat)) + (and kwds (org-set-local 'org-todo-keywords kwds)) + (and arch (org-set-local 'org-archive-location arch)) + (and int (org-set-local 'org-todo-interpretation int)) (when tags (let (e tgs) (while (setq e (pop tags)) @@ -2770,7 +2784,7 @@ Also put tags into group 4 if tags are present.") (string-to-char (match-string 2 e))) tgs)) (t (push (list e) tgs)))) - (set (make-local-variable 'org-tag-alist) nil) + (org-set-local 'org-tag-alist nil) (while (setq e (pop tgs)) (or (and (stringp (car e)) (assoc (car e) org-tag-alist)) @@ -2928,15 +2942,11 @@ The following commands are available: ;; Need to do this here because define-derived-mode sets up ;; the keymap so late. (if (featurep 'xemacs) - (if org-noutline-p - (progn - (easy-menu-remove outline-mode-menu-heading) - (easy-menu-remove outline-mode-menu-show) - (easy-menu-remove outline-mode-menu-hide)) - (delete-menu-item '("Headings")) - (delete-menu-item '("Show")) - (delete-menu-item '("Hide")) - (set-menubar-dirty-flag)) + (progn + ;; Assume this is Greg's port, it used easymenu + (easy-menu-remove outline-mode-menu-heading) + (easy-menu-remove outline-mode-menu-show) + (easy-menu-remove outline-mode-menu-hide)) (define-key org-mode-map [menu-bar headings] 'undefined) (define-key org-mode-map [menu-bar hide] 'undefined) (define-key org-mode-map [menu-bar show] 'undefined)) @@ -2947,7 +2957,7 @@ The following commands are available: (if org-descriptive-links (org-add-to-invisibility-spec '(org-link))) (org-add-to-invisibility-spec '(org-cwidth)) (when (featurep 'xemacs) - (set (make-local-variable 'line-move-ignore-invisible) t)) + (org-set-local 'line-move-ignore-invisible t)) (setq outline-regexp "\\*+") ;;(setq outline-regexp "\\(?:\\*+\\|[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\) \\)") (setq outline-level 'org-outline-level) @@ -2958,12 +2968,14 @@ The following commands are available: 4 (string-to-vector org-ellipsis)) (setq buffer-display-table org-display-table)) (org-set-regexps-and-options) + ;; Calc embedded + (org-set-local 'calc-embedded-open-mode "# ") (modify-syntax-entry ?# "<") (if org-startup-truncated (setq truncate-lines t)) - (set (make-local-variable 'font-lock-unfontify-region-function) - 'org-unfontify-region) + (org-set-local 'font-lock-unfontify-region-function + 'org-unfontify-region) ;; Activate before-change-function - (set (make-local-variable 'org-table-may-need-update) t) + (org-set-local 'org-table-may-need-update t) (org-add-hook 'before-change-functions 'org-before-change-function nil 'local) ;; Check for running clock before killing a buffer @@ -3107,7 +3119,7 @@ that will be added to PLIST. Returns the string that was modified." org-ts-regexp "\\)?") "Regular expression matching a time stamp or time stamp range.") -(defvar org-�emph-face nil) +(defvar org-��emph-face nil) (defun org-do-emphasis-faces (limit) "Run through the buffer and add overlays to links." @@ -3340,10 +3352,9 @@ between words." ))) (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) ;; Now set the full font-lock-keywords - (set (make-local-variable 'org-font-lock-keywords) - org-font-lock-extra-keywords) - (set (make-local-variable 'font-lock-defaults) - '(org-font-lock-keywords t nil nil backward-paragraph)) + (org-set-local 'org-font-lock-keywords org-font-lock-extra-keywords) + (org-set-local 'font-lock-defaults + '(org-font-lock-keywords t nil nil backward-paragraph)) (kill-local-variable 'font-lock-keywords) nil)) (defvar org-m nil) @@ -3812,9 +3823,7 @@ state (TODO by default). Also with prefix arg, force first state." (org-insert-heading) (save-excursion (org-back-to-heading) - (if org-noutline-p - (outline-previous-heading) - (outline-previous-visible-heading t)) + (outline-previous-heading) (looking-at org-todo-line-regexp)) (if (or arg (not (match-beginning 2)) @@ -4703,7 +4712,7 @@ the children that do not contain any open TODO items." (pc '(:org-comment t)) (pall '(:org-archived t :org-comment t)) (rea (concat ":" org-archive-tag ":")) - bmp file re) + bmp file re) (save-excursion (while (setq file (pop files)) (org-check-agenda-file file) @@ -4775,7 +4784,7 @@ If not found, stay at current position and return nil." pos)) (defconst org-dblock-start-re - "^#\\+BEGIN:[ \t]+\\(\\S-+\\)[ \t]+\\(.*\\)" + "^#\\+BEGIN:[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?" "Matches the startline of a dynamic block, with parameters.") (defconst org-dblock-end-re "^#\\+END\\([: \t\r\n]\\|$\\)" @@ -4803,7 +4812,7 @@ the property list including an extra property :name with the block name." (let* ((begdel (1+ (match-end 0))) (name (match-string 1)) (params (append (list :name name) - (read (concat "(" (match-string 2) ")"))))) + (read (concat "(" (match-string 3) ")"))))) (unless (re-search-forward org-dblock-end-re nil t) (error "Dynamic block not terminated")) (delete-region begdel (match-beginning 0)) @@ -5200,7 +5209,6 @@ If CALLBACK is non-nil, it is a function which is called to confirm that the match should indeed be shown." (interactive "sRegexp: ") (org-remove-occur-highlights nil nil t) - (setq regexp (org-check-occur-regexp regexp)) (let ((cnt 0)) (save-excursion (goto-char (point-min)) @@ -5625,56 +5633,58 @@ next column. For time difference computation, a year is assumed to be exactly 365 days in order to avoid rounding problems." (interactive "P") - (save-excursion - (unless (org-at-date-range-p) - (goto-char (point-at-bol)) - (re-search-forward org-tr-regexp (point-at-eol) t)) - (if (not (org-at-date-range-p)) - (error "Not at a time-stamp range, and none found in current line"))) - (let* ((ts1 (match-string 1)) - (ts2 (match-string 2)) - (havetime (or (> (length ts1) 15) (> (length ts2) 15))) - (match-end (match-end 0)) - (time1 (org-time-string-to-time ts1)) - (time2 (org-time-string-to-time ts2)) - (t1 (time-to-seconds time1)) - (t2 (time-to-seconds time2)) - (diff (abs (- t2 t1))) - (negative (< (- t2 t1) 0)) - ;; (ys (floor (* 365 24 60 60))) - (ds (* 24 60 60)) - (hs (* 60 60)) - (fy "%dy %dd %02d:%02d") - (fy1 "%dy %dd") - (fd "%dd %02d:%02d") - (fd1 "%dd") - (fh "%02d:%02d") - y d h m align) - (if havetime - (setq ; y (floor (/ diff ys)) diff (mod diff ys) - y 0 - d (floor (/ diff ds)) diff (mod diff ds) - h (floor (/ diff hs)) diff (mod diff hs) - m (floor (/ diff 60))) - (setq ; y (floor (/ diff ys)) diff (mod diff ys) - y 0 - d (floor (+ (/ diff ds) 0.5)) - h 0 m 0)) - (if (not to-buffer) - (message (org-make-tdiff-string y d h m)) - (when (org-at-table-p) - (goto-char match-end) - (setq align t) - (and (looking-at " *|") (goto-char (match-end 0)))) - (if (looking-at - "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]") - (replace-match "")) - (if negative (insert " -")) - (if (> y 0) (insert " " (format (if havetime fy fy1) y d h m)) - (if (> d 0) (insert " " (format (if havetime fd fd1) d h m)) - (insert " " (format fh h m)))) - (if align (org-table-align)) - (message "Time difference inserted")))) + (or + (org-clock-update-time-maybe) + (save-excursion + (unless (org-at-date-range-p) + (goto-char (point-at-bol)) + (re-search-forward org-tr-regexp (point-at-eol) t)) + (if (not (org-at-date-range-p)) + (error "Not at a time-stamp range, and none found in current line"))) + (let* ((ts1 (match-string 1)) + (ts2 (match-string 2)) + (havetime (or (> (length ts1) 15) (> (length ts2) 15))) + (match-end (match-end 0)) + (time1 (org-time-string-to-time ts1)) + (time2 (org-time-string-to-time ts2)) + (t1 (time-to-seconds time1)) + (t2 (time-to-seconds time2)) + (diff (abs (- t2 t1))) + (negative (< (- t2 t1) 0)) + ;; (ys (floor (* 365 24 60 60))) + (ds (* 24 60 60)) + (hs (* 60 60)) + (fy "%dy %dd %02d:%02d") + (fy1 "%dy %dd") + (fd "%dd %02d:%02d") + (fd1 "%dd") + (fh "%02d:%02d") + y d h m align) + (if havetime + (setq ; y (floor (/ diff ys)) diff (mod diff ys) + y 0 + d (floor (/ diff ds)) diff (mod diff ds) + h (floor (/ diff hs)) diff (mod diff hs) + m (floor (/ diff 60))) + (setq ; y (floor (/ diff ys)) diff (mod diff ys) + y 0 + d (floor (+ (/ diff ds) 0.5)) + h 0 m 0)) + (if (not to-buffer) + (message (org-make-tdiff-string y d h m)) + (when (org-at-table-p) + (goto-char match-end) + (setq align t) + (and (looking-at " *|") (goto-char (match-end 0)))) + (if (looking-at + "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]") + (replace-match "")) + (if negative (insert " -")) + (if (> y 0) (insert " " (format (if havetime fy fy1) y d h m)) + (if (> d 0) (insert " " (format (if havetime fd fd1) d h m)) + (insert " " (format fh h m)))) + (if align (org-table-align)) + (message "Time difference inserted"))))) (defun org-make-tdiff-string (y d h m) (let ((fmt "") @@ -5817,6 +5827,7 @@ in the timestamp determines what will be changed." (setcar (nthcdr 2 time0) (or (nth 1 time0) 0)) (setq time (apply 'encode-time time0)))) (insert (setq org-last-changed-timestamp (format-time-string fmt time))) + (org-clock-update-time-maybe) (goto-char pos) ;; Try to recenter the calendar window, if any (if (and org-calendar-follow-timestamp-change @@ -5937,18 +5948,19 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." "Holds the file total time in minutes, after a call to `org-clock-sum'.") (make-variable-buffer-local 'org-clock-file-total-minutes) -(defun org-clock-sum () +(defun org-clock-sum (&optional tstart tend) "Sum the times for each subtree. Puts the resulting times in minutes as a text property on each headline." (interactive) (let* ((bmp (buffer-modified-p)) (re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" org-clock-string - ".*=>[ \t]*\\([0-9]+\\):\\([0-9]+\\)[ \t]*$")) + "[ \t]*\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)")) (lmax 30) (ltimes (make-vector lmax 0)) (t1 0) (level 0) + ts te dt time) (remove-text-properties (point-min) (point-max) '(:org-clock-minutes t)) (save-excursion @@ -5956,8 +5968,16 @@ Puts the resulting times in minutes as a text property on each headline." (while (re-search-backward re nil t) (if (match-end 2) ;; A time - (setq t1 (+ t1 (* 60 (string-to-number (match-string 2))) - (string-to-number (match-string 3)))) + (setq ts (match-string 2) + te (match-string 3) + ts (time-to-seconds + (apply 'encode-time (org-parse-time-string ts))) + te (time-to-seconds + (apply 'encode-time (org-parse-time-string te))) + ts (if tstart (max ts tstart) ts) + te (if tend (min te tend) te) + dt (- te ts) + t1 (if (> dt 0) (+ t1 (floor (/ dt 60))) t1)) ;; A headline (setq level (- (match-end 1) (match-beginning 1))) (when (or (> t1 0) (> (aref ltimes level) 0)) @@ -6069,26 +6089,112 @@ The BEGIN line can contain parameters. Allowed are: (interactive) (org-remove-clock-overlays) (unless (org-find-dblock "clocktable") - (org-create-dblock (list :name "clocktable" - :maxlevel 2 :emphasize nil))) + (org-create-dblock (list :name "clocktable" + :maxlevel 2 :emphasize nil))) (org-update-dblock)) +(defun org-clock-update-time-maybe () + "If this is a CLOCK line, update it and return t. +Otherwise, return nil." + (interactive) + (save-excursion + (beginning-of-line 1) + (skip-chars-forward " \t") + (when (looking-at org-clock-string) + (let ((re (concat "[ \t]*" org-clock-string + " *[[<]\\([^]>]+\\)[]>]-+[[<]\\([^]>]+\\)[]>]" + "\\([ \t]*=>.*\\)?")) + ts te h m s) + (if (not (looking-at re)) + nil + (and (match-end 3) (delete-region (match-beginning 3) (match-end 3))) + (end-of-line 1) + (setq ts (match-string 1) + te (match-string 2)) + (setq s (- (time-to-seconds + (apply 'encode-time (org-parse-time-string te))) + (time-to-seconds + (apply 'encode-time (org-parse-time-string ts)))) + h (floor (/ s 3600)) + s (- s (* 3600 h)) + m (floor (/ s 60)) + s (- s (* 60 s))) + (insert " => " (format "%2d:%02d" h m)) + t))))) + +(defun org-clock-special-range (key &optional time as-strings) + "Return two times bordering a special time range. +Key is a symbol specifying the range and can be one of `today', `yesterday', +`thisweek', `lastweek', `thismonth', `lastmonth', `thisyear', `lastyear'. +A week starts Monday 0:00 and ends Sunday 24:00. +The range is determined relative to TIME. TIME defaults to the current time. +The return value is a cons cell with two internal times like the ones +returned by `current time' or `encode-time'. if AS-STRINGS is non-nil, +the returned times will be formatted strings." + (let* ((tm (decode-time (or time (current-time)))) + (s 0) (m (nth 1 tm)) (h (nth 2 tm)) + (d (nth 3 tm)) (month (nth 4 tm)) (y (nth 5 tm)) + (dow (nth 6 tm)) + s1 m1 h1 d1 month1 y1 diff ts te fm) + (cond + ((eq key 'today) + (setq h 0 m 0 h1 24 m1 0)) + ((eq key 'yesterday) + (setq d (1- d) h 0 m 0 h1 24 m1 0)) + ((eq key 'thisweek) + (setq diff (if (= dow 0) 6 (1- dow)) + m 0 h 0 d (- d diff) d1 (+ 7 d))) + ((eq key 'lastweek) + (setq diff (+ 7 (if (= dow 0) 6 (1- dow))) + m 0 h 0 d (- d diff) d1 (+ 7 d))) + ((eq key 'thismonth) + (setq d 1 h 0 m 0 d1 1 month1 (1+ month) h1 0 m1 0)) + ((eq key 'lastmonth) + (setq d 1 h 0 m 0 d1 1 month (1- month) month1 (1+ month) h1 0 m1 0)) + ((eq key 'thisyear) + (setq m 0 h 0 d 1 month 1 y1 (1+ y))) + ((eq key 'lastyear) + (setq m 0 h 0 d 1 month 1 y (1- y) y1 (1+ y))) + (t (error "No such time block %s" key))) + (setq ts (encode-time s m h d month y) + te (encode-time (or s1 s) (or m1 m) (or h1 h) + (or d1 d) (or month1 month) (or y1 y))) + (setq fm (cdr org-time-stamp-formats)) + (if as-strings + (cons (format-time-string fm ts) (format-time-string fm te)) + (cons ts te)))) + (defun org-dblock-write:clocktable (params) "Write the standard clocktable." (let ((hlchars '((1 . "*") (2 . ?/))) (emph nil) (ins (make-marker)) - ipos time h m p level hlc hdl maxlevel) + ipos time h m p level hlc hdl maxlevel + ts te cc block) (setq maxlevel (or (plist-get params :maxlevel) 3) - emph (plist-get params :emphasize)) + emph (plist-get params :emphasize) + ts (plist-get params :tstart) + te (plist-get params :tend) + block (plist-get params :block)) + (when block + (setq cc (org-clock-special-range block nil t) + ts (car cc) te (cdr cc))) + (if ts (setq ts (time-to-seconds + (apply 'encode-time (org-parse-time-string ts))))) + (if te (setq te (time-to-seconds + (apply 'encode-time (org-parse-time-string te))))) (move-marker ins (point)) (setq ipos (point)) (insert-before-markers "Clock summary at [" (substring (format-time-string (cdr org-time-stamp-formats)) 1 -1) - "]\n|L|Headline|Time|\n") - (org-clock-sum) + "]." + (if block + (format " Considered range is /%s/." block) + "") + "\n\n|L|Headline|Time|\n") + (org-clock-sum ts te) (setq h (/ org-clock-file-total-minutes 60) m (- org-clock-file-total-minutes (* 60 h))) (insert-before-markers "|-\n|0|" "*Total file time*| " @@ -6475,7 +6581,7 @@ the buffer and restores the previous window configuration." (if (stringp org-agenda-files) (let ((cw (current-window-configuration))) (find-file org-agenda-files) - (set (make-local-variable 'org-window-configuration) cw) + (org-set-local 'org-window-configuration cw) (org-add-hook 'after-save-hook (lambda () (set-window-configuration @@ -6603,7 +6709,7 @@ dates." (setq buffer-read-only nil) (erase-buffer) (org-agenda-mode) (setq buffer-read-only nil) - (set (make-local-variable 'org-agenda-type) 'timeline) + (org-set-local 'org-agenda-type 'timeline) (if doclosed (push :closed args)) (push :timestamp args) (if dotodo (push :todo args)) @@ -6701,9 +6807,9 @@ NDAYS defaults to `org-agenda-ndays'." (setq buffer-read-only nil) (erase-buffer) (org-agenda-mode) (setq buffer-read-only nil) - (set (make-local-variable 'org-agenda-type) 'agenda) - (set (make-local-variable 'starting-day) (car day-numbers)) - (set (make-local-variable 'include-all-loc) include-all) + (org-set-local 'org-agenda-type 'agenda) + (org-set-local 'starting-day (car day-numbers)) + (org-set-local 'include-all-loc include-all) (when (and (or include-all org-agenda-include-all-todo) (member today day-numbers)) (setq files thefiles @@ -6812,11 +6918,11 @@ for a keyword. A numeric prefix directly selects the Nth keyword in (setq buffer-read-only nil) (erase-buffer) (org-agenda-mode) (setq buffer-read-only nil) - (set (make-local-variable 'org-agenda-type) 'todo) - (set (make-local-variable 'last-arg) arg) - (set (make-local-variable 'org-todo-keywords) kwds) - (set (make-local-variable 'org-agenda-redo-command) - '(org-todo-list (or current-prefix-arg last-arg) t)) + (org-set-local 'org-agenda-type 'todo) + (org-set-local 'last-arg arg) + (org-set-local 'org-todo-keywords kwds) + (org-set-local 'org-agenda-redo-command + '(org-todo-list (or current-prefix-arg last-arg) t)) (setq files (org-agenda-files) rtnall nil) (org-prepare-agenda-buffers files) @@ -7704,11 +7810,12 @@ the documentation of `org-diary'." (abbreviate-file-name buffer-file-name)))) (regexp org-tr-regexp) (d0 (calendar-absolute-from-gregorian date)) - marker hdmarker ee txt d1 d2 s1 s2 timestr category tags) + marker hdmarker ee txt d1 d2 s1 s2 timestr category tags pos) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip (org-agenda-skip) + (setq pos (point)) (setq timestr (match-string 0) s1 (match-string 1) s2 (match-string 2) @@ -7736,7 +7843,8 @@ the documentation of `org-diary'." 'org-marker marker 'org-hd-marker hdmarker 'priority (org-get-priority txt) 'category category) (push txt ee))) - (outline-next-heading))) + (goto-char pos))) +; (outline-next-heading))) ;FIXME: correct to be removed?????? ;; Sort the entries by expiration date. (nreverse ee))) @@ -7757,7 +7865,7 @@ groups carry important information: (defconst org-stamp-time-of-day-regexp (concat - "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} +[a-zA-Z]+ +\\)" + "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} +\\sw+ +\\)" "\\([012][0-9]:[0-5][0-9]\\)>" "\\(--?" "<\\1\\([012][0-9]:[0-5][0-9]\\)>\\)?") @@ -8620,10 +8728,10 @@ The prefix arg TODO-ONLY limits the search to TODO entries." (setq buffer-read-only nil) (erase-buffer) (org-agenda-mode) (setq buffer-read-only nil) - (set (make-local-variable 'org-agenda-type) 'tags) - (set (make-local-variable 'org-agenda-redo-command) - (list 'org-tags-view (list 'quote todo-only) - (list 'if 'current-prefix-arg nil match) t)) + (org-set-local 'org-agenda-type 'tags) + (org-set-local 'org-agenda-redo-command + (list 'org-tags-view (list 'quote todo-only) + (list 'if 'current-prefix-arg nil match) t)) (setq files (org-agenda-files) rtnall nil) (org-prepare-agenda-buffers files) @@ -9359,6 +9467,7 @@ onto the ring." "Follow a Gnus link to GROUP and ARTICLE." (require 'gnus) (funcall (cdr (assq 'gnus org-link-frame-setup))) + (if gnus-other-frame-object (select-frame gnus-other-frame-object)) (if group (gnus-fetch-group group)) (if article (or (gnus-summary-goto-article article nil 'force) @@ -10234,13 +10343,13 @@ to be run from that hook to fucntion properly." (org-startup-with-deadline-check nil)) (org-mode)) (if (and file (string-match "\\S-" file) (not (file-directory-p file))) - (set (make-local-variable 'org-default-notes-file) file)) + (org-set-local 'org-default-notes-file file)) (goto-char (point-min)) (if (re-search-forward "%\\?" nil t) (replace-match ""))) (let ((org-startup-folded nil) (org-startup-with-deadline-check nil)) (org-mode))) - (set (make-local-variable 'org-finish-function) 'remember-buffer)) + (org-set-local 'org-finish-function 'remember-buffer)) ;;;###autoload (defun org-remember-handler () @@ -11492,10 +11601,10 @@ it can be edited in place." '(invisible t org-cwidth t display t intangible t)) (goto-char p) - (set (make-local-variable 'org-finish-function) - 'org-table-finish-edit-field) - (set (make-local-variable 'org-window-configuration) cw) - (set (make-local-variable 'org-field-marker) pos) + (org-set-local 'org-finish-function + 'org-table-finish-edit-field) + (org-set-local 'org-window-configuration cw) + (org-set-local 'org-field-marker pos) (message "Edit and finish with C-c C-c")))) (defun org-table-finish-edit-field () @@ -12098,10 +12207,11 @@ not overwrite the stored one." (setq formula (car tmp) fmt (concat (cdr (assoc "%" org-table-local-parameters)) (nth 1 tmp))) - (while (string-match "[pnfse]\\(-?[0-9]+\\)" fmt) + (while (string-match "\\([pnfse]\\)\\(-?[0-9]+\\)" fmt) (setq c (string-to-char (match-string 1 fmt)) - n (string-to-number (or (match-string 1 fmt) ""))) - (if (= c ?p) (setq modes (org-set-calc-mode 'calc-internal-prec n)) + n (string-to-number (match-string 2 fmt))) + (if (= c ?p) + (setq modes (org-set-calc-mode 'calc-internal-prec n)) (setq modes (org-set-calc-mode 'calc-float-format (list (cdr (assoc c '((?n . float) (?f . fix) @@ -12314,8 +12424,8 @@ Parameters get priority." (switch-to-buffer-other-window "*Edit Formulas*") (erase-buffer) (fundamental-mode) - (set (make-local-variable 'org-pos) pos) - (set (make-local-variable 'org-window-configuration) wc) + (org-set-local 'org-pos pos) + (org-set-local 'org-window-configuration wc) (use-local-map org-edit-formulas-map) (setq s "# Edit formulas and finish with `C-c C-c'. # Use `C-u C-c C-c' to also appy them immediately to the entire table. @@ -12481,15 +12591,15 @@ table editor in arbitrary modes.") (let ((c (assq 'orgtbl-mode minor-mode-map-alist))) (and c (setq minor-mode-map-alist (cons c (delq c minor-mode-map-alist))))) - (set (make-local-variable (quote org-table-may-need-update)) t) + (org-set-local (quote org-table-may-need-update) t) (org-add-hook 'before-change-functions 'org-before-change-function nil 'local) - (set (make-local-variable 'org-old-auto-fill-inhibit-regexp) - auto-fill-inhibit-regexp) - (set (make-local-variable 'auto-fill-inhibit-regexp) - (if auto-fill-inhibit-regexp - (concat "\\([ \t]*|\\|" auto-fill-inhibit-regexp) - "[ \t]*|")) + (org-set-local 'org-old-auto-fill-inhibit-regexp + auto-fill-inhibit-regexp) + (org-set-local 'auto-fill-inhibit-regexp + (if auto-fill-inhibit-regexp + (concat "\\([ \t]*|\\|" auto-fill-inhibit-regexp) + "[ \t]*|")) (org-add-to-invisibility-spec '(org-cwidth)) (easy-menu-add orgtbl-mode-menu) (run-hooks 'orgtbl-mode-hook)) @@ -13388,7 +13498,7 @@ underlined headlines. The default is 3." (set (make-local-variable (cdr x)) (plist-get opt-plist (car x)))) org-export-plist-vars) - (set (make-local-variable 'org-odd-levels-only) odd) + (org-set-local 'org-odd-levels-only odd) (setq umax (if arg (prefix-numeric-value arg) org-export-headline-levels)) @@ -13594,22 +13704,15 @@ command." (goto-char (point-min))))) (defun org-find-visible () - (if (featurep 'noutline) - (let ((s (point))) - (while (and (not (= (point-max) (setq s (next-overlay-change s)))) - (get-char-property s 'invisible))) - s) - (skip-chars-forward "^\n") - (point))) + (let ((s (point))) + (while (and (not (= (point-max) (setq s (next-overlay-change s)))) + (get-char-property s 'invisible))) + s)) (defun org-find-invisible () - (if (featurep 'noutline) - (let ((s (point))) - (while (and (not (= (point-max) (setq s (next-overlay-change s)))) - (not (get-char-property s 'invisible)))) - s) - (skip-chars-forward "^\r") - (point))) - + (let ((s (point))) + (while (and (not (= (point-max) (setq s (next-overlay-change s)))) + (not (get-char-property s 'invisible)))) + s)) ;; HTML @@ -13859,14 +13962,16 @@ lang=\"%s\" xml:lang=\"%s\"> (insert (or (plist-get opt-plist :preamble) "")) (when (plist-get opt-plist :auto-preamble) - (if title (insert (concat "<h1 class=\"title\">" - (org-html-expand title) "</h1>\n"))) - + (if title (insert (format org-export-html-title-format + (org-html-expand title)))) (if text (insert "<p>\n" (org-html-expand text) "</p>"))) (if org-export-with-toc (progn - (insert (format "<h2>%s</h2>\n" (nth 3 lang-words))) + (insert (format "<h%d>%s</h%d>\n" + org-export-html-toplevel-hlevel + (nth 3 lang-words) + org-export-html-toplevel-hlevel)) (insert "<ul>\n<li>") (setq lines (mapcar '(lambda (line) @@ -14553,7 +14658,7 @@ When TITLE is nil, just close all open levels." (insert "<ul>\n<li>" title "<br/>\n"))) (if org-export-with-section-numbers (setq title (concat (org-section-number level) " " title))) - (setq level (+ level 1)) + (setq level (+ level org-export-html-toplevel-hlevel -1)) (if with-toc (insert (format "\n<h%d><a name=\"sec-%d\">%s</a></h%d>\n" level head-count title level)) @@ -15763,6 +15868,10 @@ See the individual commands for more information." "--" ("TODO Lists" ["TODO/DONE/-" org-todo t] + ("Select keyword" + ["Next keyword" org-shiftright (org-on-heading-p)] + ["Previous keyword" org-shiftleft (org-on-heading-p)] + ["Complete Keyword" org-complete (assq :todo-keyword (org-context))]) ["Show TODO Tree" org-show-todo-tree t] ["Global TODO list" org-todo-list t] "--" @@ -16042,31 +16151,32 @@ return nil." ;; In the paragraph separator we include headlines, because filling ;; text in a line directly attached to a headline would otherwise ;; fill the headline as well. - (set (make-local-variable 'comment-start-skip) "^#+[ \t]*") - (set (make-local-variable 'paragraph-separate) "\f\\|\\*\\|[ ]*$\\|[ \t]*[:|]") + (org-set-local 'comment-start-skip "^#+[ \t]*") + (org-set-local 'paragraph-separate "\f\\|\\*\\|[ ]*$\\|[ \t]*[:|]") ;; The paragraph starter includes hand-formatted lists. - (set (make-local-variable 'paragraph-start) - "\f\\|[ ]*$\\|\\([*\f]+\\)\\|[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)\\|[ \t]*[:|]") + (org-set-local 'paragraph-start + "\f\\|[ ]*$\\|\\([*\f]+\\)\\|[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)\\|[ \t]*[:|]") ;; Inhibit auto-fill for headers, tables and fixed-width lines. ;; But only if the user has not turned off tables or fixed-width regions - (set (make-local-variable 'auto-fill-inhibit-regexp) - (concat "\\*\\|#" - "\\|[ \t]*" org-keyword-time-regexp - (if (or org-enable-table-editor org-enable-fixed-width-editor) - (concat - "\\|[ \t]*[" - (if org-enable-table-editor "|" "") - (if org-enable-fixed-width-editor ":" "") - "]")))) + (org-set-local + 'auto-fill-inhibit-regexp + (concat "\\*\\|#" + "\\|[ \t]*" org-keyword-time-regexp + (if (or org-enable-table-editor org-enable-fixed-width-editor) + (concat + "\\|[ \t]*[" + (if org-enable-table-editor "|" "") + (if org-enable-fixed-width-editor ":" "") + "]")))) ;; We use our own fill-paragraph function, to make sure that tables ;; and fixed-width regions are not wrapped. That function will pass ;; through to `fill-paragraph' when appropriate. - (set (make-local-variable 'fill-paragraph-function) 'org-fill-paragraph) - ;; Adaptive filling: To get full control, first make sure that + (org-set-local 'fill-paragraph-function 'org-fill-paragraph) + ; Adaptive filling: To get full control, first make sure that ;; `adaptive-fill-regexp' never matches. Then install our own matcher. - (set (make-local-variable 'adaptive-fill-regexp) "\000") - (set (make-local-variable 'adaptive-fill-function) - 'org-adaptive-fill-function)) + (org-set-local 'adaptive-fill-regexp "\000") + (org-set-local 'adaptive-fill-function + 'org-adaptive-fill-function)) (defun org-fill-paragraph (&optional justify) "Re-align a table, pass through to fill-paragraph if no table." @@ -16145,18 +16255,7 @@ that can be added." t) "\\'")))) -;; Functions needed for compatibility with old outline.el. - -;; Programming for the old outline.el (that uses selective display -;; instead of `invisible' text properties) is a nightmare, mostly -;; because regular expressions can no longer be anchored at -;; beginning/end of line. Therefore a number of function need special -;; treatment when the old outline.el is being used. - -;; The following functions capture almost the entire compatibility code -;; between the different versions of outline-mode. The only other -;; places where this is important are the font-lock-keywords, and in -;; `org-export-visible'. Search for `org-noutline-p' to find them. +;; Functions extending outline functionality ;; C-a should go to the beginning of a *visible* line, also in the ;; new outline.el. I guess this should be patched into Emacs? @@ -16174,60 +16273,26 @@ to a visible line beginning. This makes the function of C-a more intuitive." (beginning-of-line 1)) (forward-char 1)))) -(when org-noutline-p - (define-key org-mode-map "\C-a" 'org-beginning-of-line)) +(define-key org-mode-map "\C-a" 'org-beginning-of-line) (defun org-invisible-p () "Check if point is at a character currently not visible." - (if org-noutline-p - ;; Early versions of noutline don't have `outline-invisible-p'. - (if (fboundp 'outline-invisible-p) - (outline-invisible-p) - (get-char-property (point) 'invisible)) - (save-excursion - (skip-chars-backward "^\r\n") - (equal (char-before) ?\r)))) + ;; Early versions of noutline don't have `outline-invisible-p'. + (if (fboundp 'outline-invisible-p) + (outline-invisible-p) + (get-char-property (point) 'invisible))) (defun org-invisible-p2 () "Check if point is at a character currently not visible." (save-excursion - (if org-noutline-p - (progn - (if (and (eolp) (not (bobp))) (backward-char 1)) - ;; Early versions of noutline don't have `outline-invisible-p'. - (if (fboundp 'outline-invisible-p) - (outline-invisible-p) - (get-char-property (point) 'invisible))) - (skip-chars-backward "^\r\n") - (equal (char-before) ?\r)))) - -(defun org-back-to-heading (&optional invisible-ok) - "Move to previous heading line, or beg of this line if it's a heading. -Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." - (if org-noutline-p - (outline-back-to-heading invisible-ok) - (if (and (or (bobp) (memq (char-before) '(?\n ?\r))) - (looking-at outline-regexp)) - t - (if (re-search-backward (concat (if invisible-ok "\\([\r\n]\\|^\\)" "^") - outline-regexp) - nil t) - (if invisible-ok - (progn (goto-char (or (match-end 1) (match-beginning 0))) - (looking-at outline-regexp))) - (error "Before first heading"))))) - -(defun org-on-heading-p (&optional invisible-ok) - "Return t if point is on a (visible) heading line. -If INVISIBLE-OK is non-nil, an invisible heading line is ok too." - (if org-noutline-p - (outline-on-heading-p 'invisible-ok) - (save-excursion - (skip-chars-backward "^\n\r") - (and (looking-at outline-regexp) - (or invisible-ok - (bobp) - (equal (char-before) ?\n)))))) + (if (and (eolp) (not (bobp))) (backward-char 1)) + ;; Early versions of noutline don't have `outline-invisible-p'. + (if (fboundp 'outline-invisible-p) + (outline-invisible-p) + (get-char-property (point) 'invisible)))) + +(defalias 'org-back-to-heading 'outline-back-to-heading) +(defalias 'org-on-heading-p 'outline-on-heading-p) (defun org-on-target-p () (let ((pos (point))) @@ -16243,47 +16308,20 @@ If INVISIBLE-OK is non-nil, an invisible heading line is ok too." "Move to the heading line of which the present line is a subheading. This function considers both visible and invisible heading lines. With argument, move up ARG levels." - (if org-noutline-p - (if (fboundp 'outline-up-heading-all) - (outline-up-heading-all arg) ; emacs 21 version of outline.el - (outline-up-heading arg t)) ; emacs 22 version of outline.el - (org-back-to-heading t) - (looking-at outline-regexp) - (if (<= (- (match-end 0) (match-beginning 0)) arg) - (error "Cannot move up %d levels" arg) - (re-search-backward - (concat "[\n\r]" (regexp-quote - (make-string (- (match-end 0) (match-beginning 0) arg) - ?*)) - "[^*]")) - (forward-char 1)))) + (if (fboundp 'outline-up-heading-all) + (outline-up-heading-all arg) ; emacs 21 version of outline.el + (outline-up-heading arg t))) ; emacs 22 version of outline.el (defun org-show-hidden-entry () "Show an entry where even the heading is hidden." (save-excursion - (if (not org-noutline-p) - (progn - (org-back-to-heading t) - (org-flag-heading nil))) (org-show-entry))) -(defun org-check-occur-regexp (regexp) - "If REGEXP starts with \"^\", modify it to check for \\r as well. -Of course, only for the old outline mode." - (if org-noutline-p - regexp - (if (string-match "^\\^" regexp) - (concat "[\n\r]" (substring regexp 1)) - regexp))) - (defun org-flag-heading (flag &optional entry) "Flag the current heading. FLAG non-nil means make invisible. When ENTRY is non-nil, show the entire entry." (save-excursion (org-back-to-heading t) - (if (not org-noutline-p) - ;; Make the current headline visible - (outline-flag-region (max 1 (1- (point))) (point) (if flag ?\r ?\n))) ;; Check if we should show the entire entry (if entry (progn @@ -16293,9 +16331,7 @@ When ENTRY is non-nil, show the entire entry." (org-flag-heading nil)))) (outline-flag-region (max 1 (1- (point))) (save-excursion (outline-end-of-heading) (point)) - (if org-noutline-p - flag - (if flag ?\r ?\n)))))) + flag)))) (defun org-end-of-subtree (&optional invisible-OK) ;; This is an exact copy of the original function, but it uses @@ -16324,7 +16360,7 @@ When ENTRY is non-nil, show the entire entry." (point) (save-excursion (outline-end-of-subtree) (outline-next-heading) (point)) - (if org-noutline-p nil ?\n))) + nil)) (defun org-show-entry () "Show the body directly following this heading. @@ -16337,16 +16373,16 @@ Show the heading too, if it is currently invisible." (save-excursion (re-search-forward (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move) (or (match-beginning 1) (point-max))) - (if org-noutline-p nil ?\n)))) + nil))) (defun org-make-options-regexp (kwds) "Make a regular expression for keyword lines." (concat - (if org-noutline-p "^" "[\n\r]") + "^" "#?[ \t]*\\+\\(" (mapconcat 'regexp-quote kwds "\\|") "\\):[ \t]*" - (if org-noutline-p "\\(.+\\)" "\\([^\n\r]+\\)"))) + "\\(.+\\)")) ;; Make `bookmark-jump' show the jump location if it was hidden. (eval-after-load "bookmark" diff --git a/lisp/tumme.el b/lisp/tumme.el index 3bd1d41886..788a29958a 100644 --- a/lisp/tumme.el +++ b/lisp/tumme.el @@ -172,12 +172,12 @@ :group 'multimedia) (defcustom tumme-dir "~/.emacs.d/tumme/" - "*Directory where thumbnail images are stored." + "Directory where thumbnail images are stored." :type 'string :group 'tumme) (defcustom tumme-thumbnail-storage 'use-tumme-dir - "*How to store tumme's thumbnail files. + "How to store tumme's thumbnail files. Tumme can store thumbnail files in one of two ways and this is controlled by this variable. \"Use tumme dir\" means that the thumbnails are stored in a central directory. \"Per directory\" @@ -193,17 +193,17 @@ that allows sharing of thumbnails across different programs." :group 'tumme) (defcustom tumme-db-file "~/.emacs.d/tumme/.tumme_db" - "*Database file where file names and their associated tags are stored." + "Database file where file names and their associated tags are stored." :type 'string :group 'tumme) (defcustom tumme-temp-image-file "~/.emacs.d/tumme/.tumme_temp" - "*Name of temporary image file used by various commands." + "Name of temporary image file used by various commands." :type 'string :group 'tumme) (defcustom tumme-gallery-dir "~/.emacs.d/tumme/.tumme_gallery" - "*Directory to store generated gallery html pages. + "Directory to store generated gallery html pages. This path needs to be \"shared\" to the public so that it can access the index.html page that tumme creates." :type 'string @@ -211,7 +211,7 @@ the index.html page that tumme creates." (defcustom tumme-gallery-image-root-url "http://your.own.server/tummepics" - "*URL where the full size images are to be found. + "URL where the full size images are to be found. Note that this path has to be configured in your web server. Tumme expects to find pictures in this directory." :type 'string @@ -219,7 +219,7 @@ expects to find pictures in this directory." (defcustom tumme-gallery-thumb-image-root-url "http://your.own.server/tummethumbs" - "*URL where the thumbnail images are to be found. + "URL where the thumbnail images are to be found. Note that this path has to be configured in your web server. Tumme expects to find pictures in this directory." :type 'string @@ -227,14 +227,14 @@ expects to find pictures in this directory." (defcustom tumme-cmd-create-thumbnail-program "convert" - "*Executable used to create thumbnail. + "Executable used to create thumbnail. Used together with `tumme-cmd-create-thumbnail-options'." :type 'string :group 'tumme) (defcustom tumme-cmd-create-thumbnail-options "%p -size %wx%h \"%f\" -resize %wx%h +profile \"*\" jpeg:\"%t\"" - "*Format of command used to create thumbnail image. + "Format of command used to create thumbnail image. Available options are %p which is replaced by `tumme-cmd-create-thumbnail-program', %w which is replaced by `tumme-thumb-width', %h which is replaced by `tumme-thumb-height', @@ -245,14 +245,14 @@ which is replaced by the file name of the thumbnail file." (defcustom tumme-cmd-create-temp-image-program "convert" - "*Executable used to create temporary image. + "Executable used to create temporary image. Used together with `tumme-cmd-create-temp-image-options'." :type 'string :group 'tumme) (defcustom tumme-cmd-create-temp-image-options "%p -size %wx%h \"%f\" -resize %wx%h +profile \"*\" jpeg:\"%t\"" - "*Format of command used to create temporary image for display window. + "Format of command used to create temporary image for display window. Available options are %p which is replaced by `tumme-cmd-create-temp-image-program', %w and %h which is replaced by the calculated max size for width and height in the image display window, @@ -262,13 +262,13 @@ is replaced by the file name of the temporary file." :group 'tumme) (defcustom tumme-cmd-pngnq-program (executable-find "pngnq") - "*The file name of the `pngnq' program. + "The file name of the `pngnq' program. It quantizes colors of PNG images down to 256 colors." :type '(choice (const :tag "Not Set" nil) string) :group 'tumme) (defcustom tumme-cmd-pngcrush-program (executable-find "pngcrush") - "*The file name of the `pngcrush' program. + "The file name of the `pngcrush' program. It optimizes the compression of PNG images. Also it adds PNG textual chunks with the information required by the Thumbnail Managing Standard." :type '(choice (const :tag "Not Set" nil) string) @@ -305,20 +305,20 @@ with the information required by the Thumbnail Managing Standard." "-text b \"Thumb::URI\" \"file://%f\" " "%q %t" " ; rm %q"))) - "*Command to create thumbnails according to the Thumbnail Managing Standard." + "Command to create thumbnails according to the Thumbnail Managing Standard." :type 'string :group 'tumme) (defcustom tumme-cmd-rotate-thumbnail-program "mogrify" - "*Executable used to rotate thumbnail. + "Executable used to rotate thumbnail. Used together with `tumme-cmd-rotate-thumbnail-options'." :type 'string :group 'tumme) (defcustom tumme-cmd-rotate-thumbnail-options "%p -rotate %d \"%t\"" - "*Format of command used to rotate thumbnail image. + "Format of command used to rotate thumbnail image. Available options are %p which is replaced by `tumme-cmd-rotate-thumbnail-program', %d which is replaced by the number of (positive) degrees to rotate the image, normally 90 or 270 @@ -329,14 +329,14 @@ of the thumbnail file." (defcustom tumme-cmd-rotate-original-program "jpegtran" - "*Executable used to rotate original image. + "Executable used to rotate original image. Used together with `tumme-cmd-rotate-original-options'." :type 'string :group 'tumme) (defcustom tumme-cmd-rotate-original-options "%p -rotate %d -copy all \"%o\" > %t" - "*Format of command used to rotate original image. + "Format of command used to rotate original image. Available options are %p which is replaced by `tumme-cmd-rotate-original-program', %d which is replaced by the number of (positive) degrees to rotate the image, normally 90 or @@ -348,7 +348,7 @@ original image file name and %t which is replaced by (defcustom tumme-temp-rotate-image-file "~/.emacs.d/tumme/.tumme_rotate_temp" - "*Temporary file for rotate operations." + "Temporary file for rotate operations." :type 'string :group 'tumme) @@ -361,14 +361,14 @@ original file with `tumme-temp-rotate-image-file'." (defcustom tumme-cmd-write-exif-data-program "exiftool" - "*Program used to write EXIF data to image. + "Program used to write EXIF data to image. Used together with `tumme-cmd-write-exif-data-options'." :type 'string :group 'tumme) (defcustom tumme-cmd-write-exif-data-options "%p -%t=\"%v\" \"%f\"" - "*Format of command used to write EXIF data. + "Format of command used to write EXIF data. Available options are %p which is replaced by `tumme-cmd-write-exif-data-program', %f which is replaced by the image file name, %t which is replaced by the tag name and %v @@ -378,14 +378,14 @@ which is replaced by the tag value." (defcustom tumme-cmd-read-exif-data-program "exiftool" - "*Program used to read EXIF data to image. + "Program used to read EXIF data to image. Used together with `tumme-cmd-read-exif-data-program-options'." :type 'string :group 'tumme) (defcustom tumme-cmd-read-exif-data-options "%p -s -s -s -%t \"%f\"" - "*Format of command used to read EXIF data. + "Format of command used to read EXIF data. Available options are %p which is replaced by `tumme-cmd-write-exif-data-options', %f which is replaced by the image file name and %t which is replaced by the tag name." @@ -394,7 +394,7 @@ by the image file name and %t which is replaced by the tag name." (defcustom tumme-gallery-hidden-tags (list "private" "hidden" "pending") - "*List of \"hidden\" tags. + "List of \"hidden\" tags. Used by `tumme-gallery-generate' to leave out \"hidden\" images." :type '(repeat string) :group 'tumme) @@ -416,18 +416,18 @@ This is the default size for both `tumme-thumb-width' and `tumme-thumb-height'." :group 'tumme) (defcustom tumme-thumb-relief 2 - "*Size of button-like border around thumbnails." + "Size of button-like border around thumbnails." :type 'integer :group 'tumme) (defcustom tumme-thumb-margin 2 - "*Size of the margin around thumbnails. + "Size of the margin around thumbnails. This is where you see the cursor." :type 'integer :group 'tumme) (defcustom tumme-line-up-method 'dynamic - "*Default method for line-up of thumbnails in thumbnail buffer. + "Default method for line-up of thumbnails in thumbnail buffer. Used by `tumme-display-thumbs' and other functions that needs to line-up thumbnails. Dynamic means to use the available width of the window containing the thumbnail buffer, Fixed means to use @@ -441,19 +441,19 @@ line-up means that no automatic line-up will be done." :group 'tumme) (defcustom tumme-thumbs-per-row 3 - "*Number of thumbnails to display per row in thumb buffer." + "Number of thumbnails to display per row in thumb buffer." :type 'integer :group 'tumme) (defcustom tumme-display-window-width-correction 1 - "*Number to be used to correct image display window width. + "Number to be used to correct image display window width. Change if the default (1) does not work (i.e. if the image does not completely fit)." :type 'integer :group 'tumme) (defcustom tumme-display-window-height-correction 0 - "*Number to be used to correct image display window height. + "Number to be used to correct image display window height. Change if the default (0) does not work (i.e. if the image does not completely fit)." :type 'integer @@ -487,7 +487,7 @@ dired and you might want to turn it off." :group 'tumme) (defcustom tumme-display-properties-format "%b: %f (%t): %c" - "*Display format for thumbnail properties. + "Display format for thumbnail properties. %b is replaced with associated dired buffer name, %f with file name \(without path) of original image file, %t with the list of tags and %c with the comment." @@ -500,20 +500,20 @@ with the comment." (cond ((executable-find "display")) ((executable-find "xli")) ((executable-find "qiv") "qiv -t")) - "*Name of external viewer. + "Name of external viewer. Including parameters. Used when displaying original image from `tumme-thumbnail-mode'." :type 'string :group 'tumme) (defcustom tumme-main-image-directory "~/pics/" - "*Name of main image directory, if any. + "Name of main image directory, if any. Used by `tumme-copy-with-exif-file-name'." :type 'string :group 'tumme) (defcustom tumme-show-all-from-dir-max-files 50 - "*Maximum number of files to show using `tumme-show-all-from-dir'. + "Maximum number of files to show using `tumme-show-all-from-dir'. before warning the user." :type 'integer :group 'tumme) diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index 901fac0120..e4b54f9fc9 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,20 @@ +2006-08-25 Stefan Monnier <[email protected]> + + * url-handlers.el (url-file-local-copy): Tell url-copy-file that the + dest file will already exist. + +2006-07-31 Stefan Monnier <[email protected]> + + * url-util.el (url-hexify-string): Only utf-8 encode if it's + a multibyte string. + (url-normalize-url): Remove unused var `grok'. + (url-truncate-url-for-viewing): Remove unused var `tail'. + +2006-07-30 Thien-Thi Nguyen <[email protected]> + + * url-util.el (url-hexify-string): Rewrite. + Suggested by David Smith <[email protected]>. + 2006-07-12 Michael Olson <[email protected]> * url-irc.el (url-irc-erc): Call erc-handle-irc-url. diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index 6c6d85a1e0..97d1000362 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -213,7 +213,7 @@ A prefix arg makes KEEP-TIME non-nil." Returns the name of the local copy, or nil, if FILE is directly accessible." (let ((filename (make-temp-file "url"))) - (url-copy-file url filename) + (url-copy-file url filename 'ok-if-already-exists) filename)) (defun url-insert (buffer &optional beg end) diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el index f33a58950f..0aeb141c01 100644 --- a/lisp/url/url-util.el +++ b/lisp/url/url-util.el @@ -163,7 +163,7 @@ Also replaces the \" character, so that the result may be safely used as (defun url-normalize-url (url) "Return a 'normalized' version of URL. Strips out default port numbers, etc." - (let (type data grok retval) + (let (type data retval) (setq data (url-generic-parse-url url) type (url-type data)) (if (member type '("www" "about" "mailto" "info")) @@ -352,17 +352,31 @@ forbidden in URL encoding." This is taken from RFC 2396.") ;;;###autoload -(defun url-hexify-string (str) - "Escape characters in a string." - (mapconcat - (lambda (char) - ;; Fixme: use a char table instead. - (if (not (memq char url-unreserved-chars)) - (if (> char 255) - (error "Hexifying multibyte character %s" str) - (format "%%%02X" char)) - (char-to-string char))) - str "")) +(defun url-hexify-string (string) + "Return a new string that is STRING URI-encoded. +First, STRING is converted to utf-8, if necessary. Then, for each +character in the utf-8 string, those found in `url-unreserved-chars' +are left as-is, all others are represented as a three-character +string: \"%\" followed by two lowercase hex digits." + ;; To go faster and avoid a lot of consing, we could do: + ;; + ;; (defconst url-hexify-table + ;; (let ((map (make-vector 256 nil))) + ;; (dotimes (byte 256) (aset map byte + ;; (if (memq byte url-unreserved-chars) + ;; (char-to-string byte) + ;; (format "%%%02x" byte)))) + ;; map)) + ;; + ;; (mapconcat (curry 'aref url-hexify-table) ...) + (mapconcat (lambda (byte) + (if (memq byte url-unreserved-chars) + (char-to-string byte) + (format "%%%02x" byte))) + (if (multibyte-string-p string) + (encode-coding-string string 'utf-8) + string) + "")) ;;;###autoload (defun url-file-extension (fname &optional x) @@ -389,7 +403,6 @@ then return the basename of the file with the extension stripped off." WIDTH defaults to the current frame width." (let* ((fr-width (or width (frame-width))) (str-width (length url)) - (tail (file-name-nondirectory url)) (fname nil) (modified 0) (urlobj nil)) @@ -397,8 +410,7 @@ WIDTH defaults to the current frame width." (if (and (>= str-width fr-width) (string-match "?" url)) (setq url (concat (substring url 0 (match-beginning 0)) "?...") - str-width (length url) - tail (file-name-nondirectory url))) + str-width (length url))) (if (< str-width fr-width) nil ; Hey, we are done! (setq urlobj (url-generic-parse-url url) diff --git a/lisp/wdired.el b/lisp/wdired.el index 1363181524..bc70e0ddcf 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -238,6 +238,8 @@ in disk. See `wdired-mode'." (interactive) + (or (eq major-mode 'dired-mode) + (error "Not a Dired buffer")) (set (make-local-variable 'wdired-old-content) (buffer-substring (point-min) (point-max))) (set (make-local-variable 'wdired-old-point) (point)) @@ -328,6 +330,8 @@ non-nil means return old filename." (defun wdired-change-to-dired-mode () "Change the mode back to dired." + (or (eq major-mode 'wdired-mode) + (error "Not a Wdired buffer")) (let ((inhibit-read-only t)) (remove-text-properties (point-min) (point-max) '(read-only nil local-map nil))) diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 449606607f..bb829278ef 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -518,13 +518,15 @@ and: ;;;###autoload (defun whitespace-cleanup () "Cleanup the five different kinds of whitespace problems. +It normally applies to the whole buffer, but in Transient Mark mode +when the mark is active it applies to the region. See `whitespace-buffer' docstring for a summary of the problems." (interactive) (if (and transient-mark-mode mark-active) (whitespace-cleanup-region (region-beginning) (region-end)) (whitespace-cleanup-internal))) -(defun whitespace-cleanup-internal () +(defun whitespace-cleanup-internal (&optional region-only) ;; If this buffer really contains a file, then run, else quit. (whitespace-check-whitespace-mode current-prefix-arg) (if (and buffer-file-name whitespace-mode) @@ -569,9 +571,12 @@ See `whitespace-buffer' docstring for a summary of the problems." ;; Call this recursively till everything is taken care of (if whitespace-any (whitespace-cleanup-internal) + ;; if we are done, talk to the user (progn - (if (not whitespace-silent) - (message "%s clean" buffer-file-name)) + (unless whitespace-silent + (if region-only + (message "The region is now clean") + (message "%s is now clean" buffer-file-name))) (whitespace-update-modeline))) (setq tab-width whitespace-tabwith-saved)))) @@ -582,7 +587,7 @@ See `whitespace-buffer' docstring for a summary of the problems." (save-excursion (save-restriction (narrow-to-region s e) - (whitespace-cleanup-internal)) + (whitespace-cleanup-internal t)) (whitespace-buffer t))) (defun whitespace-buffer-leading () diff --git a/lisp/window.el b/lisp/window.el index 2ae1a2c9e7..7810ba4c5b 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -246,9 +246,10 @@ then the smallest tree containing that window is returned." (windowp window-or-frame)) (error "Not a frame or window: %s" window-or-frame))) (let ((subtree (bw-find-tree-sub window-or-frame))) - (if (integerp subtree) - nil - (bw-get-tree-1 subtree)))) + (when subtree + (if (integerp subtree) + nil + (bw-get-tree-1 subtree))))) (defun bw-get-tree-1 (split) (if (windowp split) diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index 04ef4f0b6d..717fcf207d 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -122,6 +122,12 @@ any protocol specific data.") (defun x-dnd-init-frame (&optional frame) "Setup drag and drop for FRAME (i.e. create appropriate properties)." (when (eq 'x (window-system frame)) + (x-register-dnd-atom "DndProtocol" frame) + (x-register-dnd-atom "_MOTIF_DRAG_AND_DROP_MESSAGE" frame) + (x-register-dnd-atom "XdndEnter" frame) + (x-register-dnd-atom "XdndPosition" frame) + (x-register-dnd-atom "XdndLeave" frame) + (x-register-dnd-atom "XdndDrop" frame) (x-dnd-init-xdnd-for-frame frame) (x-dnd-init-motif-for-frame frame))) @@ -320,7 +326,8 @@ nil if not." ;; If dropping in an ordinary window which we could use, ;; let dnd-open-file-other-window specify what to do. (progn - (goto-char (posn-point (event-start event))) + (when (not mouse-yank-at-point) + (goto-char (posn-point (event-start event)))) (funcall handler window action data)) ;; If we can't display the file here, ;; make a new window for it. |