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

Diff of /emacs/lisp/textmodes/outline.el

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

revision 1.51 by monnier, Fri Nov 30 09:23:19 2001 UTC revision 1.52 by monnier, Sun Dec 2 08:39:39 2001 UTC
# Line 61  in the file it applies to." Line 61  in the file it applies to."
61    :type 'regexp    :type 'regexp
62    :group 'outlines)    :group 'outlines)
63    
64  (defvar outline-mode-prefix-map nil)  (defvar outline-mode-prefix-map
65      (let ((map (make-sparse-keymap)))
66  (if outline-mode-prefix-map      (define-key map "@" 'outline-mark-subtree)
67      nil      (define-key map "\C-n" 'outline-next-visible-heading)
68    (setq outline-mode-prefix-map (make-sparse-keymap))      (define-key map "\C-p" 'outline-previous-visible-heading)
69    (define-key outline-mode-prefix-map "@" 'outline-mark-subtree)      (define-key map "\C-i" 'show-children)
70    (define-key outline-mode-prefix-map "\C-n" 'outline-next-visible-heading)      (define-key map "\C-s" 'show-subtree)
71    (define-key outline-mode-prefix-map "\C-p" 'outline-previous-visible-heading)      (define-key map "\C-d" 'hide-subtree)
72    (define-key outline-mode-prefix-map "\C-i" 'show-children)      (define-key map "\C-u" 'outline-up-heading)
73    (define-key outline-mode-prefix-map "\C-s" 'show-subtree)      (define-key map "\C-f" 'outline-forward-same-level)
74    (define-key outline-mode-prefix-map "\C-d" 'hide-subtree)      (define-key map "\C-b" 'outline-backward-same-level)
75    (define-key outline-mode-prefix-map "\C-u" 'outline-up-heading)      (define-key map "\C-t" 'hide-body)
76    (define-key outline-mode-prefix-map "\C-f" 'outline-forward-same-level)      (define-key map "\C-a" 'show-all)
77    (define-key outline-mode-prefix-map "\C-b" 'outline-backward-same-level)      (define-key map "\C-c" 'hide-entry)
78    (define-key outline-mode-prefix-map "\C-t" 'hide-body)      (define-key map "\C-e" 'show-entry)
79    (define-key outline-mode-prefix-map "\C-a" 'show-all)      (define-key map "\C-l" 'hide-leaves)
80    (define-key outline-mode-prefix-map "\C-c" 'hide-entry)      (define-key map "\C-k" 'show-branches)
81    (define-key outline-mode-prefix-map "\C-e" 'show-entry)      (define-key map "\C-q" 'hide-sublevels)
82    (define-key outline-mode-prefix-map "\C-l" 'hide-leaves)      (define-key map "\C-o" 'hide-other)
83    (define-key outline-mode-prefix-map "\C-k" 'show-branches)      (define-key map "\C-^" 'outline-promote)
84    (define-key outline-mode-prefix-map "\C-q" 'hide-sublevels)      (define-key map "\C-v" 'outline-demote)
85    (define-key outline-mode-prefix-map "\C-o" 'hide-other))      map))
86    
87  (defvar outline-mode-menu-bar-map nil)  (defvar outline-mode-menu-bar-map
88  (if outline-mode-menu-bar-map    (let ((map (make-sparse-keymap)))
89      nil  
90    (setq outline-mode-menu-bar-map (make-sparse-keymap))      (define-key map [hide] (cons "Hide" (make-sparse-keymap "Hide")))
91    
92    (define-key outline-mode-menu-bar-map [hide]      (define-key map [hide hide-other] '("Hide Other" . hide-other))
93      (cons "Hide" (make-sparse-keymap "Hide")))      (define-key map [hide hide-sublevels] '("Hide Sublevels" . hide-sublevels))
94        (define-key map [hide hide-subtree] '("Hide Subtree" . hide-subtree))
95    (define-key outline-mode-menu-bar-map [hide hide-other]      (define-key map [hide hide-entry] '("Hide Entry" . hide-entry))
96      '("Hide Other" . hide-other))      (define-key map [hide hide-body] '("Hide Body" . hide-body))
97    (define-key outline-mode-menu-bar-map [hide hide-sublevels]      (define-key map [hide hide-leaves] '("Hide Leaves" . hide-leaves))
98      '("Hide Sublevels" . hide-sublevels))  
99    (define-key outline-mode-menu-bar-map [hide hide-subtree]      (define-key map [show] (cons "Show" (make-sparse-keymap "Show")))
100      '("Hide Subtree" . hide-subtree))  
101    (define-key outline-mode-menu-bar-map [hide hide-entry]      (define-key map [show show-subtree] '("Show Subtree" . show-subtree))
102      '("Hide Entry" . hide-entry))      (define-key map [show show-children] '("Show Children" . show-children))
103    (define-key outline-mode-menu-bar-map [hide hide-body]      (define-key map [show show-branches] '("Show Branches" . show-branches))
104      '("Hide Body" . hide-body))      (define-key map [show show-entry] '("Show Entry" . show-entry))
105    (define-key outline-mode-menu-bar-map [hide hide-leaves]      (define-key map [show show-all] '("Show All" . show-all))
106      '("Hide Leaves" . hide-leaves))  
107        (define-key map [headings]
108    (define-key outline-mode-menu-bar-map [show]        (cons "Headings" (make-sparse-keymap "Headings")))
109      (cons "Show" (make-sparse-keymap "Show")))  
110        (define-key map [headings copy]
111    (define-key outline-mode-menu-bar-map [show show-subtree]        '(menu-item "Copy to kill ring" outline-headers-as-kill
112      '("Show Subtree" . show-subtree))          :enable mark-active))
113    (define-key outline-mode-menu-bar-map [show show-children]      (define-key map [headings outline-backward-same-level]
114      '("Show Children" . show-children))        '("Previous Same Level" . outline-backward-same-level))
115    (define-key outline-mode-menu-bar-map [show show-branches]      (define-key map [headings outline-forward-same-level]
116      '("Show Branches" . show-branches))        '("Next Same Level" . outline-forward-same-level))
117    (define-key outline-mode-menu-bar-map [show show-entry]      (define-key map [headings outline-previous-visible-heading]
118      '("Show Entry" . show-entry))        '("Previous" . outline-previous-visible-heading))
119    (define-key outline-mode-menu-bar-map [show show-all]      (define-key map [headings outline-next-visible-heading]
120      '("Show All" . show-all))        '("Next" . outline-next-visible-heading))
121        (define-key map [headings outline-up-heading]
122    (define-key outline-mode-menu-bar-map [headings]        '("Up" . outline-up-heading))
123      (cons "Headings" (make-sparse-keymap "Headings")))      map))
124    
125    (define-key outline-mode-menu-bar-map [headings copy]  (defvar outline-minor-mode-menu-bar-map
126      '(menu-item "Copy to kill ring" outline-headers-as-kill    (let ((map (make-sparse-keymap)))
127                  :enable mark-active))      (define-key map [outline]
128    (define-key outline-mode-menu-bar-map [headings outline-backward-same-level]        (cons "Outline"
129      '("Previous Same Level" . outline-backward-same-level))              (nconc (make-sparse-keymap "Outline")
130    (define-key outline-mode-menu-bar-map [headings outline-forward-same-level]                     ;; Remove extra separator
131      '("Next Same Level" . outline-forward-same-level))                     (cdr
132    (define-key outline-mode-menu-bar-map [headings outline-previous-visible-heading]                      ;; Flatten the major mode's menus into a single menu.
133      '("Previous" . outline-previous-visible-heading))                      (apply 'append
134    (define-key outline-mode-menu-bar-map [headings outline-next-visible-heading]                             (mapcar (lambda (x)
135      '("Next" . outline-next-visible-heading))                                       (if (consp x)
136    (define-key outline-mode-menu-bar-map [headings outline-up-heading]                                           ;; Add a separator between each
137      '("Up" . outline-up-heading)))                                           ;; part of the unified menu.
138                                             (cons '(--- "---") (cdr x))))
139  (defvar outline-mode-map nil "")                                     outline-mode-menu-bar-map))))))
140        map))
141  (if outline-mode-map                
142      nil  
143    (setq outline-mode-map (nconc (make-sparse-keymap) text-mode-map))  (defvar outline-mode-map
144    (define-key outline-mode-map "\C-c" outline-mode-prefix-map)    (let ((map (make-sparse-keymap)))
145    (define-key outline-mode-map [menu-bar] outline-mode-menu-bar-map))      (define-key map "\C-c" outline-mode-prefix-map)
146        (define-key map [menu-bar] outline-mode-menu-bar-map)
147        map))
148    
149  (defvar outline-font-lock-keywords  (defvar outline-font-lock-keywords
150    '(;;    '(;;
# Line 243  After that, changing the prefix key requ Line 245  After that, changing the prefix key requ
245    "Toggle Outline minor mode.    "Toggle Outline minor mode.
246  With arg, turn Outline minor mode on if arg is positive, off otherwise.  With arg, turn Outline minor mode on if arg is positive, off otherwise.
247  See the command `outline-mode' for more information on this mode."  See the command `outline-mode' for more information on this mode."
248    nil " Outl" (list (cons [menu-bar] outline-mode-menu-bar-map)    nil " Outl" (list (cons [menu-bar] outline-minor-mode-menu-bar-map)
249                      (cons outline-minor-mode-prefix outline-mode-prefix-map))                      (cons outline-minor-mode-prefix outline-mode-prefix-map))
250    (if outline-minor-mode    (if outline-minor-mode
251        (progn        (progn
# Line 266  It can assume point is at the beginning Line 268  It can assume point is at the beginning
268    :type 'function    :type 'function
269    :group 'outlines)    :group 'outlines)
270    
271    (defvar outline-heading-alist ()
272      "Alist associating a heading for every possible level.
273    Each entry is of the form (HEADING . LEVEL).
274    This alist is used both to find the heading corresponding to
275    a given level and to find the level of a given heading.")
276    (make-variable-buffer-local 'outline-heading-alist)
277    
278  ;; This used to count columns rather than characters, but that made ^L  ;; This used to count columns rather than characters, but that made ^L
279  ;; appear to be at level 2 instead of 1.  Columns would be better for  ;; appear to be at level 2 instead of 1.  Columns would be better for
280  ;; tab handling, but the default regexp doesn't use tabs, and anyone  ;; tab handling, but the default regexp doesn't use tabs, and anyone
# Line 273  It can assume point is at the beginning Line 282  It can assume point is at the beginning
282  ;; as appropriate.  ;; as appropriate.
283  (defun outline-level ()  (defun outline-level ()
284    "Return the depth to which a statement is nested in the outline.    "Return the depth to which a statement is nested in the outline.
285  Point must be at the beginning of a header line.  This is actually  Point must be at the beginning of a header line.
286  the number of characters that `outline-regexp' matches."  This is actually either the level specified in `outline-heading-alist'
287    or else the number of characters matched by `outline-regexp'."
288    (save-excursion    (save-excursion
289      (looking-at outline-regexp)      (if (not (looking-at outline-regexp))
290      (- (match-end 0) (match-beginning 0))))          ;; This should never happen
291            1000
292          (or (cdr (assoc (match-string 0) outline-heading-alist))
293              (- (match-end 0) (match-beginning 0))))))
294    
295  (defun outline-next-preface ()  (defun outline-next-preface ()
296    "Skip forward to just before the next heading line.    "Skip forward to just before the next heading line.
# Line 333  If INVISIBLE-OK is non-nil, an invisible Line 346  If INVISIBLE-OK is non-nil, an invisible
346      (and (bolp) (or invisible-ok (not (outline-invisible-p)))      (and (bolp) (or invisible-ok (not (outline-invisible-p)))
347           (looking-at outline-regexp))))           (looking-at outline-regexp))))
348    
 (defvar outline-level-heading ()  
   "Alist associating a heading for every possible level.")  
 (make-variable-buffer-local 'outline-level-heading)  
   
349  (defun outline-insert-heading ()  (defun outline-insert-heading ()
350    "Insert a new heading at same depth at point."    "Insert a new heading at same depth at point."
351    (interactive)    (interactive)
# Line 345  If INVISIBLE-OK is non-nil, an invisible Line 354  If INVISIBLE-OK is non-nil, an invisible
354                      (outline-back-to-heading)                      (outline-back-to-heading)
355                    (error (outline-next-heading)))                    (error (outline-next-heading)))
356                  (if (eobp)                  (if (eobp)
357                      (or (cdar outline-level-heading) "")                      (or (caar outline-heading-alist) "")
358                    (match-string 0)))))                    (match-string 0)))))
359      (unless (or (string-match "[ \t]\\'" head)      (unless (or (string-match "[ \t]\\'" head)
360                  (not (string-match outline-regexp (concat head " "))))                  (not (string-match outline-regexp (concat head " "))))
# Line 363  If prefix argument CHILDREN is given, pr Line 372  If prefix argument CHILDREN is given, pr
372    (outline-back-to-heading)    (outline-back-to-heading)
373    (let* ((head (match-string 0))    (let* ((head (match-string 0))
374           (level (save-match-data (funcall outline-level)))           (level (save-match-data (funcall outline-level)))
375           (up-head (or (cdr (assoc head outline-level-heading))           (up-head (or (car (rassoc (1- level) outline-heading-alist))
                       (cdr (assoc (1- level) outline-level-heading))  
376                        (save-excursion                        (save-excursion
377                          (save-match-data                          (save-match-data
378                            (outline-up-heading 1 t)                            (outline-up-heading 1 t)
379                            (match-string 0))))))                            (match-string 0))))))
380            
381      (unless (assoc level outline-level-heading)      (unless (rassoc level outline-heading-alist)
382        (push (cons level head) outline-level-heading))        (push (cons head level) outline-heading-alist))
383    
384      (replace-match up-head nil t)      (replace-match up-head nil t)
385      (when children      (when children
# Line 385  If prefix argument CHILDREN is given, de Line 393  If prefix argument CHILDREN is given, de
393    (let* ((head (match-string 0))    (let* ((head (match-string 0))
394           (level (save-match-data (funcall outline-level)))           (level (save-match-data (funcall outline-level)))
395           (down-head           (down-head
396            (or (let ((x (car (rassoc head outline-level-heading))))            (or (car (rassoc (1+ level) outline-heading-alist))
                 (if (stringp x) x))  
               (cdr (assoc (1+ level) outline-level-heading))  
397                (save-excursion                (save-excursion
398                  (save-match-data                  (save-match-data
399                    (while (and (not (eobp))                    (while (and (not (eobp))
# Line 412  If prefix argument CHILDREN is given, de Line 418  If prefix argument CHILDREN is given, de
418                      ;; Didn't work: keep it as is so it's still a heading.                      ;; Didn't work: keep it as is so it's still a heading.
419                      head))))))                      head))))))
420    
421      (unless (assoc level outline-level-heading)      (unless (rassoc level outline-heading-alist)
422        (push (cons level head) outline-level-heading))        (push (cons head level) outline-heading-alist))
423            
424      (replace-match down-head nil t)      (replace-match down-head nil t)
425      (when children      (when children

Legend:
Removed from v.1.51  
changed lines
  Added in v.1.52

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