[Emacs-diffs] Changes to emacs/lisp/textmodes/outline.el

[Stefan Monnier]

Index: emacs/lisp/textmodes/outline.el
diff -c emacs/lisp/textmodes/outline.el:1.60 
emacs/lisp/textmodes/outline.el:1.61
*** emacs/lisp/textmodes/outline.el:1.60        Wed Feb  5 18:15:41 2003
--- emacs/lisp/textmodes/outline.el     Thu Mar 13 13:15:07 2003
***************
*** 80,88 ****
      (define-key map "\C-k" 'show-branches)
      (define-key map "\C-q" 'hide-sublevels)
      (define-key map "\C-o" 'hide-other)
!     (define-key map "\C-^" 'outline-promote)
!     (define-key map "\C-v" 'outline-demote)
!     ;; Where to bind toggle and insert-heading ?
      map))
  
  (defvar outline-mode-menu-bar-map
--- 80,91 ----
      (define-key map "\C-k" 'show-branches)
      (define-key map "\C-q" 'hide-sublevels)
      (define-key map "\C-o" 'hide-other)
!     (define-key map "\C-^" 'outline-move-subtree-up)
!     (define-key map "\C-v" 'outline-move-subtree-down)
!     (define-key map [(control ?<)] 'outline-promote)
!     (define-key map [(control ?>)] 'outline-demote)
!     (define-key map "\C-m" 'outline-insert-heading)
!     ;; Where to bind outline-cycle ?
      map))
  
  (defvar outline-mode-menu-bar-map
***************
*** 108,116 ****
--- 111,129 ----
      (define-key map [headings]
        (cons "Headings" (make-sparse-keymap "Headings")))
  
+     (define-key map [headings demote-subtree]
+       '(menu-item "Demote subtree" outline-demote))
+     (define-key map [headings promote-subtree]
+       '(menu-item "Promote subtree" outline-promote))
+     (define-key map [headings move-subtree-down]
+       '(menu-item "Move subtree down" outline-move-subtree-down))
+     (define-key map [headings move-subtree-up]
+       '(menu-item "Move subtree up" outline-move-subtree-up))
      (define-key map [headings copy]
        '(menu-item "Copy to kill ring" outline-headers-as-kill
        :enable mark-active))
+     (define-key map [headings outline-insert-heading]
+       '("New heading" . outline-insert-heading))
      (define-key map [headings outline-backward-same-level]
        '("Previous Same Level" . outline-backward-same-level))
      (define-key map [headings outline-forward-same-level]
***************
*** 139,145 ****
                                         (cons '(--- "---") (cdr x))))
                                   outline-mode-menu-bar-map))))))
      map))
! 
  
  (defvar outline-mode-map
    (let ((map (make-sparse-keymap)))
--- 152,158 ----
                                         (cons '(--- "---") (cdr x))))
                                   outline-mode-menu-bar-map))))))
      map))
!             
  
  (defvar outline-mode-map
    (let ((map (make-sparse-keymap)))
***************
*** 339,347 ****
    (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
                      nil 'move))
  
! (defsubst outline-invisible-p ()
    "Non-nil if the character after point is invisible."
!   (get-char-property (point) 'invisible))
  
  (defun outline-visible ()
    (not (outline-invisible-p)))
--- 352,360 ----
    (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
                      nil 'move))
  
! (defsubst outline-invisible-p (&optional pos)
    "Non-nil if the character after point is invisible."
!   (get-char-property (or pos (point)) 'invisible))
  
  (defun outline-visible ()
    (not (outline-invisible-p)))
***************
*** 391,465 ****
      (run-hooks 'outline-insert-heading-hook)))
  
  (defun outline-promote (&optional children)
!   "Promote the current heading higher up the tree.
! If prefix argument CHILDREN is given, promote also all the children."
!   (interactive "P")
!   (outline-back-to-heading)
!   (let* ((head (match-string 0))
!        (level (save-match-data (funcall outline-level)))
!        (up-head (or (car (rassoc (1- level) outline-heading-alist))
!                     (save-excursion
!                       (save-match-data
!                         (outline-up-heading 1 t)
!                         (match-string 0))))))
! 
!     (unless (rassoc level outline-heading-alist)
!       (push (cons head level) outline-heading-alist))
! 
!     (replace-match up-head nil t)
!     (when children
!       (outline-map-tree 'outline-promote level))))
  
  (defun outline-demote (&optional children)
!   "Demote the current heading lower down the tree.
! If prefix argument CHILDREN is given, demote also all the children."
!   (interactive "P")
!   (outline-back-to-heading)
!   (let* ((head (match-string 0))
!        (level (save-match-data (funcall outline-level)))
!        (down-head
!         (or (car (rassoc (1+ level) outline-heading-alist))
!             (save-excursion
!               (save-match-data
!                 (while (and (not (eobp))
!                             (progn
!                               (outline-next-heading)
!                               (<= (funcall outline-level) level))))
!                 (when (eobp)
!                   ;; Try again from the beginning of the buffer.
!                   (goto-char (point-min))
                    (while (and (not (eobp))
                                (progn
                                  (outline-next-heading)
!                                 (<= (funcall outline-level) level)))))
!                 (unless (eobp)
!                   (looking-at outline-regexp)
!                   (match-string 0))))
!             (save-match-data
!               ;; Bummer!! There is no lower heading in the buffer.
!               ;; Let's try to invent one by repeating the first char.
!               (let ((new-head (concat (substring head 0 1) head)))
!                 (if (string-match (concat "\\`" outline-regexp) new-head)
!                     ;; Why bother checking that it is indeed of lower level ?
!                     new-head
!                   ;; Didn't work: keep it as is so it's still a heading.
!                   head))))))
  
      (unless (rassoc level outline-heading-alist)
        (push (cons head level) outline-heading-alist))
  
!     (replace-match down-head nil t)
!     (when children
!       (outline-map-tree 'outline-demote level))))
! 
! (defun outline-map-tree (fun level)
!   "Call FUN for every heading underneath the current one."
    (save-excursion
!     (while (and (progn
!                 (outline-next-heading)
!                 (> (funcall outline-level) level))
!               (not (eobp)))
!       (funcall fun))))
  
  (defun outline-end-of-heading ()
    (if (re-search-forward outline-heading-end-regexp nil 'move)
--- 404,547 ----
      (run-hooks 'outline-insert-heading-hook)))
  
  (defun outline-promote (&optional children)
!   "Promote headings higher up the tree.
! If prefix argument CHILDREN is given, promote also all the children.
! If the region is active in `transient-mark-mode', promote all headings
! in the region."
!   (interactive
!    (list (if (and transient-mark-mode mark-active) 'region
!          (outline-back-to-heading)
!          (if current-prefix-arg nil 'subtree))))
!   (cond
!    ((eq children 'region)
!     (outline-map-region 'outline-promote (region-beginning) (region-end)))
!    (children
!     (outline-map-region 'outline-promote
!                       (point)
!                       (save-excursion (outline-get-next-sibling) (point))))
!    (t
!     (outline-back-to-heading t)
!     (let* ((head (match-string 0))
!          (level (save-match-data (funcall outline-level)))
!          (up-head (or (car (rassoc (1- level) outline-heading-alist))
!                       (save-excursion
!                         (save-match-data
!                           (outline-up-heading 1 t)
!                           (match-string 0))))))
!       
!       (unless (rassoc level outline-heading-alist)
!       (push (cons head level) outline-heading-alist))
!       
!       (replace-match up-head nil t)))))
  
  (defun outline-demote (&optional children)
!   "Demote headings lower down the tree.
! If prefix argument CHILDREN is given, demote also all the children.
! If the region is active in `transient-mark-mode', demote all headings
! in the region."
!   (interactive
!    (list (if (and transient-mark-mode mark-active) 'region
!          (outline-back-to-heading)
!          (if current-prefix-arg nil 'subtree))))
!   (cond
!    ((eq children 'region)
!     (outline-map-region 'outline-demote (region-beginning) (region-end)))
!    (children
!     (outline-map-region 'outline-demote
!                       (point)
!                       (save-excursion (outline-get-next-sibling) (point))))
!    (t
!     (let* ((head (match-string 0))
!          (level (save-match-data (funcall outline-level)))
!          (down-head
!           (or (car (rassoc (1+ level) outline-heading-alist))
!               (save-excursion
!                 (save-match-data
                    (while (and (not (eobp))
                                (progn
                                  (outline-next-heading)
!                                 (<= (funcall outline-level) level))))
!                   (when (eobp)
!                     ;; Try again from the beginning of the buffer.
!                     (goto-char (point-min))
!                     (while (and (not (eobp))
!                                 (progn
!                                   (outline-next-heading)
!                                   (<= (funcall outline-level) level)))))
!                   (unless (eobp)
!                     (looking-at outline-regexp)
!                     (match-string 0))))
!               (save-match-data
!                 ;; Bummer!! There is no lower heading in the buffer.
!                 ;; Let's try to invent one by repeating the first char.
!                 (let ((new-head (concat (substring head 0 1) head)))
!                   (if (string-match (concat "\\`" outline-regexp) new-head)
!                       ;; Why bother checking that it is indeed lower level ?
!                       new-head
!                     ;; Didn't work: keep it as is so it's still a heading.
!                     head))))))
  
      (unless (rassoc level outline-heading-alist)
        (push (cons head level) outline-heading-alist))
+     (replace-match down-head nil t)))))
  
! (defun outline-map-region (fun beg end)
!   "Call FUN for every heading between BEG and END.
! When FUN is called, point is at the beginning of the heading and
! the match data is set appropriately."
    (save-excursion
!     (setq end (copy-marker end))
!     (goto-char beg)
!     (when (re-search-forward (concat "^\\(?:" outline-regexp "\\)") end t)
!       (goto-char (match-beginning 0))
!       (funcall fun)
!       (while (and (progn
!                   (outline-next-heading)
!                   (< (point) end))
!                 (not (eobp)))
!       (funcall fun)))))
! 
! ;; Vertical tree motion
! 
! (defun outline-move-subtree-up (&optional arg)
!   "Move the currrent subtree up past ARG headlines of the same level."
!   (interactive "p")
!   (outline-move-subtree-down (- arg)))
! 
! (defun outline-move-subtree-down (&optional arg)
!   "Move the currrent subtree down past ARG headlines of the same level."
!   (interactive "p")
!   (let ((re (concat "^" outline-regexp))
!       (movfunc (if (> arg 0) 'outline-get-next-sibling 
!                  'outline-get-last-sibling))
!       (ins-point (make-marker))
!       (cnt (abs arg))
!       beg end txt folded)
!     ;; Select the tree
!     (outline-back-to-heading)
!     (setq beg (point))
!     (save-match-data 
!       (save-excursion (outline-end-of-heading) 
!                     (setq folded (outline-invisible-p)))
!       (outline-end-of-subtree))
!     (if (= (char-after) ?\n) (forward-char 1))
!     (setq end (point))
!     ;; Find insertion point, with error handling
!     (goto-char beg)
!     (while (> cnt 0)
!       (or (funcall movfunc)
!         (progn (goto-char beg)
!                (error "Cannot move past superior level")))
!       (setq cnt (1- cnt)))
!     (if (> arg 0)
!       ;; Moving forward - still need to move over subtree
!       (progn (outline-end-of-subtree) 
!              (if (= (char-after) ?\n) (forward-char 1))))
!     (move-marker ins-point (point))
!     (insert (delete-and-extract-region beg end))
!     (goto-char ins-point)
!     (if folded (hide-subtree))
!     (move-marker ins-point nil)))
  
  (defun outline-end-of-heading ()
    (if (re-search-forward outline-heading-end-regexp nil 'move)
***************
*** 484,492 ****
      (while (and (not (eobp))
                (re-search-forward (concat "^\\(?:" outline-regexp "\\)")
                                   nil 'move)
!               (save-excursion
!                 (goto-char (match-beginning 0))
!                 (outline-invisible-p))))
      (setq arg (1- arg)))
    (beginning-of-line))
  
--- 566,572 ----
      (while (and (not (eobp))
                (re-search-forward (concat "^\\(?:" outline-regexp "\\)")
                                   nil 'move)
!               (outline-invisible-p (match-beginning 0))))
      (setq arg (1- arg)))
    (beginning-of-line))
  
***************
*** 534,540 ****
        ;; reveal do the rest, by simply doing:
        ;; (remove-overlays (overlay-start o) (overlay-end o)
        ;;                  'invisible 'outline)
!       ;;
        ;; That works fine as long as everything is in sync, but if the
        ;; structure of the document is changed while revealing parts of it,
        ;; the resulting behavior can be ugly.  I.e. we need to make
--- 614,620 ----
        ;; reveal do the rest, by simply doing:
        ;; (remove-overlays (overlay-start o) (overlay-end o)
        ;;                  'invisible 'outline)
!       ;; 
        ;; That works fine as long as everything is in sync, but if the
        ;; structure of the document is changed while revealing parts of it,
        ;; the resulting behavior can be ugly.  I.e. we need to make
***************
*** 681,689 ****
    "Show or hide the current subtree depending on its current state."
    (interactive)
    (outline-back-to-heading)
!   (if (save-excursion
!       (end-of-line)
!       (not (outline-invisible-p)))
        (hide-subtree)
      (show-children)
      (show-entry)))
--- 761,767 ----
    "Show or hide the current subtree depending on its current state."
    (interactive)
    (outline-back-to-heading)
!   (if (not (outline-invisible-p (line-end-position)))
        (hide-subtree)
      (show-children)
      (show-entry)))
***************
*** 754,760 ****
                                       (point))
                                     (progn (outline-end-of-heading) (point))
                                     nil)))))))
!   (run-hooks 'outline-view-change-hook))
  
  
  
--- 832,838 ----
                                       (point))
                                     (progn (outline-end-of-heading) (point))
                                     nil)))))))
!     (run-hooks 'outline-view-change-hook))
  
  
  
***************
*** 801,807 ****
      (while (and (> (funcall outline-level) level)
                (not (eobp)))
        (outline-next-visible-heading 1))
!     (if (< (funcall outline-level) level)
        nil
        (point))))
  
--- 879,885 ----
      (while (and (> (funcall outline-level) level)
                (not (eobp)))
        (outline-next-visible-heading 1))
!     (if (or (eobp) (< (funcall outline-level) level))
        nil
        (point))))