[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/textmodes/outline.el
From: |
Stefan Monnier |
Subject: |
[Emacs-diffs] Changes to emacs/lisp/textmodes/outline.el |
Date: |
Thu, 13 Mar 2003 13:15:11 -0500 |
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))))
- [Emacs-diffs] Changes to emacs/lisp/textmodes/outline.el,
Stefan Monnier <=