outline.el, killing, yanking, and invisibility

[Matt Swift]

I am in the process (now and then when I have time) of accommodating
my own long-standing enhancements to Outline mode to the many
enhancements in the CVS outline.el.  Many of the enhancements are
parallel, and the implemention in outline.el is in many cases superior
to mine.  I have made one enhancement, however, whose implementation
to that in outline.el seems superior, and I would like to present it
for consideration. 

The preservation of the invisibility of outline nodes over the
operations of killing and yanking was automatic in the old
`selective-display' implementation of Outline mode (ooutline.el now).
With the advent of overlays, this feature was sacrificed for the
advantages of an overlay implementation, and I have spent years
hacking now and then at ways to recover it.  The more-recent advent of
yank-handlers provided me with a way to do it well, and I share this
way below.

Outline mode as currently implemented in CVS makes some effort to
offer the ability to manipulate collapsed outline nodes without
expanding them (as will occur during a kill and a yank of a collapsed
node, because the killed text does not have invisibility properties,
which are in the overlay, and even if it did, yanking would strip
them).  Outline mode offers functions that move nodes up and down
within a group of siblings, which is a main reason to want to kill and
yank nodes.  I believe the functions are intended to preserve the
invisibility of the node moved (the flag `folded' in
`outline-move-subtree-down'), but (1) they do not work for me as they
seem to be intended to work, and (2) this system yanks text that is
either completely invisible or completely visible: node text in a
mixed state will be forced to one state or the other based on an area
tested for the binary condition of `folded' or not.

My more general solution transfers the 'invisible text property of
overlays on the killed text to a new overlay on the yanked text.

Below I include the relevant extracts of my own outline package.  I
haven't (and probably won't) try to patch this one feature into the
existing outline.el, since I still have a long way to go in sorting
out the overlaps between my complete package and the new outline.el,
but I want to present this solution for the possible incorporation
into outline.el by others.

;;;; Invisibility Management

;; FIX When did yank-handling show up? Could probably do this without
;; yank-handling by advising the yank functions.
;;
;; NOTE `emacs-version-lessp' is my own function defined elsewhere; I
;;      show it here just to bring up the point of compatibility.
(when (emacs-version-lessp "21.3")
  (error "Ox requires yank-handling, introduced in ABOUT Emacs version 21.3"))

(defcustom ox-preserve-invisibility-flag t
  "Non-nil means killed invisible text is yanked as invisible text.
Otherwise yank as visible text, which is normal Emacs behavior.
Default value is t."
  :type '(choice (other :tag "Yank as invisible" t)
                 (const :tag "Yank as visible" nil))
  :group 'outlines)

(defun ox-preserve-invisibility-p ()
  "Return t if killing should include the 'invisible property from overlays."
  (and ox-preserve-invisibility-flag
       (or outline-minor-mode (eq major-mode 'outline-mode))))

(defvar ox-pi-propertized nil
  "Non-nil means the current buffer has been propertized by
  `ox-pi-propertize-buffer'.")
(make-variable-buffer-local 'ox-pi-propertized)

(add-hook 'outline-mode-hook 'ox-pi-propertize-buffer)
(add-hook 'outline-minor-mode-hook 'ox-pi-propertize-buffer)

(defun ox-pi-propertize-buffer (&optional force)
  "Set the 'yank-handler text property for the entire buffer.
Optional FORCE non-nil means set the properties even if
`ox-pi-propertized' is non-nil.  Does not mark the buffer as
modified.  Returns t if text properties were changed and nil
otherwise."
  (when (or force (not ox-pi-propertized))
    (let ((modified (buffer-modified-p)))
      ;; FIX could there be multiple yank-handlers?
      (put-text-property (point-min) (point-max) 'yank-handler 
'(ox-pi-yank-handler nil t))
      (restore-buffer-modified-p modified)
      (setq ox-pi-propertized t))
    t))

(defun ox-pi-yank-handler (obj)
  "Insert OBJ, preserving invisibility.
Remove from OBJ all of `yank-excluded-properites' except
'yank-handler and 'invisible.  Then insert OBJ with `insert'.
Then move invisibility properties from the yanked text to
an overlay."
  (let ((p (point)))
    (remove-list-of-text-properties
     0 (length obj)
     (remq 'yank-handler
           (remq 'invisible yank-excluded-properties))
     obj)
    (insert obj)
    (ox-pi-invisibility-to-overlay p (point))))

(defun ox-pi-invisibility-to-overlay (beg end)
  "Move the 'invisible property from text to overlay in the region BEG END.
Avoids marking the buffer as modified."
  (let ((modified (buffer-modified-p)))
    (save-excursion
      (goto-char beg)
      (while (< (point) end)
        (let* ((pt (point))
               (invisi-prop (get-char-property pt 'invisible))
               (next-change (next-single-char-property-change
                             pt 'invisible (current-buffer) end)))
          ;; FIX How to set front and rear delimiters for `make-overlay'?
          ;; "The fourth arg FRONT-ADVANCE, if non-nil, makes the front
          ;; delimiter advance when text is inserted there.  The fifth arg
          ;; REAR-ADVANCE, if non-nil, makes the rear delimiter advance when
          ;; text is inserted there."
          (overlay-put (make-overlay pt next-change) 'invisible invisi-prop)
          (goto-char next-change)))
      (remove-text-properties beg end '(invisible nil)))
    (restore-buffer-modified-p modified)))

