|
0
|
1 ;;; outl-mouse.el --- outline mode mouse commands for Emacs
|
|
|
2
|
|
|
3 ;; Copyright 1994 (C) Andy Piper <ajp@eng.cam.ac.uk>
|
|
|
4 ;; Keywords: outlines, mouse
|
|
|
5
|
|
|
6 ;; This file is part of XEmacs.
|
|
|
7
|
|
|
8 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
9 ;; under the terms of the GNU General Public License as published by
|
|
|
10 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
11 ;; any later version.
|
|
|
12
|
|
|
13 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
16 ;; General Public License for more details.
|
|
|
17
|
|
|
18 ;; You should have received a copy of the GNU General Public License
|
|
70
|
19 ;; along with XEmacs; see the file COPYING. If not, write to the
|
|
|
20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
21 ;; Boston, MA 02111-1307, USA.
|
|
0
|
22 ;;
|
|
|
23 ;; outl-mouse.el v1.3.8:
|
|
|
24 ;;
|
|
|
25 ;; Defines button one to hide blocks when clicked on outline-up-arrow
|
|
|
26 ;; and expand blocks when clicked on outline-down-arrow. Features are
|
|
|
27 ;; activated when outline-minor-mode or outline-mode are turned
|
|
|
28 ;; on. There is also a menu for each glyph on button 3.
|
|
|
29 ;;
|
|
|
30 ;; To use put:
|
|
|
31 ;; (require 'outl-mouse)
|
|
|
32 ;; in your .emacs file.
|
|
|
33 ;;
|
|
|
34 ;; If you use func-menu all the time and want outl-mouse on all the
|
|
|
35 ;; time as well then put:
|
|
|
36 ;; (setq outline-sync-with-func-menu t)
|
|
|
37 ;; outlining will then be turned on when func-menu is. Note that this
|
|
|
38 ;; requires a patch to func-menu 2.16 (in 19.10) to work:
|
|
|
39 ;;
|
|
|
40 ;RCS file: func-menu.el,v
|
|
|
41 ;retrieving revision 1.1
|
|
|
42 ;diff -r1.1 func-menu.el
|
|
|
43 ;180a181,183
|
|
|
44 ;> (defvar fume-found-function-hook nil
|
|
|
45 ;> "*Hook to call after every function match.")
|
|
|
46 ;>
|
|
|
47 ;1137,1138c1140,1142
|
|
|
48 ;< (if (listp funcname)
|
|
|
49 ;< (setq funclist (cons funcname funclist)))
|
|
|
50 ;---
|
|
|
51 ;> (cond ((listp funcname)
|
|
|
52 ;> (setq funclist (cons funcname funclist))
|
|
|
53 ;> (save-excursion (run-hooks 'fume-found-function-hook))))
|
|
|
54 ;;
|
|
|
55 ;; If you want mac-style outlining then set outline-mac-style to t.
|
|
|
56 ;; If you want the outline arrows on the left then set
|
|
|
57 ;; outline-glyphs-on-left to t. If you have xpm then arrows are much
|
|
|
58 ;; better defined.
|
|
|
59 ;;
|
|
|
60 ;; This package uses func-menu to define outline regexps if they are
|
|
|
61 ;; not already defined. You should no longer need to use out-xtra.
|
|
|
62 ;;
|
|
|
63 ;; You can define the package to do something other than outlining by
|
|
|
64 ;; setting outline-fold-in-function and outline-fold-out-function.
|
|
|
65 ;;
|
|
|
66 ;; You can define the color of outline arrows, but only in your .emacs.
|
|
|
67 ;;
|
|
|
68 ;; Only works in XEmacs 19.10 and onwards.
|
|
|
69 ;;
|
|
|
70 ;; User definable variables.
|
|
|
71 ;;
|
|
|
72
|
|
124
|
73 (defgroup outl-mouse nil
|
|
|
74 "Outline mouse mode commands for Emacs"
|
|
|
75 :prefix "outline-"
|
|
|
76 :group 'outlines
|
|
|
77 :group 'mouse)
|
|
|
78
|
|
|
79
|
|
|
80 (defcustom outline-mac-style nil
|
|
|
81 "*If t then outline glyphs will be right and down arrows."
|
|
|
82 :type 'boolean
|
|
|
83 :group 'outl-mouse)
|
|
0
|
84
|
|
124
|
85 (defcustom outline-glyphs-on-left nil
|
|
|
86 "*The position of outline glyphs on a line."
|
|
|
87 :type 'boolean
|
|
|
88 :group 'outl-mouse)
|
|
|
89
|
|
|
90 (defcustom outline-glyph-colour "Gray75"
|
|
|
91 "*The colour of outlining arrows."
|
|
|
92 :type 'color
|
|
|
93 :group 'outl-mouse)
|
|
0
|
94
|
|
124
|
95 (defcustom outline-glyph-shade-colour "Gray40"
|
|
|
96 "*The shadow colour of outlining arrows."
|
|
|
97 :type 'color
|
|
|
98 :group 'outl-mouse)
|
|
0
|
99
|
|
124
|
100 (defcustom outline-glyph-lit-colour "Gray90"
|
|
|
101 "*The lit colour of outlining arrows."
|
|
|
102 :type 'color
|
|
|
103 :group 'outl-mouse)
|
|
0
|
104
|
|
|
105 (defvar outline-fold-in-function 'outline-fold-in
|
|
|
106 "Function to call for folding in.
|
|
|
107 The function should take an annotation argument.")
|
|
|
108 (make-variable-buffer-local 'outline-fold-in-function)
|
|
|
109
|
|
|
110 (defvar outline-fold-out-function 'outline-fold-out
|
|
|
111 "Function to call for folding out.
|
|
|
112 The function should take an annotation argument.")
|
|
|
113 (make-variable-buffer-local 'outline-fold-out-function)
|
|
|
114
|
|
124
|
115 (defcustom outline-sync-with-func-menu nil
|
|
0
|
116 "*If t then outline glyphs are permanently added by func-menu scans.
|
|
|
117 If outline-minor-mode is turned off then turing it back on will have
|
|
|
118 no effect. Instead the buffer should be rescanned from the function
|
|
124
|
119 menu."
|
|
|
120 :type 'boolean
|
|
|
121 :group 'outl-mouse)
|
|
0
|
122
|
|
124
|
123 (defcustom outline-move-point-after-click t
|
|
|
124 "*If t then point is moved to the current heading when clicked."
|
|
|
125 :type 'boolean
|
|
|
126 :group 'outl-mouse)
|
|
0
|
127
|
|
124
|
128 (defcustom outline-scanning-message "Adding glyphs... (%3d%%)"
|
|
0
|
129 "*Progress message during the scanning of the buffer.
|
|
124
|
130 Set this to nil to inhibit progress messages."
|
|
|
131 :type 'string
|
|
|
132 :group 'outl-mouse)
|
|
0
|
133
|
|
|
134 ;;
|
|
|
135 ;; No user definable variables beyond this point.
|
|
|
136 ;;
|
|
120
|
137
|
|
|
138 ;; I'll bet there's a neat way to do this with specifiers -- a pity the
|
|
|
139 ;; sucks so badly on it. -sb
|
|
|
140 (defconst outline-up-arrow ; XEmacs
|
|
|
141 (make-glyph ; an up-arrow
|
|
|
142 (cond ((featurep 'xpm) (vector 'xpm :data (concat "/* XPM */
|
|
0
|
143 static char * arrow[] = {
|
|
|
144 \"10 10 5 1\",
|
|
|
145 \" c none\",
|
|
|
146 \". c " outline-glyph-lit-colour "\",
|
|
|
147 \"X c " outline-glyph-shade-colour "\",
|
|
|
148 \"o c " outline-glyph-colour "\",
|
|
|
149 \"O c " outline-glyph-shade-colour "\",
|
|
|
150 \" .X \",
|
|
|
151 \" .X \",
|
|
|
152 \" ..XX \",
|
|
|
153 \" ..XX \",
|
|
|
154 \" ..ooXX \",
|
|
|
155 \" ..ooXX \",
|
|
|
156 \" ..ooooXX \",
|
|
|
157 \" ..ooooXX \",
|
|
|
158 \"..OOOOOOXX\",
|
|
120
|
159 \"OOOOOOOOOO\"};")))
|
|
|
160 ((featurep 'x)
|
|
|
161 (vector 'xbm
|
|
|
162 :data
|
|
|
163 (list 10 10
|
|
|
164 (concat "\000\000\000\000\060\000\060\000\150\000"
|
|
|
165 "\150\000\324\000\324\000\376\001\376\001"))))
|
|
|
166 (t "^")))
|
|
0
|
167 "Bitmap object for outline up glyph.")
|
|
|
168
|
|
120
|
169 (defconst outline-up-arrow-mask ; XEmacs
|
|
|
170 (make-glyph ; an up-arrow
|
|
|
171 (cond ((featurep 'xpm) (vector 'xpm :data (concat "/* XPM */
|
|
0
|
172 static char * arrow[] = {
|
|
|
173 \"10 10 5 1\",
|
|
|
174 \" c none\",
|
|
|
175 \". c " outline-glyph-shade-colour "\",
|
|
|
176 \"X c " outline-glyph-lit-colour "\",
|
|
|
177 \"o c " outline-glyph-colour "\",
|
|
|
178 \"O c " outline-glyph-lit-colour "\",
|
|
|
179 \" .X \",
|
|
|
180 \" .X \",
|
|
|
181 \" ..XX \",
|
|
|
182 \" ..XX \",
|
|
|
183 \" ..ooXX \",
|
|
|
184 \" ..ooXX \",
|
|
|
185 \" ..ooooXX \",
|
|
|
186 \" ..ooooXX \",
|
|
|
187 \"..OOOOOOXX\",
|
|
120
|
188 \"OOOOOOOOOO\"};")))
|
|
|
189 ((featurep 'x)
|
|
|
190 (vector 'xbm
|
|
|
191 :data
|
|
|
192 (list 10 10
|
|
|
193 (concat "\000\000\000\000\060\000\060\000\130\000"
|
|
|
194 "\130\000\254\000\274\000\006\001\376\001"))))
|
|
|
195 (t "+")))
|
|
0
|
196 "Bitmap object for outline depressed up glyph.")
|
|
|
197
|
|
120
|
198 (defconst outline-down-arrow ; XEmacs
|
|
|
199 (make-glyph ; a down-arrow
|
|
|
200 (cond ((featurep 'xpm) (vector 'xpm :data (concat "/* XPM */
|
|
0
|
201 static char * down[] = {
|
|
|
202 \"10 10 5 1\",
|
|
|
203 \" c " outline-glyph-lit-colour "\",
|
|
|
204 \". c " outline-glyph-lit-colour "\",
|
|
|
205 \"X c " outline-glyph-shade-colour "\",
|
|
|
206 \"o c none\",
|
|
|
207 \"O c " outline-glyph-colour "\",
|
|
|
208 \" \",
|
|
|
209 \".. XX\",
|
|
|
210 \"o..OOOOXXo\",
|
|
|
211 \"o..OOOOXXo\",
|
|
|
212 \"oo..OOXXoo\",
|
|
|
213 \"oo..OOXXoo\",
|
|
|
214 \"ooo..XXooo\",
|
|
|
215 \"ooo..XXooo\",
|
|
|
216 \"oooo.Xoooo\",
|
|
120
|
217 \"oooo.Xoooo\"};")))
|
|
|
218 ((featurep 'x)
|
|
|
219 (vector 'xbm
|
|
|
220 :data
|
|
|
221 (list 10 10
|
|
|
222 (concat "\000\000\000\000\376\001\202\001\364\000"
|
|
|
223 "\324\000\150\000\150\000\060\000\060\000"))))
|
|
|
224 (t "v")))
|
|
0
|
225 "Bitmap object for outline down glyph.")
|
|
|
226
|
|
120
|
227 (defconst outline-down-arrow-mask ; XEmacs
|
|
|
228 (make-glyph ; a down-arrow
|
|
|
229 (cond ((featurep 'xpm) (vector 'xpm :data (concat "/* XPM */
|
|
0
|
230 static char * down[] = {
|
|
|
231 \"10 10 5 1\",
|
|
|
232 \" c " outline-glyph-shade-colour "\",
|
|
|
233 \". c " outline-glyph-shade-colour "\",
|
|
|
234 \"X c " outline-glyph-lit-colour "\",
|
|
|
235 \"o c none\",
|
|
|
236 \"O c " outline-glyph-colour "\",
|
|
|
237 \" \",
|
|
|
238 \".. XX\",
|
|
|
239 \"o..OOOOXXo\",
|
|
|
240 \"o..OOOOXXo\",
|
|
|
241 \"oo..OOXXoo\",
|
|
|
242 \"oo..OOXXoo\",
|
|
|
243 \"ooo..XXooo\",
|
|
|
244 \"ooo..XXooo\",
|
|
|
245 \"oooo.Xoooo\",
|
|
120
|
246 \"oooo.Xoooo\"};")))
|
|
|
247 ((featurep 'x)
|
|
|
248 (vector 'xbm
|
|
|
249 :data
|
|
|
250 (list 10 10
|
|
|
251 (concat "\000\000\000\000\376\001\376\001\254\000"
|
|
|
252 "\254\000\130\000\130\000\060\000\060\000"))))
|
|
|
253 (t "+")))
|
|
0
|
254 "Bitmap object for outline depressed down glyph.")
|
|
|
255
|
|
|
256 (defconst outline-right-arrow
|
|
120
|
257 (make-glyph ; a right-arrow
|
|
|
258 (cond ((featurep 'xpm) (vector 'xpm :data (concat "/* XPM */
|
|
0
|
259 static char * right[] = {
|
|
|
260 \"10 10 5 1\",
|
|
|
261 \" c " outline-glyph-lit-colour "\",
|
|
|
262 \". c " outline-glyph-lit-colour "\",
|
|
|
263 \"X c none\",
|
|
|
264 \"o c " outline-glyph-colour "\",
|
|
|
265 \"O c " outline-glyph-shade-colour "\",
|
|
|
266 \" .XXXXXXXX\",
|
|
|
267 \" ...XXXXXX\",
|
|
|
268 \" ....XXXX\",
|
|
|
269 \" oo....XX\",
|
|
|
270 \" oooo....\",
|
|
|
271 \" ooooOOOO\",
|
|
|
272 \" ooOOOOXX\",
|
|
|
273 \" OOOOXXXX\",
|
|
|
274 \" OOOXXXXXX\",
|
|
120
|
275 \" OXXXXXXXX\"};")))
|
|
|
276 ((featurep 'x)
|
|
|
277 (vector 'xbm
|
|
|
278 :data
|
|
|
279 (list 10 10
|
|
|
280 (concat "\000\000\006\000\032\000\142\000\232\001"
|
|
|
281 "\352\001\172\000\036\000\006\000\000\000"))))
|
|
|
282 (t ">")))
|
|
0
|
283 "Bitmap object for outline right glyph.")
|
|
|
284
|
|
|
285 (defconst outline-right-arrow-mask
|
|
120
|
286 (make-glyph ; a right-arrow
|
|
|
287 (cond ((featurep 'xpm) (vector 'xpm :data (concat "/* XPM */
|
|
0
|
288 static char * right[] = {
|
|
|
289 \"10 10 5 1\",
|
|
|
290 \" c " outline-glyph-shade-colour "\",
|
|
|
291 \". c " outline-glyph-shade-colour "\",
|
|
|
292 \"X c none\",
|
|
|
293 \"o c " outline-glyph-colour "\",
|
|
|
294 \"O c " outline-glyph-lit-colour "\",
|
|
|
295 \" .XXXXXXXX\",
|
|
|
296 \" ...XXXXXX\",
|
|
|
297 \" ....XXXX\",
|
|
|
298 \" oo....XX\",
|
|
|
299 \" oooo....\",
|
|
|
300 \" ooooOOOO\",
|
|
|
301 \" ooOOOOXX\",
|
|
|
302 \" OOOOXXXX\",
|
|
|
303 \" OOOXXXXXX\",
|
|
120
|
304 \" OXXXXXXXX\"};")))
|
|
|
305 ((featurep 'x)
|
|
|
306 (vector 'xbm
|
|
|
307 :data
|
|
|
308 (list 10 10
|
|
|
309 (concat "\000\000\006\000\036\000\176\000\346\001"
|
|
|
310 "\236\001\146\000\036\000\006\000\000\000"))))
|
|
|
311 (t "+")))
|
|
0
|
312 "Bitmap object for outline depressed right glyph.")
|
|
|
313
|
|
|
314 (defvar outline-glyph-menu
|
|
|
315 '("Outline Commands"
|
|
|
316 ["Hide all" hide-body t]
|
|
|
317 ["Hide all subtrees" hide-subtrees-same-level t]
|
|
74
|
318 ["Hide subtree" hide-subtree t]
|
|
|
319 ; ["Hide body" hide-body t]
|
|
70
|
320 "---"
|
|
74
|
321 ["Show all" show-all t]
|
|
0
|
322 ["Show subtree" show-subtree t]
|
|
|
323 ["Show body" show-entry t]
|
|
|
324 "---"
|
|
|
325 ["Update buffer" outline-add-glyphs t]
|
|
|
326 ["Rescan buffer" outline-rescan-buffer t])
|
|
|
327 "Menu of commands for outline glyphs.")
|
|
|
328
|
|
|
329 (set-pixmap-contributes-to-line-height outline-down-arrow nil)
|
|
|
330 (set-pixmap-contributes-to-line-height outline-up-arrow nil)
|
|
|
331 (set-pixmap-contributes-to-line-height outline-down-arrow-mask nil)
|
|
|
332 (set-pixmap-contributes-to-line-height outline-up-arrow-mask nil)
|
|
|
333 (set-pixmap-contributes-to-line-height outline-right-arrow nil)
|
|
|
334 (set-pixmap-contributes-to-line-height outline-right-arrow-mask nil)
|
|
|
335
|
|
|
336 (require 'annotations)
|
|
|
337 (require 'advice) ; help me doctor !
|
|
|
338 (require 'outline)
|
|
|
339 (require 'func-menu) ; for those most excellent regexps.
|
|
|
340
|
|
|
341 (add-hook 'outline-mode-hook 'outline-mouse-hooks)
|
|
|
342 (add-hook 'outline-minor-mode-hook 'outline-mouse-hooks)
|
|
|
343 ;; I thought this was done already ...
|
|
|
344 (make-variable-buffer-local 'outline-regexp)
|
|
|
345 (make-variable-buffer-local 'outline-level)
|
|
|
346
|
|
|
347 (cond (outline-sync-with-func-menu
|
|
|
348 (add-hook 'fume-found-function-hook 'outline-heading-add-glyph-1)
|
|
|
349 (setq-default fume-rescan-buffer-hook '(lambda ()
|
|
|
350 (outline-minor-mode 1)))))
|
|
|
351
|
|
|
352 (defadvice fume-set-defaults (after fume-set-defaults-ad activate)
|
|
|
353 "Advise fume-set-defaults to setup outline regexps."
|
|
|
354 (if (and (not (assq 'outline-regexp (buffer-local-variables)))
|
|
|
355 fume-function-name-regexp)
|
|
|
356 (progn
|
|
|
357 (setq outline-regexp (if (listp fume-function-name-regexp)
|
|
|
358 (car fume-function-name-regexp)
|
|
|
359 fume-function-name-regexp))
|
|
|
360 (setq outline-level '(lambda () 1)))))
|
|
|
361
|
|
|
362 (defadvice outline-minor-mode (after outline-mode-mouse activate)
|
|
|
363 "Advise outline-minor-mode to delete glyphs when switched off."
|
|
|
364 (if (not outline-minor-mode)
|
|
|
365 (progn
|
|
|
366 (outline-delete-glyphs)
|
|
|
367 (show-all))))
|
|
|
368
|
|
|
369 ;; advise all outline commands so that glyphs are synced after use
|
|
|
370 (defadvice show-all (after show-all-ad activate)
|
|
|
371 "Advise show-all to sync headings."
|
|
|
372 (outline-sync-visible-sub-headings-in-region (point-min) (point-max)))
|
|
|
373
|
|
|
374 (defadvice hide-subtree (after hide-subtree-ad activate)
|
|
|
375 "Advise hide-subtree to sync headings."
|
|
|
376 (outline-sync-visible-sub-headings))
|
|
|
377
|
|
|
378 (defadvice hide-entry (after hide-entry-ad activate)
|
|
|
379 "Advise hide-entry to sync headings."
|
|
|
380 (outline-sync-visible-sub-headings))
|
|
|
381
|
|
|
382 (defadvice hide-body (after hide-body-ad activate)
|
|
|
383 "Advise hide-body to sync headings."
|
|
|
384 (outline-sync-visible-sub-headings-in-region (point-min) (point-max)))
|
|
|
385
|
|
|
386 (defadvice show-subtree (after show-subtree-ad activate)
|
|
|
387 "Advise show-subtree to sync headings."
|
|
|
388 (outline-sync-visible-sub-headings))
|
|
|
389
|
|
|
390 (defadvice show-entry (after show-entry-ad activate)
|
|
|
391 "Advise shown-entry to sync headings."
|
|
|
392 (outline-sync-visible-sub-headings))
|
|
|
393
|
|
|
394 ;;;###autoload
|
|
|
395 (defun outl-mouse-mode ()
|
|
|
396 "Calls outline-mode, with outl-mouse extensions"
|
|
|
397 (interactive)
|
|
|
398 (outline-mode))
|
|
|
399
|
|
|
400 ;;;###autoload
|
|
|
401 (defun outl-mouse-minor-mode (&optional arg)
|
|
|
402 "Toggles outline-minor-mode, with outl-mouse extensions"
|
|
|
403 (interactive "P")
|
|
|
404 (outline-minor-mode arg))
|
|
|
405
|
|
|
406 (defun hide-subtrees-same-level ()
|
|
|
407 "Hide all subtrees below the current level."
|
|
|
408 (interactive)
|
|
|
409 (save-excursion
|
|
|
410 (while (progn
|
|
|
411 (hide-subtree)
|
|
|
412 (condition-case nil
|
|
|
413 (progn
|
|
|
414 (outline-forward-same-level 1)
|
|
|
415 t)
|
|
|
416 (error nil))))))
|
|
|
417
|
|
|
418 (defun outline-mouse-hooks ()
|
|
|
419 "Hook for installing outlining with the mouse."
|
|
|
420 ;; use function menu regexps if not set
|
|
|
421 (fume-set-defaults)
|
|
|
422 ;; only add glyphs when we're not synced.
|
|
|
423 (if (not outline-sync-with-func-menu) (outline-add-glyphs))
|
|
|
424 ;; add C-a to local keymap
|
|
|
425 (let ((outline (cond ((keymapp (lookup-key (current-local-map)
|
|
|
426 outline-minor-mode-prefix))
|
|
|
427 (lookup-key (current-local-map)
|
|
|
428 outline-minor-mode-prefix))
|
|
|
429 (t
|
|
|
430 (define-key (current-local-map)
|
|
|
431 outline-minor-mode-prefix (make-sparse-keymap))
|
|
|
432 (lookup-key (current-local-map)
|
|
|
433 outline-minor-mode-prefix)))))
|
|
|
434 (define-key outline "\C-a" 'outline-heading-add-glyph)
|
|
|
435 (define-key outline-mode-map "\C-c\C-a" 'outline-heading-add-glyph)))
|
|
|
436
|
|
|
437 (defun outline-add-glyphs ()
|
|
|
438 "Add annotations and glyphs to all heading lines that don't have them."
|
|
|
439 (interactive)
|
|
|
440 (save-excursion
|
|
193
|
441 (and outline-scanning-message (display-message
|
|
|
442 'progress
|
|
|
443 (format outline-scanning-message 0)))
|
|
0
|
444 (goto-char (point-min))
|
|
|
445 (if (not (outline-on-heading-p)) (outline-next-visible-heading-safe))
|
|
|
446 (while
|
|
|
447 (progn
|
|
|
448 (outline-heading-add-glyph-1)
|
|
|
449 (and outline-scanning-message
|
|
193
|
450 (display-message
|
|
|
451 'progress
|
|
|
452 (format outline-scanning-message (fume-relative-position))))
|
|
0
|
453 (outline-next-visible-heading-safe)))
|
|
|
454 (and outline-scanning-message
|
|
193
|
455 (display-message
|
|
|
456 'progress
|
|
|
457 (format "%s done" (format outline-scanning-message 100))))))
|
|
0
|
458
|
|
|
459 (defun outline-delete-glyphs ()
|
|
|
460 "Remove annotations and glyphs from heading lines."
|
|
|
461 (save-excursion
|
|
|
462 (mapcar 'outline-heading-delete-glyph (annotation-list))))
|
|
|
463
|
|
|
464 (defun outline-rescan-buffer ()
|
|
|
465 "Remove and insert all annotations."
|
|
|
466 (interactive)
|
|
|
467 (outline-delete-glyphs)
|
|
|
468 (outline-add-glyphs)
|
|
|
469 (save-excursion
|
|
|
470 (outline-sync-visible-sub-headings-in-region (point-min) (point-max))))
|
|
|
471
|
|
|
472 (defun outline-heading-delete-glyph (ext)
|
|
|
473 "Delete annotation and glyph from a heading with annotation EXT."
|
|
|
474 (if (and
|
|
|
475 (progn
|
|
|
476 (goto-char (extent-start-position ext))
|
|
|
477 (beginning-of-line)
|
|
|
478 (outline-on-heading-p))
|
|
|
479 (extent-property ext 'outline))
|
|
|
480 (delete-annotation ext))
|
|
|
481 nil)
|
|
|
482
|
|
|
483 (defun outline-heading-add-glyph ()
|
|
|
484 "Interactive version of outline-heading-add-glyph-1."
|
|
|
485 (interactive)
|
|
|
486 (save-excursion
|
|
|
487 (outline-heading-add-glyph-1)))
|
|
|
488
|
|
|
489 (defun outline-heading-add-glyph-1 ()
|
|
|
490 "Add glyph to the end of heading line which point is on.
|
|
|
491 Returns nil if point is not on a heading or glyph already exists."
|
|
|
492 (if (or (not (outline-on-heading-p))
|
|
|
493 (outline-heading-has-glyph-p)
|
|
|
494 (save-excursion (forward-line) (outline-on-heading-p)))
|
|
|
495 nil
|
|
|
496 (outline-back-to-heading)
|
|
|
497 (let ((anot2
|
|
|
498 (make-annotation (if outline-mac-style
|
|
|
499 outline-right-arrow
|
|
|
500 outline-down-arrow)
|
|
|
501 (save-excursion (if outline-glyphs-on-left nil
|
|
|
502 (outline-end-of-heading))
|
|
|
503 (point))
|
|
|
504 'text nil t
|
|
|
505 (if outline-mac-style
|
|
|
506 outline-right-arrow-mask
|
|
|
507 outline-down-arrow-mask)))
|
|
|
508 (anot1
|
|
|
509 (make-annotation (if outline-mac-style
|
|
|
510 outline-down-arrow
|
|
|
511 outline-up-arrow)
|
|
|
512 (save-excursion (if outline-glyphs-on-left nil
|
|
|
513 (outline-end-of-heading))
|
|
|
514 (point))
|
|
|
515 'text nil t
|
|
|
516 (if outline-mac-style
|
|
|
517 outline-down-arrow-mask
|
|
|
518 outline-up-arrow-mask))))
|
|
|
519 ;; we cunningly make the annotation data point to its twin.
|
|
|
520 (set-annotation-data anot1 anot2)
|
|
|
521 (set-extent-property anot1 'outline 'up)
|
|
|
522 (set-annotation-action anot1 'outline-up-click)
|
|
|
523 (set-annotation-menu anot1 outline-glyph-menu)
|
|
|
524 (set-extent-priority anot1 1)
|
|
|
525 (set-annotation-data anot2 anot1)
|
|
|
526 (set-extent-property anot2 'outline 'down)
|
|
|
527 (set-annotation-menu anot2 outline-glyph-menu)
|
|
|
528 (set-annotation-action anot2 'outline-down-click)
|
|
|
529 (annotation-hide anot2))
|
|
|
530 t))
|
|
|
531
|
|
|
532 (defun outline-heading-has-glyph-p ()
|
|
|
533 "Return t if heading has an outline glyph."
|
|
|
534 (catch 'found
|
|
|
535 (mapcar
|
|
|
536 '(lambda(a)
|
|
|
537 (if (extent-property a 'outline)
|
|
|
538 (throw 'found t)))
|
|
|
539 (annotations-in-region (save-excursion (outline-back-to-heading) (point))
|
|
|
540 (save-excursion (outline-end-of-heading)
|
|
|
541 (+ 1 (point)))
|
|
|
542 (current-buffer)))
|
|
|
543 nil))
|
|
|
544
|
|
|
545 (defun outline-sync-visible-sub-headings-in-region (pmin pmax)
|
|
|
546 "Make sure all anotations on headings in region PMIN PMAX are
|
|
|
547 displayed correctly."
|
|
|
548 (mapcar '(lambda (x)
|
|
|
549 (goto-char (extent-start-position x))
|
|
|
550 (beginning-of-line)
|
|
|
551 (cond ((and (eq (extent-property x 'outline) 'down)
|
|
|
552 ;; skip things we can't see
|
|
|
553 (not (eq (preceding-char) ?\^M)))
|
|
|
554 (if (outline-more-to-hide)
|
|
|
555 ;; reveal my twin
|
|
|
556 (annotation-reveal (annotation-data x))
|
|
|
557 (annotation-hide (annotation-data x)))
|
|
|
558 (if (not (outline-hidden-p))
|
|
|
559 ;; hide my self
|
|
|
560 (annotation-hide x)
|
|
|
561 (annotation-reveal x)))))
|
|
|
562 (annotations-in-region pmin pmax (current-buffer))))
|
|
|
563
|
|
|
564 (defun outline-sync-visible-sub-headings ()
|
|
|
565 "Make sure all anotations on sub-headings below the one point is on are
|
|
|
566 displayed correctly."
|
|
|
567 (outline-sync-visible-sub-headings-in-region
|
|
|
568 (point)
|
|
|
569 (progn (outline-end-of-subtree) (point))))
|
|
|
570
|
|
|
571 (defun outline-fold-out (annotation)
|
|
|
572 "Fold out the current heading."
|
|
|
573 (beginning-of-line)
|
|
|
574 ; (if (not (equal (condition-case nil
|
|
|
575 ; (save-excursion (outline-next-visible-heading 1)
|
|
|
576 ; (point))
|
|
|
577 ; (error nil))
|
|
|
578 ; (save-excursion (outline-next-heading)
|
|
|
579 ; (if (eobp) nil (point)))))
|
|
|
580 (if (save-excursion (outline-next-heading)
|
|
|
581 (eq (preceding-char) ?\^M))
|
|
|
582 (progn
|
|
|
583 (save-excursion (show-children))
|
|
|
584 (outline-sync-visible-sub-headings))
|
|
|
585 ;; mess with single entry
|
|
|
586 (if (outline-hidden-p)
|
|
|
587 (progn
|
|
|
588 (save-excursion (show-entry))
|
|
|
589 ;; reveal my twin and hide me
|
|
|
590 (annotation-hide annotation)
|
|
|
591 (annotation-reveal (annotation-data annotation))))))
|
|
|
592
|
|
|
593 (defun outline-fold-in (annotation)
|
|
|
594 "Fold in the current heading."
|
|
|
595 (beginning-of-line)
|
|
|
596 ;; mess with single entries
|
|
|
597 (if (not (outline-hidden-p))
|
|
|
598 (progn
|
|
|
599 (save-excursion (hide-entry))
|
|
|
600 (if (not (outline-more-to-hide))
|
|
|
601 (annotation-hide annotation))
|
|
|
602 (annotation-reveal (annotation-data annotation)))
|
|
|
603 ;; otherwise look for more leaves
|
|
|
604 (save-excursion
|
|
|
605 (if (outline-more-to-hide t)
|
|
|
606 (hide-subtree)
|
|
|
607 (hide-leaves)))
|
|
|
608 ;; sync everything
|
|
|
609 (outline-sync-visible-sub-headings)))
|
|
|
610
|
|
|
611 (defun outline-more-to-hide (&optional arg)
|
|
|
612 "Return t if there are more visible sub-headings or text.
|
|
|
613 With ARG return t only if visible sub-headings have no visible text."
|
|
|
614 (if (not (outline-hidden-p))
|
|
|
615 (if arg nil t)
|
|
|
616 (save-excursion
|
|
|
617 (and (< (funcall outline-level) (condition-case nil
|
|
|
618 (progn
|
|
|
619 (outline-next-visible-heading 1)
|
|
|
620 (funcall outline-level))
|
|
|
621 (error 0)))
|
|
|
622 (if (and (not (outline-hidden-p)) arg)
|
|
|
623 nil t)))))
|
|
|
624
|
|
|
625 (defun outline-hidden-p ()
|
|
|
626 "Return t if point is on the header of a hidden subtree."
|
|
|
627 (save-excursion
|
|
|
628 (let ((end-of-entry (save-excursion (outline-next-heading))))
|
|
|
629 ;; Make sure that the end of the entry really exists.
|
|
|
630 (if (not end-of-entry)
|
|
|
631 (setq end-of-entry (point-max)))
|
|
|
632 (outline-back-to-heading)
|
|
|
633 ;; If there are ANY ^M's, the entry is hidden.
|
|
|
634 (search-forward "\^M" end-of-entry t))))
|
|
|
635
|
|
|
636 (defun outline-next-visible-heading-safe ()
|
|
|
637 "Safely go to the next visible heading.
|
|
|
638 nil is returned if there is none."
|
|
|
639 (condition-case nil
|
|
|
640 (progn
|
|
|
641 (outline-next-visible-heading 1)
|
|
|
642 t)
|
|
|
643 (error nil)))
|
|
|
644
|
|
|
645 (defun outline-up-click (data ev)
|
|
|
646 "Annotation action for clicking on an up arrow.
|
|
|
647 DATA is the annotation data. EV is the mouse click event."
|
|
|
648 (save-excursion
|
|
|
649 (goto-char (extent-end-position (event-glyph-extent ev)))
|
|
|
650 (funcall outline-fold-in-function (event-glyph-extent ev)))
|
|
|
651 (if outline-move-point-after-click
|
|
|
652 (progn
|
|
|
653 (goto-char (extent-end-position (event-glyph-extent ev)))
|
|
|
654 (beginning-of-line))))
|
|
|
655 ; This line demonstrates a bug in redisplay
|
|
|
656 (defun outline-down-click (data ev)
|
|
|
657 "Annotation action for clicking on a down arrow.
|
|
|
658 DATA is the annotation data. EV is the mouse click event."
|
|
|
659 (save-excursion
|
|
|
660 (goto-char (extent-end-position (event-glyph-extent ev)))
|
|
|
661 (funcall outline-fold-out-function (event-glyph-extent ev)))
|
|
|
662 (if outline-move-point-after-click
|
|
|
663 (progn
|
|
|
664 (goto-char (extent-end-position (event-glyph-extent ev)))
|
|
|
665 (beginning-of-line))))
|
|
|
666
|
|
|
667
|
|
|
668 (provide 'outl-mouse)
|
|
|
669 (provide 'outln-18) ; fool auctex - outline is ok now.
|
|
|
670
|
|
|
671 ;; Local Variables:
|
|
|
672 ;; outline-regexp: ";;; \\|(def.."
|
|
|
673 ;; End:
|
|
|
674
|
|
|
675
|
|
|
676
|
