Mercurial > emacs
comparison lisp/textmodes/outline.el @ 47735:0d2e42a6fd1c
(outline-1, outline-2, outline-3, outline-4)
(outline-5, outline-6, outline-7, outline-8): New faces.
(outline-font-lock-faces, outline-font-lock-levels): New vars.
(outline-font-lock-face): New fun.
(outline-font-lock-keywords): Use it.
(outline-font-lock-level): Remove.
(outline-mode, outline-next-preface, outline-next-heading)
(outline-previous-heading, outline-next-visible-heading):
Use shy group.
(outline-level) <var>: Update calling convention.
(outline-level) <fun>: Take advantage of it.
(outline-demote): Don't assume the match-data is still uptodate.
(outline-up-heading): Simplify and make sure the match data is
properly set at the end.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Wed, 02 Oct 2002 22:04:42 +0000 |
parents | 5d3b861665f0 |
children | c392f8b359aa |
comparison
equal
deleted
inserted
replaced
47734:4d0401ba4eae | 47735:0d2e42a6fd1c |
---|---|
148 map)) | 148 map)) |
149 | 149 |
150 (defvar outline-font-lock-keywords | 150 (defvar outline-font-lock-keywords |
151 '(;; | 151 '(;; |
152 ;; Highlight headings according to the level. | 152 ;; Highlight headings according to the level. |
153 (eval . (list (concat "^" outline-regexp ".+") | 153 (eval . (list (concat "^\\(?:" outline-regexp "\\).+") |
154 0 '(or (cdr (assq (outline-font-lock-level) | 154 0 '(outline-font-lock-face) nil t))) |
155 ;; FIXME: this is silly! | |
156 '((1 . font-lock-function-name-face) | |
157 (2 . font-lock-variable-name-face) | |
158 (3 . font-lock-keyword-face) | |
159 (4 . font-lock-builtin-face) | |
160 (5 . font-lock-comment-face) | |
161 (6 . font-lock-constant-face) | |
162 (7 . font-lock-type-face) | |
163 (8 . font-lock-string-face)))) | |
164 font-lock-warning-face) | |
165 nil t))) | |
166 "Additional expressions to highlight in Outline mode.") | 155 "Additional expressions to highlight in Outline mode.") |
167 | 156 |
168 (defun outline-font-lock-level () | 157 (defface outline-1 '((t :inherit font-lock-function-name-face)) "Level 1.") |
169 (let ((count 1)) | 158 (defface outline-2 '((t :inherit font-lock-variable-name-face)) "Level 2.") |
170 (save-excursion | 159 (defface outline-3 '((t :inherit font-lock-keyword-face)) "Level 3.") |
171 (outline-back-to-heading t) | 160 (defface outline-4 '((t :inherit font-lock-builtin-face)) "Level 4.") |
172 (while (and (not (bobp)) | 161 (defface outline-5 '((t :inherit font-lock-comment-face)) "Level 5.") |
173 (not (eq (funcall outline-level) 1))) | 162 (defface outline-6 '((t :inherit font-lock-constant-face)) "Level 6.") |
174 (outline-up-heading 1 t) | 163 (defface outline-7 '((t :inherit font-lock-type-face)) "Level 7.") |
175 (setq count (1+ count))) | 164 (defface outline-8 '((t :inherit font-lock-string-face)) "Level 8.") |
176 count))) | 165 |
166 (defvar outline-font-lock-faces | |
167 [outline-1 outline-2 outline-3 outline-4 | |
168 outline-5 outline-6 outline-7 outline-8]) | |
169 | |
170 (defvar outline-font-lock-levels nil) | |
171 (make-variable-buffer-local 'outline-font-lock-levels) | |
172 | |
173 (defun outline-font-lock-face () | |
174 ;; (save-excursion | |
175 ;; (outline-back-to-heading t) | |
176 ;; (let* ((count 0) | |
177 ;; (start-level (funcall outline-level)) | |
178 ;; (level start-level) | |
179 ;; face-level) | |
180 ;; (while (not (setq face-level | |
181 ;; (if (or (bobp) (eq level 1)) 0 | |
182 ;; (cdr (assq level outline-font-lock-levels))))) | |
183 ;; (outline-up-heading 1 t) | |
184 ;; (setq count (1+ count)) | |
185 ;; (setq level (funcall outline-level))) | |
186 ;; ;; Remember for later. | |
187 ;; (unless (zerop count) | |
188 ;; (setq face-level (+ face-level count)) | |
189 ;; (push (cons start-level face-level) outline-font-lock-levels)) | |
190 ;; (condition-case nil | |
191 ;; (aref outline-font-lock-faces face-level) | |
192 ;; (error font-lock-warning-face)))) | |
193 (save-excursion | |
194 (goto-char (match-beginning 0)) | |
195 (looking-at outline-regexp) | |
196 (condition-case nil | |
197 (aref outline-font-lock-faces (1- (funcall outline-level))) | |
198 (error font-lock-warning-face)))) | |
177 | 199 |
178 (defvar outline-view-change-hook nil | 200 (defvar outline-view-change-hook nil |
179 "Normal hook to be run after outline visibility changes.") | 201 "Normal hook to be run after outline visibility changes.") |
180 | 202 |
181 ;;;###autoload | 203 ;;;###autoload |
221 (make-local-variable 'line-move-ignore-invisible) | 243 (make-local-variable 'line-move-ignore-invisible) |
222 (setq line-move-ignore-invisible t) | 244 (setq line-move-ignore-invisible t) |
223 ;; Cause use of ellipses for invisible text. | 245 ;; Cause use of ellipses for invisible text. |
224 (add-to-invisibility-spec '(outline . t)) | 246 (add-to-invisibility-spec '(outline . t)) |
225 (set (make-local-variable 'paragraph-start) | 247 (set (make-local-variable 'paragraph-start) |
226 (concat paragraph-start "\\|\\(" outline-regexp "\\)")) | 248 (concat paragraph-start "\\|\\(?:" outline-regexp "\\)")) |
227 ;; Inhibit auto-filling of header lines. | 249 ;; Inhibit auto-filling of header lines. |
228 (set (make-local-variable 'auto-fill-inhibit-regexp) outline-regexp) | 250 (set (make-local-variable 'auto-fill-inhibit-regexp) outline-regexp) |
229 (set (make-local-variable 'paragraph-separate) | 251 (set (make-local-variable 'paragraph-separate) |
230 (concat paragraph-separate "\\|\\(" outline-regexp "\\)")) | 252 (concat paragraph-separate "\\|\\(?:" outline-regexp "\\)")) |
231 (set (make-local-variable 'font-lock-defaults) | 253 (set (make-local-variable 'font-lock-defaults) |
232 '(outline-font-lock-keywords t nil nil backward-paragraph)) | 254 '(outline-font-lock-keywords t nil nil backward-paragraph)) |
233 (setq imenu-generic-expression | 255 (setq imenu-generic-expression |
234 (list (list nil (concat "^\\(?:" outline-regexp "\\).*$") 0))) | 256 (list (list nil (concat "^\\(?:" outline-regexp "\\).*$") 0))) |
235 (add-hook 'change-major-mode-hook 'show-all nil t)) | 257 (add-hook 'change-major-mode-hook 'show-all nil t)) |
263 ;; When turning off outline mode, get rid of any outline hiding. | 285 ;; When turning off outline mode, get rid of any outline hiding. |
264 (show-all))) | 286 (show-all))) |
265 | 287 |
266 (defcustom outline-level 'outline-level | 288 (defcustom outline-level 'outline-level |
267 "*Function of no args to compute a header's nesting level in an outline. | 289 "*Function of no args to compute a header's nesting level in an outline. |
268 It can assume point is at the beginning of a header line." | 290 It can assume point is at the beginning of a header line and that the match |
291 data reflects the `outline-regexp'." | |
269 :type 'function | 292 :type 'function |
270 :group 'outlines) | 293 :group 'outlines) |
271 | 294 |
272 (defvar outline-heading-alist () | 295 (defvar outline-heading-alist () |
273 "Alist associating a heading for every possible level. | 296 "Alist associating a heading for every possible level. |
284 (defun outline-level () | 307 (defun outline-level () |
285 "Return the depth to which a statement is nested in the outline. | 308 "Return the depth to which a statement is nested in the outline. |
286 Point must be at the beginning of a header line. | 309 Point must be at the beginning of a header line. |
287 This is actually either the level specified in `outline-heading-alist' | 310 This is actually either the level specified in `outline-heading-alist' |
288 or else the number of characters matched by `outline-regexp'." | 311 or else the number of characters matched by `outline-regexp'." |
289 (save-excursion | 312 (or (cdr (assoc (match-string 0) outline-heading-alist)) |
290 (if (not (looking-at outline-regexp)) | 313 (- (match-end 0) (match-beginning 0)))) |
291 ;; This should never happen | |
292 1000 | |
293 (or (cdr (assoc (match-string 0) outline-heading-alist)) | |
294 (- (match-end 0) (match-beginning 0)))))) | |
295 | 314 |
296 (defun outline-next-preface () | 315 (defun outline-next-preface () |
297 "Skip forward to just before the next heading line. | 316 "Skip forward to just before the next heading line. |
298 If there's no following heading line, stop before the newline | 317 If there's no following heading line, stop before the newline |
299 at the end of the buffer." | 318 at the end of the buffer." |
300 (if (re-search-forward (concat "\n\\(" outline-regexp "\\)") | 319 (if (re-search-forward (concat "\n\\(?:" outline-regexp "\\)") |
301 nil 'move) | 320 nil 'move) |
302 (goto-char (match-beginning 0))) | 321 (goto-char (match-beginning 0))) |
303 (if (and (bolp) (not (bobp))) | 322 (if (and (bolp) (not (bobp))) |
304 (forward-char -1))) | 323 (forward-char -1))) |
305 | 324 |
306 (defun outline-next-heading () | 325 (defun outline-next-heading () |
307 "Move to the next (possibly invisible) heading line." | 326 "Move to the next (possibly invisible) heading line." |
308 (interactive) | 327 (interactive) |
309 (if (re-search-forward (concat "\n\\(" outline-regexp "\\)") | 328 (if (re-search-forward (concat "\n\\(?:" outline-regexp "\\)") |
310 nil 'move) | 329 nil 'move) |
311 (goto-char (1+ (match-beginning 0))))) | 330 (goto-char (1+ (match-beginning 0))))) |
312 | 331 |
313 (defun outline-previous-heading () | 332 (defun outline-previous-heading () |
314 "Move to the previous (possibly invisible) heading line." | 333 "Move to the previous (possibly invisible) heading line." |
315 (interactive) | 334 (interactive) |
316 (re-search-backward (concat "^\\(" outline-regexp "\\)") | 335 (re-search-backward (concat "^\\(?:" outline-regexp "\\)") |
317 nil 'move)) | 336 nil 'move)) |
318 | 337 |
319 (defsubst outline-invisible-p () | 338 (defsubst outline-invisible-p () |
320 "Non-nil if the character after point is invisible." | 339 "Non-nil if the character after point is invisible." |
321 (get-char-property (point) 'invisible)) | 340 (get-char-property (point) 'invisible)) |
329 (beginning-of-line) | 348 (beginning-of-line) |
330 (or (outline-on-heading-p invisible-ok) | 349 (or (outline-on-heading-p invisible-ok) |
331 (let (found) | 350 (let (found) |
332 (save-excursion | 351 (save-excursion |
333 (while (not found) | 352 (while (not found) |
334 (or (re-search-backward (concat "^\\(" outline-regexp "\\)") | 353 (or (re-search-backward (concat "^\\(?:" outline-regexp "\\)") |
335 nil t) | 354 nil t) |
336 (error "before first heading")) | 355 (error "before first heading")) |
337 (setq found (and (or invisible-ok (not (outline-invisible-p))) | 356 (setq found (and (or invisible-ok (not (outline-invisible-p))) |
338 (point))))) | 357 (point))))) |
339 (goto-char found) | 358 (goto-char found) |
406 (goto-char (point-min)) | 425 (goto-char (point-min)) |
407 (while (and (not (eobp)) | 426 (while (and (not (eobp)) |
408 (progn | 427 (progn |
409 (outline-next-heading) | 428 (outline-next-heading) |
410 (<= (funcall outline-level) level))))) | 429 (<= (funcall outline-level) level))))) |
411 (unless (eobp) (match-string 0)))) | 430 (unless (eobp) |
431 (looking-at outline-regexp) | |
432 (match-string 0)))) | |
412 (save-match-data | 433 (save-match-data |
413 ;; Bummer!! There is no lower heading in the buffer. | 434 ;; Bummer!! There is no lower heading in the buffer. |
414 ;; Let's try to invent one by repeating the first char. | 435 ;; Let's try to invent one by repeating the first char. |
415 (let ((new-head (concat (substring head 0 1) head))) | 436 (let ((new-head (concat (substring head 0 1) head))) |
416 (if (string-match (concat "\\`" outline-regexp) new-head) | 437 (if (string-match (concat "\\`" outline-regexp) new-head) |
448 (if (< arg 0) | 469 (if (< arg 0) |
449 (beginning-of-line) | 470 (beginning-of-line) |
450 (end-of-line)) | 471 (end-of-line)) |
451 (while (and (not (bobp)) (< arg 0)) | 472 (while (and (not (bobp)) (< arg 0)) |
452 (while (and (not (bobp)) | 473 (while (and (not (bobp)) |
453 (re-search-backward (concat "^\\(" outline-regexp "\\)") | 474 (re-search-backward (concat "^\\(?:" outline-regexp "\\)") |
454 nil 'move) | 475 nil 'move) |
455 (outline-invisible-p))) | 476 (outline-invisible-p))) |
456 (setq arg (1+ arg))) | 477 (setq arg (1+ arg))) |
457 (while (and (not (eobp)) (> arg 0)) | 478 (while (and (not (eobp)) (> arg 0)) |
458 (while (and (not (eobp)) | 479 (while (and (not (eobp)) |
459 (re-search-forward (concat "^\\(" outline-regexp "\\)") | 480 (re-search-forward (concat "^\\(?:" outline-regexp "\\)") |
460 nil 'move) | 481 nil 'move) |
461 (outline-invisible-p))) | 482 (outline-invisible-p))) |
462 (setq arg (1- arg))) | 483 (setq arg (1- arg))) |
463 (beginning-of-line)) | 484 (beginning-of-line)) |
464 | 485 |
734 "Move to the visible heading line of which the present line is a subheading. | 755 "Move to the visible heading line of which the present line is a subheading. |
735 With argument, move up ARG levels. | 756 With argument, move up ARG levels. |
736 If INVISIBLE-OK is non-nil, also consider invisible lines." | 757 If INVISIBLE-OK is non-nil, also consider invisible lines." |
737 (interactive "p") | 758 (interactive "p") |
738 (outline-back-to-heading invisible-ok) | 759 (outline-back-to-heading invisible-ok) |
739 (if (eq (funcall outline-level) 1) | 760 (let ((start-level (funcall outline-level))) |
740 (error "Already at top level of the outline")) | 761 (if (eq start-level 1) |
741 (while (and (> (funcall outline-level) 1) | 762 (error "Already at top level of the outline")) |
742 (> arg 0) | 763 (while (and (> start-level 1) (> arg 0) (not (bobp))) |
743 (not (bobp))) | 764 (let ((level start-level)) |
744 (let ((present-level (funcall outline-level))) | 765 (while (not (or (< level start-level) (bobp))) |
745 (while (and (not (< (funcall outline-level) present-level)) | 766 (if invisible-ok |
746 (not (bobp))) | 767 (outline-previous-heading) |
747 (if invisible-ok | 768 (outline-previous-visible-heading 1)) |
748 (outline-previous-heading) | 769 (setq level (funcall outline-level))) |
749 (outline-previous-visible-heading 1))) | 770 (setq start-level level)) |
750 (setq arg (- arg 1))))) | 771 (setq arg (- arg 1)))) |
772 (looking-at outline-regexp)) | |
751 | 773 |
752 (defun outline-forward-same-level (arg) | 774 (defun outline-forward-same-level (arg) |
753 "Move forward to the ARG'th subheading at same level as this one. | 775 "Move forward to the ARG'th subheading at same level as this one. |
754 Stop at the first and last subheadings of a superior heading." | 776 Stop at the first and last subheadings of a superior heading." |
755 (interactive "p") | 777 (interactive "p") |