Mercurial > emacs
comparison lisp/allout.el @ 87943:4fb8430d030b
(allout-keybindings-list): In initial setting, express
meta-prefixed allout keys as vectors instead of strings, since the
string form is interpreted in some cases as composed key
modifiers, eg, accented keys.
(allout-line-boundary-regexp): Clarify description.
(set-allout-regexp): Repair the expressions so that the formfeed part is
identified as one of the top-level groups, and is included in all the
forms, not just the -line-boundary-regexp one.
(allout-prefix-data): Incorporate information from the various allout
regexp's formfeed alternative group, when present.
(allout-write-file-hook-handler): Rectify mangling of the error handling.
It was broken in version 1.100, where an `error' condition-case handler was
apparently reformatted as if it was a call to the error function. An
apparent repair attempt in version 1.101 situated the original body of the
error handling code as bogus condition-case handlers. I've returned to
just about the working code that was originally there, removing an
unnecessary - but benign - enclosing 'progn'. \(Automated or cursory code
fixes often aren't.)
(allout-region-active-p): Fallback to value of mark-active if neither
use-region-p nor region-active-p are present, for compatability with
current and recent emacs major releases.
author | Ken Manheimer <ken.manheimer@gmail.com> |
---|---|
date | Thu, 24 Jan 2008 17:45:28 +0000 |
parents | 107ccd98fa12 |
children | 7dc2524306eb |
comparison
equal
deleted
inserted
replaced
87942:d497b71f87dc | 87943:4fb8430d030b |
---|---|
153 ("<" allout-shift-out) | 153 ("<" allout-shift-out) |
154 ("\C-m" allout-rebullet-topic) | 154 ("\C-m" allout-rebullet-topic) |
155 ("*" allout-rebullet-current-heading) | 155 ("*" allout-rebullet-current-heading) |
156 ("#" allout-number-siblings) | 156 ("#" allout-number-siblings) |
157 ("\C-k" allout-kill-line t) | 157 ("\C-k" allout-kill-line t) |
158 ("\M-k" allout-copy-line-as-kill t) | 158 ([?\M-k] allout-copy-line-as-kill t) |
159 ("\C-y" allout-yank t) | 159 ("\C-y" allout-yank t) |
160 ("\M-y" allout-yank-pop t) | 160 ([?\M-y] allout-yank-pop t) |
161 ("\C-k" allout-kill-topic) | 161 ("\C-k" allout-kill-topic) |
162 ("\M-k" allout-copy-topic-as-kill) | 162 ([?\M-k] allout-copy-topic-as-kill) |
163 ; Miscellaneous commands: | 163 ; Miscellaneous commands: |
164 ;([?\C-\ ] allout-mark-topic) | 164 ;([?\C-\ ] allout-mark-topic) |
165 ("@" allout-resolve-xref) | 165 ("@" allout-resolve-xref) |
166 ("=c" allout-copy-exposed-to-buffer) | 166 ("=c" allout-copy-exposed-to-buffer) |
167 ("=i" allout-indented-exposed-to-buffer) | 167 ("=i" allout-indented-exposed-to-buffer) |
884 decimal numbers, which should each be one less than the depth of the | 884 decimal numbers, which should each be one less than the depth of the |
885 topic prefix to be matched.") | 885 topic prefix to be matched.") |
886 (make-variable-buffer-local 'allout-depth-one-regexp) | 886 (make-variable-buffer-local 'allout-depth-one-regexp) |
887 ;;;_ = allout-line-boundary-regexp | 887 ;;;_ = allout-line-boundary-regexp |
888 (defvar allout-line-boundary-regexp () | 888 (defvar allout-line-boundary-regexp () |
889 "`allout-regexp' with outline style beginning-of-line anchor. | 889 "`allout-regexp' prepended with a newline for the search target. |
890 | 890 |
891 This is properly set by `set-allout-regexp'.") | 891 This is properly set by `set-allout-regexp'.") |
892 (make-variable-buffer-local 'allout-line-boundary-regexp) | 892 (make-variable-buffer-local 'allout-line-boundary-regexp) |
893 ;;;_ = allout-bob-regexp | 893 ;;;_ = allout-bob-regexp |
894 (defvar allout-bob-regexp () | 894 (defvar allout-bob-regexp () |
1056 ) | 1056 ) |
1057 ;; Derive next for repeated use in allout-pending-bullet: | 1057 ;; Derive next for repeated use in allout-pending-bullet: |
1058 (setq allout-plain-bullets-string-len (length allout-plain-bullets-string)) | 1058 (setq allout-plain-bullets-string-len (length allout-plain-bullets-string)) |
1059 (setq allout-header-subtraction (1- (length allout-header-prefix))) | 1059 (setq allout-header-subtraction (1- (length allout-header-prefix))) |
1060 | 1060 |
1061 (let (new-part old-part) | 1061 (let (new-part old-part formfeed-part) |
1062 (setq new-part (concat "\\(" | 1062 (setq new-part (concat "\\(" |
1063 (regexp-quote allout-header-prefix) | 1063 (regexp-quote allout-header-prefix) |
1064 "[ \t]*" | 1064 "[ \t]*" |
1065 ;; already regexp-quoted in a custom way: | 1065 ;; already regexp-quoted in a custom way: |
1066 "[" allout-bullets-string "]" | 1066 "[" allout-bullets-string "]" |
1070 "\\|" | 1070 "\\|" |
1071 (regexp-quote allout-header-prefix) | 1071 (regexp-quote allout-header-prefix) |
1072 "\\)" | 1072 "\\)" |
1073 "+" | 1073 "+" |
1074 " ?[^" allout-primary-bullet "]") | 1074 " ?[^" allout-primary-bullet "]") |
1075 formfeed-part "\\(\^L\\)" | |
1076 | |
1075 allout-regexp (concat new-part | 1077 allout-regexp (concat new-part |
1076 "\\|" | 1078 "\\|" |
1077 old-part | 1079 old-part |
1078 "\\|\^l") | 1080 "\\|" |
1081 formfeed-part) | |
1079 | 1082 |
1080 allout-line-boundary-regexp (concat "\n" new-part | 1083 allout-line-boundary-regexp (concat "\n" new-part |
1081 "\\|" | 1084 "\\|" |
1082 "\n" old-part) | 1085 "\n" old-part |
1086 "\\|" | |
1087 "\n" formfeed-part) | |
1083 | 1088 |
1084 allout-bob-regexp (concat "\\`" new-part | 1089 allout-bob-regexp (concat "\\`" new-part |
1085 "\\|" | 1090 "\\|" |
1086 "\\`" old-part)) | 1091 "\\`" old-part |
1092 "\\|" | |
1093 "\\`" formfeed-part | |
1094 )) | |
1087 | 1095 |
1088 (setq allout-depth-specific-regexp | 1096 (setq allout-depth-specific-regexp |
1089 (concat "\\(^\\|\\`\\)" | 1097 (concat "\\(^\\|\\`\\)" |
1090 "\\(" | 1098 "\\(" |
1091 | 1099 |
1499 (message "auto-encrypting pending topics") | 1507 (message "auto-encrypting pending topics") |
1500 (sit-for 0) | 1508 (sit-for 0) |
1501 (condition-case failure | 1509 (condition-case failure |
1502 (setq allout-after-save-decrypt | 1510 (setq allout-after-save-decrypt |
1503 (allout-encrypt-decrypted except-mark)) | 1511 (allout-encrypt-decrypted except-mark)) |
1504 (message "allout-write-file-hook-handler suppressing error %s" | 1512 (error (message |
1505 failure) | 1513 "allout-write-file-hook-handler suppressing error %s" |
1506 (sit-for 2) | 1514 failure) |
1507 (error "allout-write-file-hook-handler suppressing error %s" | 1515 (sit-for 2))))) |
1508 failure)))) | |
1509 )) | 1516 )) |
1510 nil) | 1517 nil) |
1511 ;;;_ > allout-auto-save-hook-handler () | 1518 ;;;_ > allout-auto-save-hook-handler () |
1512 (defun allout-auto-save-hook-handler () | 1519 (defun allout-auto-save-hook-handler () |
1513 "Implement `allout-encrypt-unencrypted-on-saves' policy for auto save." | 1520 "Implement `allout-encrypt-unencrypted-on-saves' policy for auto save." |
1514 | 1521 |
1515 (if (and (allout-mode-p) allout-encrypt-unencrypted-on-saves) | 1522 (if (and (allout-mode-p) allout-encrypt-unencrypted-on-saves) |
2251 ;;;_ > allout-prefix-data () | 2258 ;;;_ > allout-prefix-data () |
2252 (defsubst allout-prefix-data () | 2259 (defsubst allout-prefix-data () |
2253 "Register allout-prefix state data. | 2260 "Register allout-prefix state data. |
2254 | 2261 |
2255 For reference by `allout-recent' funcs. Returns BEGINNING." | 2262 For reference by `allout-recent' funcs. Returns BEGINNING." |
2256 (setq allout-recent-prefix-end (or (match-end 1) (match-end 2)) | 2263 (setq allout-recent-prefix-end (or (match-end 1) (match-end 2) (match-end 3)) |
2257 allout-recent-prefix-beginning (or (match-beginning 1) | 2264 allout-recent-prefix-beginning (or (match-beginning 1) |
2258 (match-beginning 2)) | 2265 (match-beginning 2) |
2266 (match-beginning 3)) | |
2259 allout-recent-depth (max 1 (- allout-recent-prefix-end | 2267 allout-recent-depth (max 1 (- allout-recent-prefix-end |
2260 allout-recent-prefix-beginning | 2268 allout-recent-prefix-beginning |
2261 allout-header-subtraction))) | 2269 allout-header-subtraction))) |
2262 allout-recent-prefix-beginning) | 2270 allout-recent-prefix-beginning) |
2263 ;;;_ > nullify-allout-prefix-data () | 2271 ;;;_ > nullify-allout-prefix-data () |
2381 (= (point) (save-excursion (allout-end-of-prefix)(point)))))) | 2389 (= (point) (save-excursion (allout-end-of-prefix)(point)))))) |
2382 ;;;_ : Location attributes | 2390 ;;;_ : Location attributes |
2383 ;;;_ > allout-depth () | 2391 ;;;_ > allout-depth () |
2384 (defun allout-depth () | 2392 (defun allout-depth () |
2385 "Return depth of topic most immediately containing point. | 2393 "Return depth of topic most immediately containing point. |
2394 | |
2395 Does not do doublecheck for aberrant topic header. | |
2386 | 2396 |
2387 Return zero if point is not within any topic. | 2397 Return zero if point is not within any topic. |
2388 | 2398 |
2389 Like `allout-current-depth', but respects hidden as well as visible topics." | 2399 Like `allout-current-depth', but respects hidden as well as visible topics." |
2390 (save-excursion | 2400 (save-excursion |
2570 (if (looking-at allout-regexp) | 2580 (if (looking-at allout-regexp) |
2571 (forward-char 1)) | 2581 (forward-char 1)) |
2572 | 2582 |
2573 (when (re-search-forward allout-line-boundary-regexp nil 0) | 2583 (when (re-search-forward allout-line-boundary-regexp nil 0) |
2574 (allout-prefix-data) | 2584 (allout-prefix-data) |
2585 (goto-char allout-recent-prefix-beginning) | |
2586 (while (not (bolp)) | |
2587 (forward-char -1)) | |
2575 (and (allout-do-doublecheck) | 2588 (and (allout-do-doublecheck) |
2576 ;; this will set allout-recent-* on the first non-aberrant topic, | 2589 ;; this will set allout-recent-* on the first non-aberrant topic, |
2577 ;; whether it's the current one or one that disqualifies it: | 2590 ;; whether it's the current one or one that disqualifies it: |
2578 (allout-aberrant-container-p)) | 2591 (allout-aberrant-container-p)) |
2592 ;; this may or may not be the same as above depending on doublecheck: | |
2579 (goto-char allout-recent-prefix-beginning)))) | 2593 (goto-char allout-recent-prefix-beginning)))) |
2580 ;;;_ > allout-this-or-next-heading | 2594 ;;;_ > allout-this-or-next-heading |
2581 (defun allout-this-or-next-heading () | 2595 (defun allout-this-or-next-heading () |
2582 "Position cursor on current or next heading." | 2596 "Position cursor on current or next heading." |
2583 ;; A throwaway non-macro that is defined after allout-next-heading | 2597 ;; A throwaway non-macro that is defined after allout-next-heading |
5457 (cdr format))))))) | 5471 (cdr format))))))) |
5458 ;; Put the list with first at front, to last at back: | 5472 ;; Put the list with first at front, to last at back: |
5459 (nreverse result)))) | 5473 (nreverse result)))) |
5460 ;;;_ > allout-region-active-p () | 5474 ;;;_ > allout-region-active-p () |
5461 (defmacro allout-region-active-p () | 5475 (defmacro allout-region-active-p () |
5462 (if (fboundp 'use-region-p) | 5476 (cond ((fboundp 'use-region-p) '(use-region-p)) |
5463 '(use-region-p) | 5477 ((fboundp 'region-active-p) '(region-active-p)) |
5464 '(region-active-p))) | 5478 (t 'mark-active))) |
5465 ;;;_ > allout-process-exposed (&optional func from to frombuf | 5479 ;;_ > allout-process-exposed (&optional func from to frombuf |
5466 ;;; tobuf format) | 5480 ;;; tobuf format) |
5467 (defun allout-process-exposed (&optional func from to frombuf tobuf | 5481 (defun allout-process-exposed (&optional func from to frombuf tobuf |
5468 format start-num) | 5482 format start-num) |
5469 "Map function on exposed parts of current topic; results to another buffer. | 5483 "Map function on exposed parts of current topic; results to another buffer. |
5470 | 5484 |