Function: allout-yank-processing
allout-yank-processing is an interactive and byte-compiled function
defined in allout.el.gz.
Signature
(allout-yank-processing &optional ARG)
Documentation
Incidental allout-specific business to be done just after text yanks.
Does depth adjustment of yanked topics, when:
1 the stuff being yanked starts with a valid outline header prefix, and
2 it is being yanked at the end of a line which consists of only a valid
topic prefix.
Also, adjusts numbering of subsequent siblings when appropriate.
Depth adjustment alters the depth of all the topics being yanked the amount it takes to make the first topic have the depth of the header into which it's being yanked.
The point is left in front of yanked, adjusted topics, rather than at the end (and vice-versa with the mark). Non-adjusted yanks, however, are left exactly like normal, non-allout-specific yanks.
Key Bindings
Source Code
;; Defined in /usr/src/emacs/lisp/allout.el.gz
;;;_ > allout-yank-processing ()
(defun allout-yank-processing (&optional _arg)
"Incidental allout-specific business to be done just after text yanks.
Does depth adjustment of yanked topics, when:
1 the stuff being yanked starts with a valid outline header prefix, and
2 it is being yanked at the end of a line which consists of only a valid
topic prefix.
Also, adjusts numbering of subsequent siblings when appropriate.
Depth adjustment alters the depth of all the topics being yanked
the amount it takes to make the first topic have the depth of the
header into which it's being yanked.
The point is left in front of yanked, adjusted topics, rather than
at the end (and vice-versa with the mark). Non-adjusted yanks,
however, are left exactly like normal, non-allout-specific yanks."
(interactive "*P")
; Get to beginning, leaving
; region around subject:
(if (< (mark-marker) (point))
(exchange-point-and-mark))
(save-match-data
(let* ((subj-beg (point))
(into-bol (bolp))
(subj-end (mark-marker))
;; 'resituate' if yanking an entire topic into topic header:
(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
;; 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)
(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))
allout-recent-depth)))
(more t))
(setq rectify-numbering allout-numbered-bullet)
(if adjust-to-depth
; Do the adjustment:
(progn
(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)))
; Work backwards, with each
; shallowest level,
; successively excluding the
; last processed topic from
; the narrow region:
(while more
(allout-back-to-current-heading)
; go as high as we can in each bunch:
(while (allout-ascend t))
(save-excursion
(allout-unprotected
(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))))))
;; Remove new heading prefix:
(allout-unprotected
(progn
(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))
(delete-char -1)
(if (not (eolp))
(forward-char))))
;; Assert new topic's bullet - minimal effort if unchanged:
(allout-rebullet-heading (string-to-char prefix-bullet)))
(exchange-point-and-mark))))
(if rectify-numbering
(progn
(save-excursion
; Give some preliminary feedback:
(message "... reconciling numbers")
; ... and renumber, in case necessary:
(goto-char subj-beg)
(if (allout-goto-prefix-doublechecked)
(allout-unprotected
(allout-rebullet-heading nil ;;; instead
(allout-depth) ;;; depth
nil ;;; number-control
nil ;;; index
t)))
(message ""))))
(if (or into-bol resituate)
(allout-hide-by-annotation (point) (mark-marker))
(allout-deannotate-hidden (mark-marker) (point)))
(if (not resituate)
(exchange-point-and-mark))
(run-hook-with-args 'allout-structure-added-functions subj-beg subj-end))))