emacs: lisp/allout.el comparison

comparison lisp/allout.el @ 74011:cce8c092567f

(allout-doublecheck-at-and-shallower): Clarify docstring. (allout-inhibit-aberrance-doublecheck): Rename from allout-during-yank-processing. All callers changed. (allout-ascend): Provide for unusual case where some topic after the first in file is at lower depth than the first. (allout-shift-in): Ensure the offspring of the new containing topic are exposed. (allout-encrypt-string): Preserve the coding-system of the text, according to that of the containing buffer. (allout-toggle-subtree-encryption): When the text being encrypted requires a different coding system, offer to preserve the coding system using a file local var.

author	Chong Yidong <cyd@stupidchicken.com>
date	Wed, 15 Nov 2006 16:34:20 +0000
parents	89b9e8184350
children	cba6f2b24720 c71725faff1a dbe3f29e61d6

comparison

equal deleted inserted replaced

-:ba98b964892a
+:cce8c092567f
 ;;;_   = allout-doublecheck-at-and-shallower
 (defconst allout-doublecheck-at-and-shallower 2
 "Validate apparent topics of this depth and shallower as being non-aberrant.
 Verified with `allout-aberrant-container-p'.  This check's usefulness is
-limited to shallow prospects, because the determination of aberrance
+limited to shallow depths, because the determination of aberrance
-depends on the mistaken item being followed by a legitimate item of
+is according to the mistaken item being followed by a legitimate item of
-excessively greater depth.
+excessively greater depth.")
-A level of 2 is safest, so that yanks, which must ignore
-aberrance while rectifying the yanked text to their new location,
-is least likely to be fooled by aberrant topics in the yanked
-text.")
 ;;;_   X allout-reset-header-lead (header-lead)
 (defun allout-reset-header-lead (header-lead)
 "*Reset the leading string used to identify topic headers."
 (interactive "sNew lead string: ")
 (setq allout-header-prefix header-lead)
 (if (not was-modified)
 (set-buffer-modified-p nil)))
 (goto-char (cadr allout-after-save-decrypt))
 (setq allout-after-save-decrypt nil))
 )
-;;;_   = allout-during-yank-processing nil
+;;;_   = allout-inhibit-aberrance-doublecheck nil
-;; XXX allout yanks adjust the level of the topic being pasted to that of
+;; In some exceptional moments, disparate topic depths need to be allowed
-;; their target location.  aberrance must be inhibited to allow that
+;; momentarily, eg when one topic is being yanked into another and they're
-;; reconciliation.  (this means that actually aberrant topics won't be
+;; about to be reconciled.  let-binding allout-inhibit-aberrance-doublecheck
-;; treated specially while being pasted.)
+;; prevents the aberrance doublecheck to allow, eg, the reconciliation
-(defvar allout-during-yank-processing nil
+;; processing to happen in the presence of such discrepancies.  It should
-"Internal state, inhibits aberrance doublecheck while adjusting yanks.")
+;; almost never be needed, however.
+(defvar allout-inhibit-aberrance-doublecheck nil
+"Internal state, for momentarily inhibits aberrance doublecheck.
+This should only be momentarily let-bound non-nil, not set
+non-nil in a lasting way.")
 ;;;_ #2 Mode activation
 ;;;_  = allout-explicitly-deactivated
 (defvar allout-explicitly-deactivated nil
 "If t, `allout-mode's last deactivation was deliberate.
 (defsubst allout-do-doublecheck ()
 "True if current item conditions qualify for checking on topic aberrance."
 (and
 ;; presume integrity of outline and yanked content during yank - necessary,
 ;; to allow for level disparity of yank location and yanked text:
-(not allout-during-yank-processing)
+(not allout-inhibit-aberrance-doublecheck)
 ;; allout-doublecheck-at-and-shallower is ceiling for doublecheck:
 (<= allout-recent-depth allout-doublecheck-at-and-shallower)))
 ;;;_     > allout-aberrant-container-p ()
 (defun allout-aberrant-container-p ()
 "True if topic, or next sibling with children, contains them discontinuously.
 ;;;_   > allout-ascend ()
 (defun allout-ascend ()
 "Ascend one level, returning t if successful, nil if not."
 (prog1
 (if (allout-beginning-of-level)
-(allout-previous-heading))
+(let ((bolevel (point))
+(bolevel-depth allout-recent-depth))
+(allout-previous-heading)
+(if (< allout-recent-depth bolevel-depth)
+allout-recent-depth
+;; some topic after file's first is at lower depth than first:
+(goto-char bolevel)
+(allout-depth)
+nil)))
 (if (interactive-p) (allout-end-of-prefix))))
 ;;;_   > allout-descend-to-depth (depth)
 (defun allout-descend-to-depth (depth)
 "Descend to depth DEPTH within current topic.
 the other offspring are exposed, or after the last child if the offspring
 are hidden.  \(The intervening offspring will be exposed in the latter
 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
 containing the cursor, regardless of intervening concealed ones.
 0))))
 (if (and (> predecessor-depth 0)
 (> (1+ current-depth)
 (1+ predecessor-depth)))
 (error (concat "Disallowed shift deeper than"
-" containing topic's children."))))))
+" containing topic's children."))
+(allout-back-to-current-heading)
+(if (< allout-recent-depth (1+ current-depth))
+(allout-show-children))))))
 (let ((where (point)))
 (allout-rebullet-topic 1 (and (> arg 1) 'sans-offspring))
 (run-hook-with-args 'allout-structure-shifted-hook arg where))))
 ;;;_    > allout-shift-out (arg)
 (defun allout-shift-out (arg)
 (interactive "*P")
 					; Get to beginning, leaving
 					; region around subject:
 (if (< (allout-mark-marker t) (point))
 (exchange-point-and-mark))
-(let* ( ;; inhibit aberrance doublecheck while reconciling disparate pastes:
+(let* ((subj-beg (point))
-(allout-during-yank-processing t)
-(subj-beg (point))
 (into-bol (bolp))
 (subj-end (allout-mark-marker t))
 ;; 'resituate' if yanking an entire topic into topic header:
-(resituate (and (allout-e-o-prefix-p)
+(resituate (and (let ((allout-inhibit-aberrance-doublecheck t))
+(allout-e-o-prefix-p))
 (looking-at allout-regexp)
 (allout-prefix-data)))
 ;; `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:
+;; Yanking a topic into the start of a topic - reconcile to fit:
 (let* ((inhibit-field-text-motion t)
 (prefix-len (if (not (match-end 1))
 1
 (- (match-end 1) subj-beg)))
 (subj-depth allout-recent-depth)
 ; leaving old one:
 (allout-unprotected
 (progn
 (delete-region (point) (+ (point)
 prefix-len
-(- adjust-to-depth subj-depth)))
+(- 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 (= allout-recent-depth 1)
 (error (concat "Cannot encrypt or decrypt level 1 topics -"
 " shift it in to make it encryptable")))
 (let* ((allout-buffer (current-buffer))
-;; Asses location:
+;; Assess location:
 (bullet-pos allout-recent-prefix-beginning)
 (after-bullet-pos (point))
 (was-encrypted
 (progn (if (= (point-max) after-bullet-pos)
 (error "no body to encrypt"))
 (and (member fetch-pass '(4 (4)))
 '(keypair nil))
 '(symmetric nil)))
 (for-key-type (car key-info))
 (for-key-identity (cadr key-info))
-(fetch-pass (and fetch-pass (member fetch-pass '(16 (16))))))
+(fetch-pass (and fetch-pass (member fetch-pass '(16 (16)))))
+(was-coding-system buffer-file-coding-system))
+(when (not was-encrypted)
+;; ensure that non-ascii chars pending encryption are noticed before
+;; they're encrypted, so the coding system is set to accomodate
+;; them.
+(setq buffer-file-coding-system
+(select-safe-coding-system subtree-beg subtree-end))
+;; if the coding system for the text being encrypted is different
+;; than that prevailing, then there a real risk that the coding
+;; system can't be noticed by emacs when the file is visited.  to
+;; mitigate that, offer to preserve the coding system using a file
+;; local variable.
+(if (and (not (equal buffer-file-coding-system
+was-coding-system))
+(yes-or-no-p
+(format (concat "Register coding system %s as file local"
+" var?  Necessary when only encrypted text"
+" is in that coding system. ")
+buffer-file-coding-system)))
+(allout-adjust-file-variable "buffer-file-coding-system"
+buffer-file-coding-system)))
 (setq result-text
 (allout-encrypt-string subject-text was-encrypted
 (current-buffer)
 for-key-type for-key-identity fetch-pass))
 key-type
 (if (equal key-type 'keypair)
 target-prompt-id
 (or (buffer-file-name allout-buffer)
 target-prompt-id))))
+(encoding (with-current-buffer allout-buffer
+buffer-file-coding-system))
+(multibyte (with-current-buffer allout-buffer
+enable-multibyte-characters))
 (strip-plaintext-regexps
 (if (not decrypt)
 (allout-get-configvar-values
 'allout-encryption-plaintext-sanitization-regexps)))
 (reject-ciphertext-regexps
 retried fetch-pass)))
 (with-temp-buffer
 (insert text)
+;; convey the text characteristics of the original buffer:
+(set-buffer-multibyte multibyte)
+(when encoding
+(set-buffer-file-coding-system encoding)
+(if (not decrypt)
+(encode-coding-region (point-min) (point-max) encoding)))
 (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) "")))

Mercurial > emacs

comparison lisp/allout.el @ 74011:cce8c092567f