(defun ox-pi-invisibility-from-overlay (beg end)
  "Copy 'invisible property from overlays to buffer text in region BEG END.
Does not mark buffer modified."
  (let ((modified (buffer-modified-p)))
    (save-excursion
      (goto-char beg)
      (while (< (point) end)
        (let* ((pt (point))
               (invisi-prop (get-char-property pt 'invisible))
               (next-change (next-single-char-property-change
                             pt 'invisible (current-buffer) end)))
          (put-text-property pt next-change 'invisible invisi-prop)
          (goto-char next-change))))
    (restore-buffer-modified-p modified)))

;; FIX Should we worry about the case of a non-nil YANK-HANDLER?
;;(kill-region BEG END &optional YANK-HANDLER)
(defadvice kill-region (before ox-pi-kill-region last 'disable)
  "Ox's advice to `kill-region'.
When `ox-preserve-invisibility-p' returns non-nil,
calls `ox-pi-invisibility-from-overlay' on the region to be killed."
  (when (ox-preserve-invisibility-p)
    (ox-pi-invisibility-from-overlay (ad-get-arg 0) (ad-get-arg 1))))
    
(defadvice copy-region-as-kill (before ox-pi-copy-region-as-kill last 'disable)
  "Ox's advice to `copy-region-as-kill'.
When `ox-preserve-invisibility-p' returns non-nil,
calls `ox-pi-invisibility-from-overlay' on the region to be killed."
  (when (ox-preserve-invisibility-p)
    (ox-pi-invisibility-from-overlay (ad-get-arg 0) (ad-get-arg 1))))

;; This system of turning advice on and off is perhaps overkill.  It was
;; motivated by earlier versions of this package, which defined more advice.
(defconst ox-advised-function-info
  '((kill-region (before ox-pi-kill-region))
    (copy-region-as-kill (before ox-pi-copy-region-as-kill)))
  "List of information about functions advised by Ox.
Each element is in the form
   \(FUNC \[\(AD-CLASS AD-NAME...\)\]...\)")
(defun ox-pi-turn-advice (status)
  "Set Ox preserve invisibility advice to STATUS.
STATUS nil or 'off or means disable Ox advice and any other value
means enable it.  After enabling or disabling, all pieces of
advice are activated.

Ox advice is listed in `ox-advised-function-info'."
  (let ((action (if (memq status '(nil off))
                    (function ad-disable-advice)
                  (function ad-enable-advice))))
    (dolist (funfo ox-advised-function-info)
      ;; (car funfo) = FUNC
      ;; classfos:= (cdr funfo) = (AD-CLASS AD-NAME...)...
      (dolist (classfo (cdr funfo))
        ;; (car classfo) = AD-CLASS
        ;; names:= (cdr classfo) = (AD-NAME...)
        (dolist (name (cdr classfo))
          ;; i.e.:(ad-enable/disable-advice FUNC AD-CLASS AD-NAME)
          (funcall action (car funfo) (car classfo) name)))
      ;; i.e.: (ad-activate FUNC)
      (ad-activate (car funfo)))))
(ox-pi-turn-advice 'on)