Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/kotl/kvspec.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 4103f0995bd7
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;!emacs
2 ;;
3 ;; FILE: kvspec.el
4 ;; SUMMARY: Koutline view specification.
5 ;; USAGE: GNU Emacs Lisp Library
6 ;; KEYWORDS: outlines, wp
7 ;;
8 ;; AUTHOR: Bob Weiner
9 ;;
10 ;; ORIG-DATE: 21-Oct-95 at 15:17:07
11 ;; LAST-MOD: 3-Nov-95 at 19:44:10 by Bob Weiner
12 ;;
13 ;; This file is part of Hyperbole.
14 ;; Available for use and distribution under the same terms as GNU Emacs.
15 ;;
16 ;; Copyright (C) 1995, Free Software Foundation, Inc.
17 ;; Developed with support from Motorola Inc.
18 ;;
19 ;; DESCRIPTION:
20 ;;
21 ;;; Koutliner view specs
22 ;; + means support code has been written already.
23 ;;
24 ;; + all: Show all lines of cells and all cells in the outline.
25 ;; + blank: Blank lines are on.
26 ;; b - on
27 ;; + cutoff: Show only NUM lines per cell, 0 = all
28 ;; c - set default cutoff lines
29 ;; cNUM - set cutoff lines to NUM
30 ;; descend: Only entries below this entry
31 ;; + elide: Ellipses are on.
32 ;; e - ellipses on
33 ;; filter: Regexp or filter program to select entries for view,
34 ;; off=select non-matching entries
35 ;; glue: Freeze any group of entries selected to stay at top of
36 ;; window, off=freeze those not-in-group.
37 ;; include: Include an entry referenced by a link.
38 ;; + level: Some levels are hidden.
39 ;; l - set default level clipping
40 ;; lNUM - set level clipping to NUM
41 ;; name: Display leading names within cells.
42 ;; m - show names
43 ;; + number: Cell numbers are on
44 ;; n - set default labels
45 ;; n0 - display idstamp labels
46 ;; n1 - display alpha labels
47 ;; n2 - display partial alpha labels
48 ;; n. - display legal labels
49 ;; n* - display star labels
50 ;; n~ - turn off labels
51 ;; rest: Only following cells.
52 ;; synthesize: Use a named generator function to generate entries for
53 ;; view.
54 ;; view: Turn koutliner view mode on. Standard insertion keys then
55 ;; can be used for browsing and view setting.
56 ;;
57 ;; DESCRIP-END.
58
59 ;;; ************************************************************************
60 ;;; Other required Elisp libraries
61 ;;; ************************************************************************
62
63 (require 'kview)
64
65 ;;; ************************************************************************
66 ;;; Public variables
67 ;;; ************************************************************************
68
69 (defvar kvspec:current nil
70 "String that represents the current view spec.
71 It is local to each koutline. Nil value means it has not been set yet.")
72
73 ;;; ************************************************************************
74 ;;; Public functions
75 ;;; ************************************************************************
76
77 (defun kvspec:activate (&optional view-spec)
78 "Activate optional VIEW-SPEC or existing view spec in the current koutline.
79 VIEW-SPEC is a string or t, which means recompute the current view spec. See
80 <${hyperb:dir}/kotl/EXAMPLE.kotl, 2b17=048> for details on valid view specs."
81 (interactive (list (read-string "Set view spec: " kvspec:current)))
82 (kotl-mode:is-p)
83 (if (or (equal view-spec "") (equal view-spec kvspec:current))
84 (setq view-spec nil))
85 (kvspec:initialize)
86 (kvspec:update view-spec)
87 (kvspec:update-view))
88
89 (defun kvspec:initialize ()
90 "Ensure that view spec settings will be local to the current buffer."
91 (if (and (fboundp 'local-variable-p)
92 (local-variable-p 'kvspec:current (current-buffer)))
93 nil
94 (make-local-variable 'kvspec:current)
95 (make-local-variable 'kvspec:string)))
96
97 (defun kvspec:levels-to-show (levels-to-keep)
98 "Hide all cells in outline at levels deeper than LEVELS-TO-KEEP (a number).
99 Shows any hidden cells within LEVELS-TO-KEEP. 1 is the first level. 0 means
100 display all levels of cells."
101 (if (null levels-to-keep)
102 (setq levels-to-keep
103 (read-from-minibuffer "Show cells down to level (0 = show all levels): "
104 nil nil t)))
105 (setq levels-to-keep (prefix-numeric-value levels-to-keep))
106 (if (< levels-to-keep 0)
107 (error "(kvspec:levels-to-show): Must display at least one level."))
108 (kview:map-tree
109 (function (lambda (kview)
110 (if (/= (kcell-view:level) levels-to-keep)
111 (kotl-mode:show-tree)
112 (kotl-mode:hide-subtree)
113 ;; Move to last cell in hidden subtree, to skip further
114 ;; processing of these cells.
115 (if (kcell-view:next t)
116 (kcell-view:previous)
117 (goto-char (point-max))))))
118 kview t)
119 (kview:set-attr kview 'levels-to-show levels-to-keep))
120
121 (defun kvspec:show-lines-per-cell (num)
122 "Show NUM lines per cell."
123 (if (and (integerp num) (>= num 0))
124 nil
125 (error "(kvspec:show-lines-per-cell): Invalid lines per cell, '%d'" num))
126 (kview:set-attr kview 'lines-to-show num)
127 (let (start end count)
128 (if (zerop num)
129 ;; Show all lines in cells.
130 (kview:map-tree
131 (function
132 (lambda (kview)
133 ;; Use free variable label-sep-len bound in kview:map-tree for
134 ;; speed.
135 (setq start (goto-char (kcell-view:start nil label-sep-len))
136 end (kcell-view:end-contents))
137 ;; Show all lines in cell.
138 (subst-char-in-region start end ?\r ?\n t)))
139 kview t t)
140 ;; Show NUM lines in cells.
141 (kview:map-tree
142 (function
143 (lambda (kview)
144 ;; Use free variable label-sep-len bound in kview:map-tree for speed.
145 (setq start (goto-char (kcell-view:start nil label-sep-len))
146 end (kcell-view:end-contents)
147 count (1- num))
148 ;; Hide all lines in cell.
149 (subst-char-in-region start end ?\n ?\r t)
150 ;; Expand num - 1 newlines to show num lines.
151 (while (and (> count 0) (search-forward "\r" end t))
152 (replace-match "\n") (setq count (1- count)))))
153 kview t t))))
154
155 (defun kvspec:toggle-blank-lines ()
156 "Toggle blank lines between cells on or off."
157 (interactive)
158 (setq kvspec:current
159 (if (string-match "b" kvspec:current)
160 (hypb:replace-match-string "b" kvspec:current "" t)
161 (concat "b" kvspec:current)))
162 (kvspec:blank-lines)
163 (kvspec:update-modeline))
164
165 (defun kvspec:update (view-spec)
166 "Update current view spec according to VIEW-SPEC but don't change the view.
167 VIEW-SPEC is a string or t, which means recompute the current view spec. See
168 <${hyperb:dir}/kotl/EXAMPLE.kotl, 2b17=048> for details on valid view specs."
169 (cond ((stringp view-spec)
170 ;; Use given view-spec after removing extraneous characters.
171 (setq kvspec:current
172 (hypb:replace-match-string
173 "[^.*~0-9abcdefgilnrsv]+" view-spec "" t)))
174 ((or (eq view-spec t) (null kvspec:current))
175 (setq kvspec:current (kvspec:compute))))
176 ;; Update display using current specs.
177 (kvspec:update-modeline))
178
179 ;;; ************************************************************************
180 ;;; Private functions
181 ;;; ************************************************************************
182
183 (defun kvspec:blank-lines ()
184 "Turn blank lines on or off according to 'kvspec:current'."
185 (let ((modified-p (buffer-modified-p))
186 (buffer-read-only))
187 (if (string-match "b" kvspec:current)
188 ;; On
189 (progn (kview:set-attr kview 'blank-lines t)
190 (kproperty:remove (point-min) (point-max) '(invisible t)))
191 ;; Off
192 (kview:set-attr kview 'blank-lines nil)
193 (save-excursion
194 (goto-char (point-max))
195 (while (re-search-backward "[\n\r][\n\r]" nil t)
196 ;; Make blank lines invisible.
197 (kproperty:put (1+ (point)) (min (+ (point) 2) (point-max))
198 '(invisible t)))))
199 (set-buffer-modified-p modified-p)))
200
201 (defun kvspec:compute ()
202 "Compute and return current view spec string."
203 (concat
204
205 ;; a - Show all cells and cell lines.
206 ;; Never compute this setting (use it only within links) since it will
207 ;; expose all carefully hidden outline items if the user forgets to turn
208 ;; it off when he resets the view specs.
209
210 ;; b - blank separator lines
211 (if (kview:get-attr kview 'blank-lines) "b")
212
213 ;; c - cutoff lines per cell
214 (let ((lines (kview:get-attr kview 'lines-to-show)))
215 (if (zerop lines)
216 nil
217 (concat "c" (int-to-string lines))))
218
219 ;; e - ellipses on
220 (if selective-display-ellipses "e")
221
222 ;; l - hide some levels
223 (let ((levels (kview:get-attr kview 'levels-to-show)))
224 (if (zerop levels)
225 nil
226 (concat "l" (int-to-string levels))))
227
228 ;; n - numbering type
229 (let ((type (kview:label-type kview)))
230 (cond ((eq type 'no) nil)
231 ((eq type kview:default-label-type) "n")
232 (t (concat "n" (char-to-string
233 (car (rassq (kview:label-type kview)
234 kvspec:label-type-alist)))))))))
235
236 (defun kvspec:elide ()
237 "Turn ellipses display following clipped cells on or off according to 'kvspec:current'."
238 (setq selective-display-ellipses
239 (if (string-match "e" kvspec:current) t)))
240
241 (defun kvspec:hide-levels ()
242 "Show a set number of cell levels according to 'kvspec:current'."
243 ;; "l" means use value of kview:default-levels-to-show.
244 ;; "l0" means show all levels.
245 (let (levels)
246 (if (not (string-match "l\\([0-9]+\\)?" kvspec:current))
247 ;; Don't change the view if no view spec is given but note that
248 ;; all levels should be shown in the future.
249 (kview:set-attr kview 'levels-to-show 0)
250 (if (match-beginning 1)
251 (setq levels (string-to-int
252 (substring kvspec:current (match-beginning 1)
253 (match-end 1))))
254 (setq levels kview:default-levels-to-show))
255 (kview:set-attr kview 'levels-to-show levels)
256 (kvspec:levels-to-show levels))))
257
258 (defun kvspec:lines-to-show ()
259 "Show a set number of lines per cell according to 'kvspec:current'."
260 ;; "c" means use value of kview:default-lines-to-show.
261 ;; "c0" means show all lines.
262 (cond ((not (string-match "c\\([0-9]+\\)?" kvspec:current))
263 ;; Don't change the view if no view spec is given but note that all
264 ;; lines should be shown in the future.
265 (kview:set-attr kview 'lines-to-show 0))
266 ((match-beginning 1)
267 (kvspec:show-lines-per-cell
268 (string-to-int (substring kvspec:current (match-beginning 1)
269 (match-end 1)))))
270 (t (kvspec:show-lines-per-cell kview:default-lines-to-show))))
271
272 (defun kvspec:numbering ()
273 "Set the type of numbering (label) display according to 'kvspec:current'."
274 (if (not (string-match "n\\([.*~0-2]\\)?" kvspec:current))
275 nil
276 ;; "n" means use value of kview:default-label-type.
277 ;; "n0" means display idstamps.
278 ;; "n1" means display alpha labels.
279 ;; "n2" means display partial alpha labels.
280 ;; "n." means display legal labels.
281 ;; "n*" means star labels.
282 ;; "n~" means no labels.
283 (let (spec type)
284 (if (match-beginning 1)
285 (setq spec (string-to-char
286 (substring kvspec:current
287 (match-beginning 1) (match-end 1)))
288 type (cdr (assq spec kvspec:label-type-alist)))
289 (setq type kview:default-label-type))
290 (kview:set-label-type kview type))))
291
292 (defun kvspec:update-modeline ()
293 "Setup or update display of the current kview spec in the modeline."
294 (if (stringp kvspec:current)
295 (setq kvspec:string (format kvspec:string-format kvspec:current)))
296 (if (memq 'kvspec:string mode-line-format)
297 nil
298 (setq mode-line-format (copy-sequence mode-line-format))
299 (let ((elt (or (memq 'mode-line-buffer-identification mode-line-format)
300 (memq 'modeline-buffer-identification mode-line-format))))
301 (setcdr elt (cons 'kvspec:string (cdr elt))))))
302
303 (defun kvspec:update-view ()
304 "Update view according to current setting of local 'kvspec:current' variable."
305 (let ((modified-p (buffer-modified-p))
306 (buffer-read-only))
307 (save-excursion
308
309 (if (string-match "a" kvspec:current)
310 (kotl-mode:show-all))
311
312 (kvspec:blank-lines) ;; b
313
314 ;; This must come before kvspec:lines-to-show or else it could show
315 ;; lines that should be hidden.
316 (kvspec:hide-levels) ;; l
317
318 (kvspec:lines-to-show) ;; c
319
320 (if (string-match "d" kvspec:current)
321 nil)
322
323 (kvspec:elide) ;; e
324
325 (if (string-match "f" kvspec:current)
326 nil)
327
328 (if (string-match "g" kvspec:current)
329 nil)
330
331 (if (string-match "i" kvspec:current)
332 nil)
333
334 (if (string-match "r" kvspec:current)
335 nil)
336
337 (if (string-match "s" kvspec:current)
338 nil)
339
340 ;; Do this last since it can trigger an error if partial alpha is
341 ;; selected.
342 (kvspec:numbering) ;; n
343
344 )
345 (set-buffer-modified-p modified-p)))
346
347 ;;; ************************************************************************
348 ;;; Private variables
349 ;;; ************************************************************************
350
351 (defvar kvspec:label-type-alist
352 '((?0 . idstamp) (?1 . alpha) (?2 . partial-alpha)
353 (?. . legal) (?* . star) (?~ . no))
354 "Alist of (view-spec-character . label-type) pairs.")
355
356 (defvar kvspec:string ""
357 "String displayed in koutline modelines to reflect the current view spec.
358 It is local to each koutline. Set this to nil to disable modeline display of
359 the view spec settings.")
360
361 (defvar kvspec:string-format " <|%s>"
362 "Format of the kview spec modeline display.
363 It must contain a '%s' which is replaced with the current set of view spec
364 characters at run-time.")
365
366 (provide 'kvspec)