diff options
Diffstat (limited to 'lisp')
44 files changed, 1818 insertions, 974 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index dabcdb2f91..53f8448edf 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,294 @@ +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): Added 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): + Removed 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): Fixed 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): Revised + 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) @@ -173,9 +464,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]> @@ -239,8 +530,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]> @@ -279,7 +570,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]> @@ -315,7 +606,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'. @@ -639,8 +930,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 1accc5b266..dacde69fa0 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -280,52 +280,62 @@ 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-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-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'.") 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..3aa01424fb 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,19 @@ 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 () (compare-windows-skip-whitespace) + t) + compare-windows-whitespace))) + + (with-current-buffer b2 + (setq skip-func-2 (if ignore-whitespace + (if (stringp compare-windows-whitespace) + (lambda () (compare-windows-skip-whitespace) + t) + compare-windows-whitespace))) (push-mark p2 t) (setq maxp2 (point-max))) (push-mark) @@ -199,17 +208,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 c49ad48853..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)) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 0493dd0894..609b5572a0 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -4436,6 +4436,7 @@ The format is suitable for use with `easy-menu-define'." (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-newline) (define-key map " " 'scroll-up) (define-key map "\177" 'scroll-down) (define-key map "\C-c\C-c" 'Custom-set) @@ -4452,6 +4453,14 @@ The format is suitable for use with `easy-menu-define'." (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) + (error "You can't edit this part of the Custom buffer")))) + (easy-menu-define Custom-mode-menu custom-mode-map "Menu used in customization buffers." diff --git a/lisp/cus-start.el b/lisp/cus-start.el index e35a75da59..2fce89c73c 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -178,7 +178,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) 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/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/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/erc/ChangeLog b/lisp/erc/ChangeLog index 0129bd4397..72754aa1cd 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog @@ -1,3 +1,41 @@ +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. diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 705ca7a9e6..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)) diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el index 418e45060b..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 @@ -293,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.el b/lisp/erc/erc.el index 4317b831d5..41d5957625 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -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. @@ -2362,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 @@ -2374,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))))) @@ -5241,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'." @@ -5894,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))))) @@ -5946,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 4627b5ff59..f2d3e0ddb4 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2066,7 +2066,7 @@ created." ;; 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/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-lock.el b/lisp/font-lock.el index b05b7ecc2e..82f9be4cb4 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -976,7 +976,7 @@ The value of this variable is used when Font Lock mode is turned on." ;; 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 fontify after a change. + "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. @@ -985,7 +985,7 @@ 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 fontify, or nil +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.") @@ -1044,6 +1044,12 @@ 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 @@ -1167,6 +1173,13 @@ what properties to clear before refontifying a region.") (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 @@ -1177,6 +1190,16 @@ what properties to clear before refontifying a 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 @@ -1186,8 +1209,11 @@ what properties to clear before refontifying a region.") 'font-lock-multiline nil) (point-max))) ;; Finally, pre-enlarge the region to a whole number of lines, to try - ;; and predict what font-lock-default-fontify-region will do, so as to + ;; 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) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 750956b9f8..6ddd513610 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,27 @@ +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. 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/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 79732cd3d8..82e1d3ab55 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -598,7 +598,7 @@ the line could be found." (nth 1 (mm-insert-file-contents file nil beg (incf beg nnheader-head-chop-length)))) - ;; CRLF of CR might be used for the line-break code. + ;; 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) 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/info.el b/lisp/info.el index def9a12ab0..34509e72f2 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -3806,6 +3806,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 8b0a25dbae..d1cc961817 100644 --- a/lisp/international/mule-diag.el +++ b/lisp/international/mule-diag.el @@ -830,18 +830,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/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..358c834de7 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el @@ -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)))) 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 e6c6380bf8..b5334ba5bc 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 @@ -321,7 +322,7 @@ of the inferior. Non-nil means display the layout shown for :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)) @@ -1030,7 +1031,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 '(".*"))) @@ -1296,6 +1297,7 @@ not GDB." (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 @@ -1776,9 +1779,8 @@ static char *magick[] = { (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))) (add-text-properties @@ -1786,43 +1788,55 @@ static char *magick[] = { (if (eq flag ?y) '(face font-lock-warning-face) '(face font-lock-type-face))) - (beginning-of-line) - (if (re-search-forward " in \\(.*\\) at\\s-+" nil t) - (progn + (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-function-name-face)) - (looking-at "\\(\\S-+\\):\\([0-9]+\\)") - (let ((line (match-string 2)) - (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)))))))))) + '(face font-lock-variable-name-face))))))) (end-of-line)))))) (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom))) @@ -2026,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 ") @@ -2098,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) @@ -2549,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 @@ -2568,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 @@ -2635,13 +2657,13 @@ 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))) + (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.") @@ -2764,7 +2786,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)) @@ -2783,7 +2805,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)) @@ -2802,9 +2824,9 @@ corresponding to the mode line clicked." :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 @@ -2901,12 +2923,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) @@ -3128,8 +3151,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) 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/sh-script.el b/lisp/progmodes/sh-script.el index f748bb4b04..a08f999f08 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/simple.el b/lisp/simple.el index 204684a3d5..86b3af702e 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -3697,7 +3697,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)))) @@ -3767,7 +3770,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) @@ -3778,10 +3782,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/term/x-win.el b/lisp/term/x-win.el index 21515e0261..9229ec549e 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -2484,7 +2484,7 @@ order until succeed.") ;; Override Paste so it looks at CLIPBOARD first. (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)) @@ -2492,12 +2492,13 @@ order until succeed.") (yank))) (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")) ;; 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) ;; Let F10 do menu bar navigation. (and (fboundp 'menu-bar-open) diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index 7622f23752..9ea51a2f77 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -228,8 +228,37 @@ (define-key map "\e[4~" [select]) (define-key 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 map "\e[27;5;39~" [?\C-\']) + (define-key map "\e[27;5;45~" [?\C--]) + + (define-key map "\e[27;5;48~" [?\C-0]) + (define-key map "\e[27;5;49~" [?\C-1]) + ;; Not all C-DIGIT keys have a distinct binding. + (define-key map "\e[27;5;57~" [?\C-9]) + + (define-key map "\e[27;5;59~" [?\C-\;]) + (define-key map "\e[27;5;61~" [?\C-=]) + + + (define-key map "\e[27;6;33~" [?\C-!]) + (define-key map "\e[27;6;34~" [?\C-\"]) + (define-key map "\e[27;6;35~" [?\C-#]) + (define-key map "\e[27;6;36~" [?\C-$]) + (define-key map "\e[27;6;37~" [?\C-%]) + (define-key map "\e[27;6;38~" [(C-&)]) + (define-key map "\e[27;6;40~" [?\C-(]) + (define-key map "\e[27;6;41~" [?\C-)]) + (define-key map "\e[27;6;42~" [?\C-*]) + (define-key map "\e[27;6;43~" [?\C-+]) + + (define-key map "\e[27;6;58~" [?\C-:]) + (define-key map "\e[27;6;60~" [?\C-<]) + (define-key map "\e[27;6;62~" [?\C->]) + (define-key map "\e[27;6;63~" [(C-\?)]) + (define-key map "\e[27;5;9~" [C-tab]) (define-key map "\e[27;5;13~" [C-return]) (define-key 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..1fcac6855d 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) @@ -10234,13 +10342,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 +11600,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 +12206,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 +12423,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 +12590,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 +13497,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 +13703,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 +13961,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 +14657,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 +15867,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 +16150,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 +16254,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 +16272,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 +16307,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 +16330,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 +16359,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 +16372,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/x-dnd.el b/lisp/x-dnd.el index 693a2d7fa4..81fe9a8e86 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -121,6 +121,12 @@ any protocol specific data.") (defun x-dnd-init-frame (&optional frame) "Setup drag and drop for FRAME (i.e. create appropriate properties)." + (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)) |