/[emacs]/emacs/lisp/outline.el
ViewVC logotype

Diff of /emacs/lisp/outline.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.14 by rms, Fri Aug 26 11:52:08 2005 UTC revision 1.15 by monnier, Fri Aug 26 15:31:59 2005 UTC
# Line 453  If INVISIBLE-OK is non-nil, an invisible Line 453  If INVISIBLE-OK is non-nil, an invisible
453        (save-excursion (newline-and-indent)))        (save-excursion (newline-and-indent)))
454      (run-hooks 'outline-insert-heading-hook)))      (run-hooks 'outline-insert-heading-hook)))
455    
456    (defun outline-invent-heading (head up)
457      (save-match-data
458        ;; Let's try to invent one by repeating or deleting the last char.
459        (let ((new-head (if up (substring head 0 -1)
460                          (concat head (substring head -1)))))
461          (if (string-match (concat "\\`\\(?:" outline-regexp "\\)")
462                            new-head)
463              ;; Why bother checking that it is indeed higher/lower level ?
464              new-head
465            ;; Didn't work, so ask what to do.
466            (read-string (format "%s heading for `%s': "
467                                 (if up "Parent" "Demoted") head)
468                         head nil nil t)))))
469    
470  (defun outline-promote (&optional children)  (defun outline-promote (&optional children)
471    "Promote headings higher up the tree.    "Promote headings higher up the tree.
472  If prefix argument CHILDREN is given, promote also all the children.  If prefix argument CHILDREN is given, promote also all the children.
# Line 481  in the region." Line 495  in the region."
495                              (outline-up-heading 1 t)                              (outline-up-heading 1 t)
496                              (and (= (1- level) (funcall outline-level))                              (and (= (1- level) (funcall outline-level))
497                                   (match-string-no-properties 0))))                                   (match-string-no-properties 0))))
498                          ;; Bummer!! There is no lower level heading.                          ;; Bummer!! There is no lower level heading.
499                          ;; Let's try to invent one by deleting the last char.                          (outline-invent-heading head 'up))))
                         (save-match-data  
                           (let ((new-head (substring head 0 -1)))  
                             (if (string-match (concat "\\`\\(?:" outline-regexp "\\)")  
                                               new-head)  
                                 ;; Why bother checking that it is indeed lower level ?  
                                 new-head  
                               ;; Didn't work, so ask what to do.  
                               (read-string (format "Parent heading for `%s': "  
                                                    head)  
                                            head nil nil t)))))))  
500    
501        (unless (rassoc level outline-heading-alist)        (unless (rassoc level outline-heading-alist)
502          (push (cons head level) outline-heading-alist))          (push (cons head level) outline-heading-alist))
# Line 532  in the region." Line 536  in the region."
536                      (unless (eobp)                      (unless (eobp)
537                        (looking-at outline-regexp)                        (looking-at outline-regexp)
538                        (match-string-no-properties 0))))                        (match-string-no-properties 0))))
539                  (save-match-data                  ;; Bummer!! There is no higher-level heading in the buffer.
540                    ;; Bummer!! There is no higher-level heading in the buffer.                  (outline-invent-heading head nil))))
                   ;; Let's try to invent one by repeating the last char.  
                   (let ((new-head (concat head (substring head -1))))  
                     (if (string-match (concat "\\`\\(?:" outline-regexp "\\)")  
                                       new-head)  
                         ;; Why bother checking that it is indeed higher level ?  
                         new-head  
                       ;; Didn't work, so ask what to do.  
                       (read-string (format "Demoted heading for `%s': "  
                                            head)  
                                    head nil nil t)))))))  
541    
542        (unless (rassoc level outline-heading-alist)        (unless (rassoc level outline-heading-alist)
543          (push (cons head level) outline-heading-alist))          (push (cons head level) outline-heading-alist))
# Line 610  the match data is set appropriately." Line 604  the match data is set appropriately."
604  (defun outline-move-subtree-down (&optional arg)  (defun outline-move-subtree-down (&optional arg)
605    "Move the currrent subtree down past ARG headlines of the same level."    "Move the currrent subtree down past ARG headlines of the same level."
606    (interactive "p")    (interactive "p")
607    (let ((re (concat "^\\(?:" outline-regexp "\\)"))    (let ((movfunc (if (> arg 0) 'outline-get-next-sibling
         (movfunc (if (> arg 0) 'outline-get-next-sibling  
608                     'outline-get-last-sibling))                     'outline-get-last-sibling))
609          (ins-point (make-marker))          (ins-point (make-marker))
610          (cnt (abs arg))          (cnt (abs arg))
611          beg end txt folded)          beg end folded)
612      ;; Select the tree      ;; Select the tree
613      (outline-back-to-heading)      (outline-back-to-heading)
614      (setq beg (point))      (setq beg (point))
# Line 883  Show the heading too, if it is currently Line 876  Show the heading too, if it is currently
876    
877  (defun outline-end-of-subtree ()  (defun outline-end-of-subtree ()
878    (outline-back-to-heading)    (outline-back-to-heading)
879    (let ((opoint (point))    (let ((first t)
         (first t)  
880          (level (funcall outline-level)))          (level (funcall outline-level)))
881      (while (and (not (eobp))      (while (and (not (eobp))
882                  (or first (> (funcall outline-level) level)))                  (or first (> (funcall outline-level) level)))
# Line 1044  convenient way to make a table of conten Line 1036  convenient way to make a table of conten
1036  (provide 'outline)  (provide 'outline)
1037  (provide 'noutline)  (provide 'noutline)
1038    
1039  ;;; arch-tag: 1724410e-7d4d-4f46-b801-49e18171e874  ;; arch-tag: 1724410e-7d4d-4f46-b801-49e18171e874
1040  ;;; outline.el ends here  ;;; outline.el ends here

Legend:
Removed from v.1.14  
changed lines
  Added in v.1.15

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26