|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: kview.el
|
|
|
4 ;; SUMMARY: Display handling of koutlines.
|
|
|
5 ;; USAGE: GNU Emacs Lisp Library
|
|
|
6 ;; KEYWORDS: outlines, wp
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner & Kellie Clark
|
|
|
9 ;;
|
|
|
10 ;; ORIG-DATE: 6/30/93
|
|
|
11 ;; LAST-MOD: 2-Nov-95 at 00:52:52 by Bob Weiner
|
|
|
12 ;;; ************************************************************************
|
|
|
13 ;;; Other required Lisp Libraries
|
|
|
14 ;;; ************************************************************************
|
|
|
15 (mapcar 'require '(klabel kfill hypb))
|
|
|
16
|
|
|
17 ;;; ************************************************************************
|
|
|
18 ;;; Public variables
|
|
|
19 ;;; ************************************************************************
|
|
|
20
|
|
|
21 (set-default 'kview nil)
|
|
|
22
|
|
|
23 (defvar kview:default-blank-lines t
|
|
|
24 "*Default setting of whether to show blank lines between koutline cells.
|
|
|
25 T means show them, nil means don't show them.")
|
|
|
26
|
|
|
27 (defvar kview:default-levels-to-show 0
|
|
|
28 "*Default number of cell levels to show. 0 means all levels.")
|
|
|
29
|
|
|
30 (defvar kview:default-lines-to-show 0
|
|
|
31 "*Default number of lines per cell to show. 0 means all lines.")
|
|
|
32
|
|
|
33
|
|
|
34 (defvar kview:default-label-min-width 4
|
|
|
35 "*Minimum width to which to pad labels in a kotl view.
|
|
|
36 Labels are padded with spaces on the left.")
|
|
|
37
|
|
|
38 (defvar kview:default-label-separator " "
|
|
|
39 "*Default string of characters to insert between label and contents of a koutline cell.")
|
|
|
40
|
|
|
41 (defvar kview:default-label-type 'alpha
|
|
|
42 "*Default label-type to use for new koutlines.
|
|
|
43 It must be one of the following symbols:
|
|
|
44 no for no labels
|
|
|
45 id for permanent idstamp labels, e.g. 001, 002, etc.
|
|
|
46 alpha for '1a2' full alphanumeric labels
|
|
|
47 legal for '1.1.2' labels
|
|
|
48 partial-alpha for partial alphanumeric labels, e.g. '2' for node '1a2'
|
|
|
49 star for multi-star labeling, e.g. '***'.")
|
|
|
50
|
|
|
51 (defvar kview:default-level-indent 3
|
|
|
52 "*Default number of spaces to indent each succeeding level in koutlines.")
|
|
|
53
|
|
|
54 ;;; ************************************************************************
|
|
|
55 ;;; Public functions
|
|
|
56 ;;; ************************************************************************
|
|
|
57
|
|
|
58 ;;;
|
|
|
59 ;;; kcell-view
|
|
|
60 ;;;
|
|
|
61
|
|
|
62 (defun kcell-view:backward (&optional visible-p label-sep-len)
|
|
|
63 "Move to start of the prior cell at the same level as the current cell.
|
|
|
64 With optional VISIBLE-P, consider only visible cells.
|
|
|
65 Return t unless no such cell."
|
|
|
66 (or label-sep-len (setq label-sep-len
|
|
|
67 (kview:label-separator-length kview)))
|
|
|
68 (let ((opoint (point))
|
|
|
69 (found) (done)
|
|
|
70 (curr-indent 0)
|
|
|
71 (start-indent (kcell-view:indent nil label-sep-len)))
|
|
|
72 (while (and (not (or found done))
|
|
|
73 (kcell-view:previous visible-p label-sep-len))
|
|
|
74 (if (bobp)
|
|
|
75 (progn (setq done t)
|
|
|
76 (goto-char opoint))
|
|
|
77 (setq curr-indent (kcell-view:indent nil label-sep-len))
|
|
|
78 (cond ((= curr-indent start-indent)
|
|
|
79 (goto-char (kcell-view:start nil label-sep-len))
|
|
|
80 (setq found t))
|
|
|
81 ((< curr-indent start-indent)
|
|
|
82 ;; Went past start of this tree without a match.
|
|
|
83 (setq done t)
|
|
|
84 (goto-char opoint))
|
|
|
85 ;; else go to prior node
|
|
|
86 )))
|
|
|
87 found))
|
|
|
88
|
|
|
89 (defun kview:beginning-of-actual-line ()
|
|
|
90 "Go to the beginning of the current line whether collapsed or not."
|
|
|
91 (if (re-search-backward "[\n\r]" nil 'move)
|
|
|
92 (forward-char 1)))
|
|
|
93
|
|
|
94 (defun kcell-view:cell (&optional pos)
|
|
|
95 "Return kcell at optional POS or point."
|
|
|
96 (kproperty:get (kcell-view:plist-point pos) 'kcell))
|
|
|
97
|
|
|
98 (defun kcell-view:child (&optional visible-p label-sep-len)
|
|
|
99 "Move to start of current cell's child.
|
|
|
100 With optional VISIBLE-P, consider only visible children.
|
|
|
101 Return t unless cell has no matching child.
|
|
|
102 Optional LABEL-SEP-LEN is the length of the separation between
|
|
|
103 a cell's label and the start of its contents."
|
|
|
104 (let* ((opoint (point))
|
|
|
105 (prev-indent (kcell-view:indent nil label-sep-len))
|
|
|
106 (next (kcell-view:next visible-p label-sep-len)))
|
|
|
107 (or label-sep-len (setq label-sep-len
|
|
|
108 (kview:label-separator-length kview)))
|
|
|
109 ;; Since kcell-view:next leaves point at the start of a cell, the cell's
|
|
|
110 ;; indent is just the current-column of point.
|
|
|
111 (if (and next (> (current-column) prev-indent))
|
|
|
112 t
|
|
|
113 ;; Move back to previous point and return nil.
|
|
|
114 (goto-char opoint)
|
|
|
115 nil)))
|
|
|
116
|
|
|
117 (defun kcell-view:child-p (&optional pos visible-p label-sep-len)
|
|
|
118 "Return t if cell at optional POS or point has a child.
|
|
|
119 With optional VISIBLE-P, consider only visible children.
|
|
|
120 Optional LABEL-SEP-LEN is the length of the separation between
|
|
|
121 a cell's label and the start of its contents."
|
|
|
122 (save-excursion
|
|
|
123 (if pos (goto-char pos))
|
|
|
124 (kcell-view:child visible-p label-sep-len)))
|
|
|
125
|
|
|
126 (defun kcell-view:collapse (&optional pos label-sep-len)
|
|
|
127 "Collapse cell at optional POS or point within the current view."
|
|
|
128 (save-excursion
|
|
|
129 (goto-char (kcell-view:start pos label-sep-len))
|
|
|
130 (subst-char-in-region (point) (kcell-view:end-contents) ?\n ?\r t)))
|
|
|
131
|
|
|
132 (defun kcell-view:collapsed-p (&optional pos label-sep-len)
|
|
|
133 "Return t if cell at optional POS or point is collapsed within the current view."
|
|
|
134 (save-excursion
|
|
|
135 (goto-char (kcell-view:start pos label-sep-len))
|
|
|
136 (if (search-forward "\r" (kcell-view:end-contents) t)
|
|
|
137 t)))
|
|
|
138
|
|
|
139 (defun kcell-view:contents (&optional pos)
|
|
|
140 "Return contents of cell at optional POS or point."
|
|
|
141 (save-excursion
|
|
|
142 (if pos (goto-char pos))
|
|
|
143 (let ((indent (kcell-view:indent))
|
|
|
144 (start (kcell-view:start))
|
|
|
145 (end (kcell-view:end-contents)))
|
|
|
146 ;; Remove indentation from all but first line.
|
|
|
147 (hypb:replace-match-string
|
|
|
148 (concat "\\([\n\r]\\)" (make-string indent ?\ ))
|
|
|
149 (buffer-substring start end) "\\1"))))
|
|
|
150
|
|
|
151 (defun kcell-view:create (kview cell level klabel &optional no-fill)
|
|
|
152 "Insert into KVIEW at point, CELL at LEVEL (1 = first level) with KLABEL.
|
|
|
153 Optional NO-FILL non-nil suppresses filling of cell's contents upon insertion
|
|
|
154 or movement."
|
|
|
155 (if (= (kcell:idstamp cell) 0)
|
|
|
156 nil
|
|
|
157 (or no-fill (setq no-fill (kcell:get-attr cell 'no-fill)))
|
|
|
158 (let* ((label-min-width (kview:label-min-width kview))
|
|
|
159 (label-fmt (format "%%%ds" label-min-width))
|
|
|
160 (label (if (string= klabel "") "" (format label-fmt klabel)))
|
|
|
161 (label-separator (if (string= klabel "") " "
|
|
|
162 (kview:label-separator kview)))
|
|
|
163 (mult-line-indent (* (1- level) (kview:level-indent kview)))
|
|
|
164 (thru-label (+ mult-line-indent label-min-width
|
|
|
165 (length label-separator)))
|
|
|
166 (old-point (point))
|
|
|
167 (fill-prefix (make-string thru-label ?\ ))
|
|
|
168 contents
|
|
|
169 new-point)
|
|
|
170 (if no-fill (kcell:set-attr cell 'no-fill t))
|
|
|
171 (insert fill-prefix)
|
|
|
172 (setq contents (kview:insert-contents cell nil no-fill fill-prefix))
|
|
|
173 ;; Insert lines to separate cell from next.
|
|
|
174 (insert (if (or no-fill (equal contents ""))
|
|
|
175 "\n\n" "\n"))
|
|
|
176 (if (kview:get-attr kview 'blank-lines)
|
|
|
177 nil
|
|
|
178 ;; Make blank lines invisible.
|
|
|
179 (kproperty:put (1- (point)) (min (point) (point-max))
|
|
|
180 '(invisible t)))
|
|
|
181 (kfile:narrow-to-kcells)
|
|
|
182 (setq new-point (point))
|
|
|
183 (goto-char old-point)
|
|
|
184 ;; Delete leading spaces used to get fill right in first cell
|
|
|
185 ;; line. Replace it with label.
|
|
|
186 (delete-char thru-label)
|
|
|
187 (insert (format
|
|
|
188 (format "%%%ds" (- thru-label (length label-separator)))
|
|
|
189 label))
|
|
|
190 (setq old-point (point))
|
|
|
191 (insert label-separator)
|
|
|
192 (goto-char old-point)
|
|
|
193 ;; Add cell's attributes to the text property list at point.
|
|
|
194 (kproperty:set 'kcell cell)
|
|
|
195 (goto-char new-point))))
|
|
|
196
|
|
|
197 (defun kcell-view:end (&optional pos)
|
|
|
198 "Return end position of cell from optional POS or point.
|
|
|
199 Includes blank lines following cell contents."
|
|
|
200 (or pos (setq pos (point)))
|
|
|
201 (save-excursion
|
|
|
202 (or (re-search-forward "[\n\r][\n\r]" nil t)
|
|
|
203 (point-max))))
|
|
|
204
|
|
|
205 (defun kcell-view:end-contents (&optional pos)
|
|
|
206 "Return end position of cell contents from optional POS or point.
|
|
|
207 Excludes blank lines following cell contents."
|
|
|
208 (save-excursion
|
|
|
209 (if pos (goto-char pos))
|
|
|
210 (goto-char (kcell-view:end))
|
|
|
211 (skip-chars-backward "\n\r")
|
|
|
212 (point)))
|
|
|
213
|
|
|
214 (defun kcell-view:expand (&optional pos label-sep-len)
|
|
|
215 "Expand cell at optional POS or point within the current view."
|
|
|
216 (save-excursion
|
|
|
217 (goto-char (kcell-view:start pos label-sep-len))
|
|
|
218 (subst-char-in-region (point) (kcell-view:end-contents) ?\r ?\n t)))
|
|
|
219
|
|
|
220 (defun kcell-view:forward (&optional visible-p label-sep-len)
|
|
|
221 "Move to start of the following cell at the same level as the current cell.
|
|
|
222 With optional VISIBLE-P, consider only visible cells.
|
|
|
223 Return t unless no such cell."
|
|
|
224 (or label-sep-len (setq label-sep-len
|
|
|
225 (kview:label-separator-length kview)))
|
|
|
226 (let ((opoint (point))
|
|
|
227 (found) (done)
|
|
|
228 (curr-indent 0)
|
|
|
229 (start-indent (kcell-view:indent nil label-sep-len)))
|
|
|
230 (while (and (not (or found done))
|
|
|
231 (kcell-view:next visible-p label-sep-len))
|
|
|
232 (setq curr-indent (kcell-view:indent nil label-sep-len))
|
|
|
233 (cond ((= curr-indent start-indent)
|
|
|
234 (goto-char (kcell-view:start nil label-sep-len))
|
|
|
235 (setq found t))
|
|
|
236 ((< curr-indent start-indent)
|
|
|
237 ;; Went past end of this tree without a match.
|
|
|
238 (setq done t)
|
|
|
239 (goto-char opoint))
|
|
|
240 ;; else go to following node
|
|
|
241 ))
|
|
|
242 ;; If didn't find a match, return to original point.
|
|
|
243 (or found (goto-char opoint))
|
|
|
244 found))
|
|
|
245
|
|
|
246 (defun kcell-view:get-attr (attribute &optional pos)
|
|
|
247 "Return ATTRIBUTE's value for current cell or cell at optional POS."
|
|
|
248 (save-excursion
|
|
|
249 (if pos (goto-char pos))
|
|
|
250 (kcell:get-attr (kcell-view:cell) attribute)))
|
|
|
251
|
|
|
252 (defun kcell-view:idstamp (&optional pos)
|
|
|
253 "Return idstamp string of cell at optional POS or point."
|
|
|
254 (save-excursion
|
|
|
255 (if pos (goto-char pos))
|
|
|
256 (format "0%d" (kcell:idstamp (kcell-view:cell)))))
|
|
|
257
|
|
|
258 (defun kcell-view:indent (&optional pos label-sep-len)
|
|
|
259 "Return indentation of cell at optional POS or point.
|
|
|
260 Optional LABEL-SEP-LEN is the view-specific length of the separator between a
|
|
|
261 cell's label and the start of its contents."
|
|
|
262 (+ (save-excursion
|
|
|
263 (kcell-view:to-label-end pos)
|
|
|
264 (current-column))
|
|
|
265 (or label-sep-len (kview:label-separator-length kview))))
|
|
|
266
|
|
|
267 (defun kcell-view:label (&optional pos)
|
|
|
268 "Return displayed label string of cell at optional POS or point.
|
|
|
269 If labels are off, return cell's idstamp as a string."
|
|
|
270 (save-excursion
|
|
|
271 (if pos (goto-char pos))
|
|
|
272 (let ((label-type (kview:label-type kview)))
|
|
|
273 (if (eq label-type 'no)
|
|
|
274 (kcell-view:idstamp)
|
|
|
275 (kcell-view:to-label-end)
|
|
|
276 (buffer-substring (point) (progn (skip-chars-backward "^ \t\n\r")
|
|
|
277 (point)))))))
|
|
|
278
|
|
|
279 (defun kcell-view:level (&optional pos label-sep-len indent)
|
|
|
280 "Return cell level relative to top cell of the outline for current cell or one at optional POS.
|
|
|
281 0 = top cell level, 1 = 1st level in outline.
|
|
|
282 Optional LABEL-SEP-LEN is length of spaces between a cell label and its the
|
|
|
283 start of its body in the current view. Optional INDENT is the indentation in
|
|
|
284 characters of the cell whose level is desired."
|
|
|
285 (or label-sep-len (setq label-sep-len (kview:label-separator-length kview)))
|
|
|
286 (save-excursion
|
|
|
287 (if pos (goto-char pos))
|
|
|
288 (/ (- (or indent (kcell-view:indent nil label-sep-len)) label-sep-len)
|
|
|
289 (kview:level-indent kview))))
|
|
|
290
|
|
|
291 (defun kcell-view:line (&optional pos)
|
|
|
292 "Return contents of cell line at point or optional POS as a string."
|
|
|
293 (save-excursion
|
|
|
294 (if pos (goto-char pos))
|
|
|
295 (if (kview:valid-position-p)
|
|
|
296 (buffer-substring
|
|
|
297 (kotl-mode:beginning-of-line)
|
|
|
298 (kotl-mode:end-of-line))
|
|
|
299 (error "(kcell-view:line): Invalid position, '%d'" (point)))))
|
|
|
300
|
|
|
301 (defun kcell-view:next (&optional visible-p label-sep-len)
|
|
|
302 "Move to start of next cell within current view.
|
|
|
303 With optional VISIBLE-P, consider only visible cells.
|
|
|
304 Return t unless no next cell."
|
|
|
305 (let ((opoint (point))
|
|
|
306 pos)
|
|
|
307 ;;
|
|
|
308 ;; If a subtree is collapsed, be sure we end up at the start of a visible
|
|
|
309 ;; cell rather than within an invisible one.
|
|
|
310 (if visible-p
|
|
|
311 (progn (goto-char (kcell-view:end-contents)) (end-of-line)))
|
|
|
312 (setq pos (kproperty:next-single-change (point) 'kcell))
|
|
|
313 (if (or (null pos)
|
|
|
314 (if (goto-char pos) (kotl-mode:eobp)))
|
|
|
315 (progn (goto-char opoint)
|
|
|
316 nil)
|
|
|
317 (goto-char (kcell-view:start nil label-sep-len))
|
|
|
318 (not (eq opoint (point))))))
|
|
|
319
|
|
|
320 (defun kcell-view:operate (function &optional start end)
|
|
|
321 "Invoke FUNCTION with view restricted to current cell contents.
|
|
|
322 Optional START and END are start and endpoints of cell to use."
|
|
|
323 (save-restriction
|
|
|
324 (narrow-to-region (or start (kcell-view:start))
|
|
|
325 (or end (kcell-view:end-contents)))
|
|
|
326 (funcall function)))
|
|
|
327
|
|
|
328 (defun kcell-view:parent (&optional visible-p label-sep-len)
|
|
|
329 "Move to start of current cell's parent within current view.
|
|
|
330 If parent is top cell, move to first cell within view and return 0.
|
|
|
331 Otherwise, return t unless optional VISIBLE-P is non-nil and the parent cell
|
|
|
332 is not part of the current view."
|
|
|
333 (or label-sep-len (setq label-sep-len (kview:label-separator-length kview)))
|
|
|
334 (let ((opoint (point))
|
|
|
335 (parent-level (1- (kcell-view:level nil label-sep-len))))
|
|
|
336 (if (= parent-level 0) ;; top cell
|
|
|
337 (progn (goto-char (point-min))
|
|
|
338 (goto-char (kcell-view:start nil label-sep-len))
|
|
|
339 0)
|
|
|
340 ;; Skip from point back past any siblings
|
|
|
341 (while (kcell-view:backward visible-p label-sep-len))
|
|
|
342 ;; Move back to parent.
|
|
|
343 (if (kcell-view:previous visible-p label-sep-len)
|
|
|
344 t
|
|
|
345 ;; Move back to previous point and return nil.
|
|
|
346 (goto-char opoint)
|
|
|
347 nil))))
|
|
|
348
|
|
|
349 (defun kcell-view:previous (&optional visible-p label-sep-len)
|
|
|
350 "Move to start of previous cell within current view.
|
|
|
351 With optional VISIBLE-P, consider only visible cells.
|
|
|
352 Return t unless no previous cell."
|
|
|
353 (let ((opoint (point))
|
|
|
354 (pos (point)))
|
|
|
355 (goto-char (kcell-view:start nil label-sep-len))
|
|
|
356 ;;
|
|
|
357 ;; If a subtree is collapsed, be sure we end up at the start of a visible
|
|
|
358 ;; cell rather than within an invisible one.
|
|
|
359 (if visible-p
|
|
|
360 (beginning-of-line)
|
|
|
361 (if (setq pos (kproperty:previous-single-change (point) 'kcell))
|
|
|
362 (goto-char pos)))
|
|
|
363 (if (and pos (not (kotl-mode:bobp))
|
|
|
364 (setq pos (kproperty:previous-single-change (point) 'kcell)))
|
|
|
365 (progn (goto-char pos)
|
|
|
366 (skip-chars-backward "\n\r")
|
|
|
367 (if visible-p (beginning-of-line))
|
|
|
368 (goto-char (kcell-view:start nil label-sep-len))
|
|
|
369 (not (eq opoint (point))))
|
|
|
370 ;; No previous cell exists
|
|
|
371 (goto-char opoint)
|
|
|
372 nil)))
|
|
|
373
|
|
|
374 (defun kcell-view:plist (&optional pos)
|
|
|
375 "Return attributes associated with cell at optional POS or point."
|
|
|
376 (kcell:plist (kcell-view:cell pos)))
|
|
|
377
|
|
|
378 (defun kcell-view:plist-point (&optional pos)
|
|
|
379 "Return buffer position of attributes associated with cell at optional POS or point."
|
|
|
380 (save-excursion (1+ (kcell-view:to-label-end pos))))
|
|
|
381
|
|
|
382 (defun kcell-view:to-label-end (&optional pos)
|
|
|
383 "Move point after end of current cell's label and return point."
|
|
|
384 (if pos (goto-char pos))
|
|
|
385 (kview:end-of-actual-line)
|
|
|
386 (cond ((null kview)
|
|
|
387 (error "(kcell-view:to-label-end): Invalid kview; try {M-x kotl-mode RET} to fix it."))
|
|
|
388 (klabel-type:changing-flag
|
|
|
389 ;; When changing from one label type to another, e.g. alpha to
|
|
|
390 ;; legal, we can't depend on the label being of the type given by
|
|
|
391 ;; the kview, so use kcell properties to find label end.
|
|
|
392 (if (kproperty:get (1- (point)) 'kcell)
|
|
|
393 nil
|
|
|
394 ;; If not at beginning of cell contents, move there.
|
|
|
395 (goto-char (kproperty:previous-single-change (point) 'kcell)))
|
|
|
396 ;; Then move to end of label via embedded kcell property.
|
|
|
397 (goto-char (kproperty:previous-single-change (point) 'kcell)))
|
|
|
398 ((funcall (kview:get-attr kview 'to-label-end))
|
|
|
399 (point))
|
|
|
400 (t (error "(kcell-view:to-label-end): Can't find end of current cell's label"))))
|
|
|
401
|
|
|
402 (defun kcell-view:reference (&optional pos relative-dir)
|
|
|
403 "Return a reference to the kcell at optional POS or point for use in a link.
|
|
|
404 The reference is a string of the form, \"<kcell-file, cell-ref>\" where
|
|
|
405 cell-ref is as described in the documentation for 'kcell:ref-to-id'.
|
|
|
406 Kcell-file is made relative to optional RELATIVE-DIR before it is returned."
|
|
|
407 (format "<%s, %s=%s>" (hpath:relative-to buffer-file-name relative-dir)
|
|
|
408 (kcell-view:label pos) (kcell-view:idstamp pos)))
|
|
|
409
|
|
|
410 (defun kcell-view:remove-attr (attribute &optional pos)
|
|
|
411 "Remove ATTRIBUTE, if any, for current cell or cell at optional POS."
|
|
|
412 (interactive "*SAttribute to remove: ")
|
|
|
413 (save-excursion
|
|
|
414 (if pos (goto-char pos))
|
|
|
415 (let ((kcell (kcell:remove-attr (kcell-view:cell) attribute)))
|
|
|
416 (if (interactive-p)
|
|
|
417 (message "Cell <%s> now has no %s attribute."
|
|
|
418 (kcell-view:label) attribute))
|
|
|
419 kcell)))
|
|
|
420
|
|
|
421 (defun kcell-view:set-attr (attribute value &optional pos)
|
|
|
422 "Set ATTRIBUTE's VALUE for current cell or cell at optional POS and return the cell."
|
|
|
423 (save-excursion
|
|
|
424 (if pos (goto-char pos))
|
|
|
425 ;; Returns kcell.
|
|
|
426 (kcell:set-attr (kcell-view:cell) attribute value)))
|
|
|
427
|
|
|
428 (defun kcell-view:set-cell (kcell)
|
|
|
429 "Attach KCELL property to cell at point."
|
|
|
430 (save-excursion
|
|
|
431 (kcell-view:to-label-end)
|
|
|
432 (kproperty:set 'kcell kcell)))
|
|
|
433
|
|
|
434 (defun kcell-view:sibling-p (&optional pos visible-p label-sep-len)
|
|
|
435 "Return t if cell at optional POS or point has a successor.
|
|
|
436 With optional VISIBLE-P, consider only visible siblings."
|
|
|
437 (save-excursion
|
|
|
438 (if pos (goto-char pos))
|
|
|
439 (kcell-view:forward visible-p label-sep-len)))
|
|
|
440
|
|
|
441 (defun kcell-view:start (&optional pos label-sep-len)
|
|
|
442 "Return start position of cell contents from optional POS or point."
|
|
|
443 (save-excursion
|
|
|
444 (+ (kcell-view:to-label-end pos)
|
|
|
445 (or label-sep-len (kview:label-separator-length kview)))))
|
|
|
446
|
|
|
447 ;;;
|
|
|
448 ;;; kview - one view per buffer, multiple views per kotl
|
|
|
449 ;;;
|
|
|
450
|
|
|
451 (defun kview:add-cell (klabel level &optional contents prop-list no-fill)
|
|
|
452 "Create a new cell with full KLABEL and add it at point at LEVEL within outline.
|
|
|
453 1 = first level. Optional cell CONTENTS and PROP-LIST may also be given, as
|
|
|
454 well as NO-FILL which skips filling of any CONTENTS.
|
|
|
455 Return new cell. This function does not renumber any other cells."
|
|
|
456 (let ((new-cell (kcell:create contents (kview:id-increment kview)
|
|
|
457 prop-list)))
|
|
|
458 (kcell-view:create kview new-cell level klabel no-fill)
|
|
|
459 new-cell))
|
|
|
460
|
|
|
461 (defun kview:buffer (kview)
|
|
|
462 "Return kview's buffer or nil if argument is not a kview."
|
|
|
463 (if (kview:is-p kview)
|
|
|
464 (get-buffer (kview:get-attr kview 'view-buffer-name))))
|
|
|
465
|
|
|
466 (defun kview:create (buffer-name
|
|
|
467 &optional id-counter label-type level-indent
|
|
|
468 label-separator label-min-width blank-lines
|
|
|
469 levels-to-show lines-to-show)
|
|
|
470 "Return a new kview for BUFFER-NAME.
|
|
|
471 Optional ID-COUNTER is the maximum permanent id previously given out in this
|
|
|
472 outline. Optional LABEL-TYPE, LEVEL-INDENT, LABEL-SEPARATOR, LABEL-MIN-WIDTH,
|
|
|
473 BLANK-LINES, LEVELS-TO-SHOW, and LINES-TO-SHOW may also be given, otherwise default values are used.
|
|
|
474
|
|
|
475 See documentation of:
|
|
|
476 'kview:default-label-type' for LABEL-TYPE,
|
|
|
477 'kview:default-level-indent' for LEVEL-INDENT,
|
|
|
478 'kview:default-label-separator' for LABEL-SEPARATOR,
|
|
|
479 'kview:default-label-min-width' for LABEL-MIN-WIDTH,
|
|
|
480 'kview:default-blank-lines' for BLANK-LINES,
|
|
|
481 'kview:default-levels-to-show' for LEVELS-TO-SHOW,
|
|
|
482 'kview:default-lines-to-show' for LINES-TO-SHOW."
|
|
|
483
|
|
|
484 (let ((buf (get-buffer buffer-name)))
|
|
|
485 (cond ((null buf)
|
|
|
486 (error "(kview:create): No such buffer, '%s'." buffer-name))
|
|
|
487 ((or (null id-counter) (= id-counter 0))
|
|
|
488 (setq id-counter 0))
|
|
|
489 ((not (integerp id-counter))
|
|
|
490 (error "(kview:create): 2nd arg, '%s', must be an integer." id-counter)))
|
|
|
491 (set-buffer buf)
|
|
|
492 (if (and (boundp 'kview) (eq (kview:buffer kview) buf))
|
|
|
493 ;; Don't recreate view if it exists.
|
|
|
494 nil
|
|
|
495 (make-local-variable 'kview)
|
|
|
496 (setq kview
|
|
|
497 (list 'kview 'plist
|
|
|
498 (list 'view-buffer-name buffer-name
|
|
|
499 'top-cell
|
|
|
500 (kcell:create-top buffer-file-name id-counter)
|
|
|
501 'label-type (or label-type kview:default-label-type)
|
|
|
502 'label-min-width (or label-min-width
|
|
|
503 kview:default-label-min-width)
|
|
|
504 'label-separator (or label-separator
|
|
|
505 kview:default-label-separator)
|
|
|
506 'label-separator-length
|
|
|
507 (length (or label-separator
|
|
|
508 kview:default-label-separator))
|
|
|
509 'level-indent (or level-indent
|
|
|
510 kview:default-level-indent)
|
|
|
511 'blank-lines
|
|
|
512 (or blank-lines kview:default-blank-lines)
|
|
|
513 'levels-to-show
|
|
|
514 (or levels-to-show kview:default-levels-to-show)
|
|
|
515 'lines-to-show
|
|
|
516 (or lines-to-show kview:default-lines-to-show)
|
|
|
517 )))
|
|
|
518 (kview:set-functions (or label-type kview:default-label-type)))
|
|
|
519 kview))
|
|
|
520
|
|
|
521 ;;; Using this stimulates an GNU Emacs V19.19 bug in text-property handling,
|
|
|
522 ;; visible when one deletes a sibling cell and then deletes the prior cell,
|
|
|
523 ;; the following cell is left with a different idstamp and its label
|
|
|
524 ;; displays as "0". Using delete-char here would solve the problem but we
|
|
|
525 ;; suggest you upgrade to a newer version of GNU Emacs in which the bug is
|
|
|
526 ;; fixed.
|
|
|
527 (defun kview:delete-region (start end)
|
|
|
528 "Delete cells between START and END points from current view."
|
|
|
529 (delete-region start end))
|
|
|
530
|
|
|
531 (defun kview:end-of-actual-line ()
|
|
|
532 "Go to the end of the current line whether collapsed or not."
|
|
|
533 (if (re-search-forward "[\n\r]" nil 'move)
|
|
|
534 (backward-char 1)))
|
|
|
535
|
|
|
536 (defun kview:fill-region (start end &optional kcell justify)
|
|
|
537 "Fill region between START and END within current view.
|
|
|
538 With optional KCELL, assume START and END delimit that cell's contents.
|
|
|
539 With optional JUSTIFY, justify region as well.
|
|
|
540 Fill-prefix must be a string of spaces the length of this cell's indent, when
|
|
|
541 this function is called."
|
|
|
542 (let ((opoint (set-marker (make-marker) (point)))
|
|
|
543 (label-sep-len (kview:label-separator-length kview))
|
|
|
544 (continue t)
|
|
|
545 prev-point)
|
|
|
546 (goto-char start)
|
|
|
547 (while continue
|
|
|
548 (if (kcell:get-attr (or kcell (kcell-view:cell)) 'no-fill)
|
|
|
549 (setq continue (kcell-view:next nil label-sep-len))
|
|
|
550 (fill-paragraph justify t)
|
|
|
551 (setq prev-point (point))
|
|
|
552 (forward-paragraph)
|
|
|
553 (re-search-forward "[^ \t\n\r]" nil t))
|
|
|
554 (setq continue (and continue
|
|
|
555 (/= (point) prev-point)
|
|
|
556 (< (point) (min end (point-max))))))
|
|
|
557 ;; Return to original point.
|
|
|
558 (goto-char opoint)
|
|
|
559 (set-marker opoint nil)))
|
|
|
560
|
|
|
561 (cond ((and hyperb:xemacs-p (or (>= emacs-minor-version 12)
|
|
|
562 (> emacs-major-version 19)))
|
|
|
563 (defun kview:goto-cell-id (id-string)
|
|
|
564 "Move point to start of cell with idstamp ID-STRING and return t, else nil."
|
|
|
565 (let ((cell-id (string-to-int id-string))
|
|
|
566 label-end kcell)
|
|
|
567 (setq label-end
|
|
|
568 (map-extents
|
|
|
569 (function (lambda (extent unused)
|
|
|
570 (setq kcell (extent-property extent 'kcell))
|
|
|
571 (if (= (kcell:idstamp kcell) cell-id)
|
|
|
572 (extent-end-position extent))))
|
|
|
573 nil nil nil nil nil 'kcell))
|
|
|
574 (if (null label-end)
|
|
|
575 nil
|
|
|
576 (goto-char label-end)
|
|
|
577 t))))
|
|
|
578 (hyperb:lemacs-p
|
|
|
579 (defun kview:goto-cell-id (id-string)
|
|
|
580 "Move point to start of cell with idstamp ID-STRING and return t, else nil."
|
|
|
581 (let ((cell-id (string-to-int id-string))
|
|
|
582 label-end kcell)
|
|
|
583 (setq label-end
|
|
|
584 (map-extents
|
|
|
585 (function (lambda (extent unused)
|
|
|
586 (setq kcell (extent-property extent 'kcell))
|
|
|
587 (and kcell (= (kcell:idstamp kcell) cell-id)
|
|
|
588 (extent-end-position extent))))))
|
|
|
589 (if (null label-end)
|
|
|
590 nil
|
|
|
591 (goto-char label-end)
|
|
|
592 t))))
|
|
|
593 ;; Emacs 19
|
|
|
594 (t (defun kview:goto-cell-id (id-string)
|
|
|
595 "Move point to start of cell with idstamp ID-STRING and return t, else nil."
|
|
|
596 (let ((cell-id (string-to-int id-string))
|
|
|
597 (opoint (point))
|
|
|
598 pos kcell)
|
|
|
599 (goto-char (point-min))
|
|
|
600 (while (and (setq pos
|
|
|
601 (kproperty:next-single-change (point) 'kcell))
|
|
|
602 (goto-char pos)
|
|
|
603 (or (null (setq kcell (kproperty:get pos 'kcell)))
|
|
|
604 (/= (kcell:idstamp kcell) cell-id))))
|
|
|
605 (if pos
|
|
|
606 (progn
|
|
|
607 (forward-char (kview:label-separator-length kview))
|
|
|
608 t)
|
|
|
609 (goto-char opoint)
|
|
|
610 nil))))
|
|
|
611 )
|
|
|
612
|
|
|
613 (defun kview:id-increment (kview)
|
|
|
614 "Return next idstamp (an integer) for KVIEW."
|
|
|
615 (let* ((top-cell (kview:get-attr kview 'top-cell))
|
|
|
616 (counter (1+ (kcell:get-attr top-cell 'id-counter))))
|
|
|
617 (kcell:set-attr top-cell 'id-counter counter)
|
|
|
618 counter))
|
|
|
619
|
|
|
620 (defun kview:idstamp-to-label (permanent-id)
|
|
|
621 "Return relative label for cell with PERMANENT-ID within current kview."
|
|
|
622 (save-excursion
|
|
|
623 (if (kotl-mode:goto-cell permanent-id)
|
|
|
624 (kcell-view:label))))
|
|
|
625
|
|
|
626 (defun kview:insert-contents (kcell contents no-fill fill-prefix)
|
|
|
627 "Insert KCELL's CONTENTS into view at point and fill resulting paragraphs, unless NO-FILL is non-nil.
|
|
|
628 FILL-PREFIX is the indentation string for the current cell.
|
|
|
629 If CONTENTS is nil, get contents from KCELL. Return contents inserted (this
|
|
|
630 value may differ from the value passed in.)"
|
|
|
631 (let ((start (point))
|
|
|
632 end)
|
|
|
633 (setq contents (or contents (kcell:contents kcell) ""))
|
|
|
634 (insert contents)
|
|
|
635 ;;
|
|
|
636 ;; Delete any extra newlines at end of cell contents.
|
|
|
637 (setq end (point))
|
|
|
638 (skip-chars-backward "\n\r")
|
|
|
639 (delete-region (point) end)
|
|
|
640 (setq end (point))
|
|
|
641 ;;
|
|
|
642 (save-restriction
|
|
|
643 (if no-fill
|
|
|
644 ;; Insert proper indent in all but the first line which has
|
|
|
645 ;; already been indented.
|
|
|
646 (progn
|
|
|
647 (narrow-to-region start end)
|
|
|
648 (goto-char (point-min))
|
|
|
649 (while (re-search-forward "[\n\r]" nil t)
|
|
|
650 (insert fill-prefix))
|
|
|
651 (goto-char (point-max)))
|
|
|
652 ;;
|
|
|
653 ;; Filling cell will insert proper indent on all lines.
|
|
|
654 (if (equal contents "")
|
|
|
655 nil
|
|
|
656 (goto-char start)
|
|
|
657 (beginning-of-line)
|
|
|
658 (narrow-to-region (point) end)
|
|
|
659 ;; Add fill-prefix to all but paragraph separator lines, so
|
|
|
660 ;; filling is done properly.
|
|
|
661 (while (re-search-forward "[\n\r][^\n\r]" nil t)
|
|
|
662 (forward-char -1) (insert fill-prefix))
|
|
|
663 (kview:fill-region start end kcell)
|
|
|
664 (goto-char (point-min))
|
|
|
665 ;; Now add fill-prefix to paragraph separator lines.
|
|
|
666 (while (re-search-forward "[\n\r][\n\r]" nil t)
|
|
|
667 (forward-char -1) (insert fill-prefix))
|
|
|
668 ;;
|
|
|
669 (goto-char (point-max))))))
|
|
|
670 contents)
|
|
|
671
|
|
|
672 (defun kview:is-p (object)
|
|
|
673 "Is OBJECT a kview?"
|
|
|
674 (if (listp object) (eq (car object) 'kview)))
|
|
|
675
|
|
|
676 (defun kview:kotl (kview)
|
|
|
677 "Return kview's kotl object or nil if argument is not a kview."
|
|
|
678 (if (kview:is-p kview)
|
|
|
679 (kview:get-attr kview 'kotl)))
|
|
|
680
|
|
|
681 (defun kview:label (klabel-function prev-label child-p)
|
|
|
682 "Return label string to display for current cell computed from KLABEL-FUNCTION, PREV-LABEL and CHILD-P."
|
|
|
683 (funcall klabel-function prev-label child-p))
|
|
|
684
|
|
|
685 (defun kview:label-function (kview)
|
|
|
686 "Return function which will return display label for current cell in KVIEW.
|
|
|
687 Function signature is: (func prev-label &optional child-p), where prev-label
|
|
|
688 is the display label of the cell preceding the current one and child-p is
|
|
|
689 non-nil if cell is to be the child of the preceding cell."
|
|
|
690 (kview:get-attr kview 'label-function))
|
|
|
691
|
|
|
692 (defun kview:label-min-width (kview)
|
|
|
693 "Return kview's label-min-width setting or nil if argument is not a kview.
|
|
|
694 See documentation for kview:default-label-min-width."
|
|
|
695 (if (kview:is-p kview)
|
|
|
696 (kview:get-attr kview 'label-min-width)))
|
|
|
697
|
|
|
698 (defun kview:label-separator (kview)
|
|
|
699 "Return kview's label-separator setting or nil if argument is not a kview.
|
|
|
700 See documentation for kview:default-label-separator."
|
|
|
701 (if (kview:is-p kview)
|
|
|
702 (kview:get-attr kview 'label-separator)))
|
|
|
703
|
|
|
704 (defun kview:label-separator-length (kview)
|
|
|
705 "Return kview's label-separator length or nil if argument is not a kview.
|
|
|
706 See documentation for kview:default-label-separator."
|
|
|
707 (kview:get-attr kview 'label-separator-length))
|
|
|
708
|
|
|
709 (defun kview:label-type (kview)
|
|
|
710 "Return kview's label-type setting or nil if argument is not a kview.
|
|
|
711 See documentation for kview:default-label-type."
|
|
|
712 (if (kview:is-p kview)
|
|
|
713 (kview:get-attr kview 'label-type)))
|
|
|
714
|
|
|
715 (defun kview:level-indent (kview)
|
|
|
716 "Return kview's level-indent setting or nil if argument is not a kview.
|
|
|
717 See documentation for kview:default-level-indent."
|
|
|
718 (if (kview:is-p kview)
|
|
|
719 (kview:get-attr kview 'level-indent)))
|
|
|
720
|
|
|
721 (defun kview:map-branch (func kview &optional first-p visible-p)
|
|
|
722 "Applies FUNC to the sibling trees from point forward within KVIEW and returns results as a list.
|
|
|
723 With optional FIRST-P non-nil, begins with first sibling in current branch.
|
|
|
724 With optional VISIBLE-P, considers only those sibling cells that are visible
|
|
|
725 in the view.
|
|
|
726
|
|
|
727 FUNC should take one argument, the kview local variable of the current
|
|
|
728 buffer or some other kview, and should operate upon the cell at point.
|
|
|
729
|
|
|
730 `Cell-indent' contains the indentation value of the first cell mapped when
|
|
|
731 FUNC is called so that it may test against this value. `Label-sep-len'
|
|
|
732 contains the label separator length.
|
|
|
733
|
|
|
734 See also 'kview:map-siblings' and 'kview:map-tree'."
|
|
|
735 (save-excursion
|
|
|
736 (set-buffer (kview:buffer kview))
|
|
|
737 (let ((results)
|
|
|
738 (label-sep-len (kview:label-separator-length kview)))
|
|
|
739 (if first-p
|
|
|
740 ;; Move back to first predecessor at same level.
|
|
|
741 (while (kcell-view:backward t label-sep-len)))
|
|
|
742 (let ((cell-indent (kcell-view:indent nil label-sep-len)))
|
|
|
743 ;; Terminate when no further cells or when reach a cell at an equal
|
|
|
744 ;; or higher level in the kotl than the first cell that we processed.
|
|
|
745 (while (and (progn (setq results (cons (funcall func kview) results))
|
|
|
746 (kcell-view:next visible-p label-sep-len))
|
|
|
747 (> (kcell-view:indent nil label-sep-len) cell-indent))))
|
|
|
748 (nreverse results))))
|
|
|
749
|
|
|
750 (defun kview:map-siblings (func kview &optional first-p visible-p)
|
|
|
751 "Applies FUNC to the sibling cells from point forward within KVIEW and returns results as a list.
|
|
|
752 With optional FIRST-P non-nil, begins with first sibling in current branch.
|
|
|
753 With optional VISIBLE-P, considers only those sibling cells that are visible
|
|
|
754 in the view.
|
|
|
755
|
|
|
756 FUNC should take one argument, the kview local variable of the current
|
|
|
757 buffer or some other kview, and should operate upon the cell at point.
|
|
|
758
|
|
|
759 `Cell-indent' contains the indentation value of the first cell mapped when
|
|
|
760 FUNC is called so that it may test against this value. `Label-sep-len'
|
|
|
761 contains the label separator length.
|
|
|
762
|
|
|
763 See also 'kview:map-branch' and 'kview:map-tree'."
|
|
|
764 (save-excursion
|
|
|
765 (set-buffer (kview:buffer kview))
|
|
|
766 (let ((results)
|
|
|
767 (label-sep-len (kview:label-separator-length kview)))
|
|
|
768 (if first-p
|
|
|
769 ;; Move back to first predecessor at same level.
|
|
|
770 (while (kcell-view:backward t label-sep-len)))
|
|
|
771 (let ((cell-indent (kcell-view:indent nil label-sep-len)))
|
|
|
772 ;; Terminate when no further cells at same level.
|
|
|
773 (while (progn (setq results (cons (funcall func kview) results))
|
|
|
774 (kcell-view:forward visible-p label-sep-len))))
|
|
|
775 (nreverse results))))
|
|
|
776
|
|
|
777 (defun kview:map-tree (func kview &optional top-p visible-p)
|
|
|
778 "Applies FUNC to the tree starting at point within KVIEW and returns results as a list.
|
|
|
779 With optional TOP-P non-nil, maps over all of kview's cells.
|
|
|
780 With optional VISIBLE-P, considers only those cells that are visible in the
|
|
|
781 view.
|
|
|
782
|
|
|
783 FUNC should take one argument, the kview local variable of the current
|
|
|
784 buffer or some other kview, and should operate upon the cell at point.
|
|
|
785
|
|
|
786 `Cell-indent' contains the indentation value of the first cell mapped when
|
|
|
787 FUNC is called so that it may test against this value. `Label-sep-len'
|
|
|
788 contains the label separator length.
|
|
|
789
|
|
|
790 See also 'kview:map-branch' and 'kview:map-siblings'."
|
|
|
791 (let ((results)
|
|
|
792 (label-sep-len (kview:label-separator-length kview)))
|
|
|
793 (save-excursion
|
|
|
794 (set-buffer (kview:buffer kview))
|
|
|
795 (if top-p
|
|
|
796 (progn (goto-char (point-min))
|
|
|
797 (kview:end-of-actual-line)
|
|
|
798 ;; Terminate when no further cells to process.
|
|
|
799 (while (progn
|
|
|
800 (setq results (cons (funcall func kview) results))
|
|
|
801 (kcell-view:next visible-p label-sep-len))))
|
|
|
802 (let ((cell-indent (kcell-view:indent nil label-sep-len)))
|
|
|
803 ;; Terminate when no further cells or when reach a cell at an equal
|
|
|
804 ;; or higher level in the kotl than the first cell that we processed.
|
|
|
805 (while (and (progn (setq results (cons (funcall func kview) results))
|
|
|
806 (kcell-view:next visible-p label-sep-len))
|
|
|
807 (> (kcell-view:indent nil label-sep-len)
|
|
|
808 cell-indent))))))
|
|
|
809 (nreverse results)))
|
|
|
810
|
|
|
811 (defun kview:move (from-start from-end to-start from-indent to-indent
|
|
|
812 &optional copy-p fill-p)
|
|
|
813 "Move tree between FROM-START and FROM-END to TO-START, changing FROM-INDENT to TO-INDENT.
|
|
|
814 Copy tree if optional COPY-P is non-nil. Refill cells if optional
|
|
|
815 FILL-P is non-nil. Leave point at TO-START."
|
|
|
816 (let ((region (buffer-substring from-start from-end))
|
|
|
817 (new-start (set-marker (make-marker) to-start))
|
|
|
818 collapsed-cells expr new-end space)
|
|
|
819 ;;
|
|
|
820 ;; Move or copy tree region to new location.
|
|
|
821 (or copy-p (delete-region from-start from-end))
|
|
|
822 (goto-char new-start)
|
|
|
823 (insert region)
|
|
|
824 (setq new-end (point))
|
|
|
825 ;;
|
|
|
826 ;; Change indentation of tree cells.
|
|
|
827 (if (/= from-indent to-indent)
|
|
|
828 (save-restriction
|
|
|
829 (narrow-to-region new-start new-end)
|
|
|
830 ;; Store list of which cells are presently collapsed.
|
|
|
831 (setq collapsed-cells
|
|
|
832 (kview:map-tree
|
|
|
833 (function (lambda (view)
|
|
|
834 ;; Use free variable label-sep-len bound in
|
|
|
835 ;; kview:map-tree for speed.
|
|
|
836 (kcell-view:collapsed-p nil label-sep-len)))
|
|
|
837 kview t))
|
|
|
838 ;; Expand all cells.
|
|
|
839 (subst-char-in-region new-start new-end ?\r ?\n t)
|
|
|
840 ;;
|
|
|
841 (goto-char (point-min))
|
|
|
842 (if (< from-indent to-indent)
|
|
|
843 ;; Add indent
|
|
|
844 (progn
|
|
|
845 (setq expr (make-string (1+ (- to-indent from-indent)) ?\ ))
|
|
|
846 (while (re-search-forward "^ " nil t)
|
|
|
847 (replace-match expr t t)
|
|
|
848 (forward-line 1)))
|
|
|
849 ;; Reduce indent in all but first cell lines.
|
|
|
850 (setq expr (concat "^" (make-string
|
|
|
851 (- from-indent to-indent) ?\ )))
|
|
|
852 (while (re-search-forward expr nil t)
|
|
|
853 (replace-match "" t t)
|
|
|
854 (forward-line 1))
|
|
|
855 ;; Reduce indent in first cell lines which may have an
|
|
|
856 ;; autonumber or other cell delimiter.
|
|
|
857 (setq space (- from-indent to-indent
|
|
|
858 (kview:label-separator-length kview)
|
|
|
859 1))
|
|
|
860 (if (zerop space)
|
|
|
861 nil
|
|
|
862 (setq expr (concat "^" (make-string
|
|
|
863 (- from-indent to-indent
|
|
|
864 (kview:label-separator-length kview)
|
|
|
865 1)
|
|
|
866 ?\ )))
|
|
|
867 (kview:map-tree
|
|
|
868 (function (lambda (view)
|
|
|
869 (save-excursion
|
|
|
870 (beginning-of-line)
|
|
|
871 (if (looking-at expr)
|
|
|
872 (replace-match "" t t)))))
|
|
|
873 kview t)))
|
|
|
874 ;;
|
|
|
875 (if fill-p
|
|
|
876 ;; Refill cells without no-fill attribute.
|
|
|
877 (kview:map-tree (function (lambda (view)
|
|
|
878 (kotl-mode:fill-cell nil t)))
|
|
|
879 kview t))
|
|
|
880 ;;
|
|
|
881 ;; Collapse temporarily expanded cells.
|
|
|
882 (if (delq nil collapsed-cells)
|
|
|
883 (kview:map-tree
|
|
|
884 (function
|
|
|
885 (lambda (view)
|
|
|
886 (if (car collapsed-cells)
|
|
|
887 ;; Use free variable label-sep-len bound in
|
|
|
888 ;; kview:map-tree for speed.
|
|
|
889 (kcell-view:collapse nil label-sep-len))
|
|
|
890 (setq collapsed-cells (cdr collapsed-cells))))
|
|
|
891 kview t))))
|
|
|
892 ;;
|
|
|
893 (goto-char new-start)
|
|
|
894 ;;
|
|
|
895 ;; Delete temporary markers.
|
|
|
896 (set-marker new-start nil)))
|
|
|
897
|
|
|
898 (defun kview:set-buffer-name (kview new-name)
|
|
|
899 "Set kview's buffer name to NEW-NAME."
|
|
|
900 (if (kview:is-p kview)
|
|
|
901 (save-excursion
|
|
|
902 (let ((buf (kview:buffer kview)))
|
|
|
903 (if buf (set-buffer buf)))
|
|
|
904 (kview:set-attr kview 'view-buffer-name new-name))
|
|
|
905 (error "(kview:set-buffer-name): Invalid kview argument")))
|
|
|
906
|
|
|
907 (defun kview:set-label-type (kview new-type)
|
|
|
908 "Change kview's label display type to NEW-TYPE, updating all displayed labels.
|
|
|
909 See documentation for variable, kview:default-label-type, for
|
|
|
910 valid values of NEW-TYPE."
|
|
|
911 (interactive (list kview
|
|
|
912 (let ((completion-ignore-case)
|
|
|
913 (label-type (kview:label-type kview))
|
|
|
914 new-type-str)
|
|
|
915 (if (string=
|
|
|
916 ""
|
|
|
917 (setq new-type-str
|
|
|
918 (completing-read
|
|
|
919 (format "View label type (current = %s): "
|
|
|
920 label-type)
|
|
|
921 '(("alpha") ("legal") ("id") ("no")
|
|
|
922 ("partial-alpha") ("star"))
|
|
|
923 nil t)))
|
|
|
924 label-type
|
|
|
925 (intern new-type-str)))))
|
|
|
926 (if (not (memq new-type '(alpha legal id no partial-alpha star)))
|
|
|
927 (error "(kview:set-label-type): Invalid label type, '%s'." new-type))
|
|
|
928 ;; Disable use of partial-alpha for now since it is broken.
|
|
|
929 (if (eq new-type 'partial-alpha)
|
|
|
930 (error "(kview:set-label-type): Partial-alpha labels don't work, choose another type"))
|
|
|
931 (let ((old-label-type (kview:label-type kview)))
|
|
|
932 (if (eq old-label-type new-type)
|
|
|
933 nil
|
|
|
934 (klabel-type:set-labels new-type)
|
|
|
935 (kview:set-attr kview 'label-type new-type)
|
|
|
936 (kview:set-functions new-type)
|
|
|
937 (kvspec:update t))))
|
|
|
938
|
|
|
939 (defun kview:top-cell (kview)
|
|
|
940 "Return kview's invisible top cell with idstamp 0 or nil if argument is not a kview."
|
|
|
941 (if (kview:is-p kview)
|
|
|
942 (kview:get-attr kview 'top-cell)))
|
|
|
943
|
|
|
944 (defun kview:valid-position-p (&optional pos)
|
|
|
945 "Return non-nil iff point or optional POS is at a position where editing may occur.
|
|
|
946 The read-only positions between cells and within cell indentations are invalid."
|
|
|
947 (cond ((null pos)
|
|
|
948 (>= (current-column) (kcell-view:indent)))
|
|
|
949 ((not (integer-or-marker-p pos))
|
|
|
950 (error "(kview:valid-position-p): Argument POS not an integer
|
|
|
951 or marker, '%s'" pos))
|
|
|
952 ((or (< pos (point-min)) (> pos (point-max)))
|
|
|
953 (error "(kview:valid-position-p): Invalid POS argument, '%d'"
|
|
|
954 pos))
|
|
|
955 (t (save-excursion
|
|
|
956 (goto-char pos)
|
|
|
957 (>= (current-column) (kcell-view:indent))))))
|
|
|
958
|
|
|
959 ;;; ************************************************************************
|
|
|
960 ;;; Private functions
|
|
|
961 ;;; ************************************************************************
|
|
|
962
|
|
|
963 (defun kview:get-attr (obj attribute)
|
|
|
964 "Return the value of OBJECT's ATTRIBUTE."
|
|
|
965 (car (cdr (memq attribute (car (cdr (memq 'plist obj)))))))
|
|
|
966
|
|
|
967 (defun kview:set-attr (obj attribute value)
|
|
|
968 "Set OBJECT's ATTRIBUTE to VALUE and return VALUE."
|
|
|
969 (let* ((plist-ptr (cdr (memq 'plist obj)))
|
|
|
970 (plist (car plist-ptr))
|
|
|
971 (attr (memq attribute plist)))
|
|
|
972 (if attr
|
|
|
973 (setcar (cdr attr) value)
|
|
|
974 (setcar plist-ptr
|
|
|
975 (nconc (list attribute value) plist)))
|
|
|
976 value))
|
|
|
977
|
|
|
978 (defun kview:set-functions (label-type)
|
|
|
979 "Setup functions which handle labels of LABEL-TYPE for current view."
|
|
|
980 (kview:set-attr kview 'label-function (klabel-type:function label-type))
|
|
|
981 (kview:set-attr kview 'label-child (klabel-type:child label-type))
|
|
|
982 (kview:set-attr kview 'label-increment (klabel-type:increment label-type))
|
|
|
983 (kview:set-attr kview 'label-parent (klabel-type:parent label-type))
|
|
|
984 (kview:set-attr kview 'to-label-end (klabel-type:to-label-end label-type)))
|
|
|
985
|
|
|
986 (defun kview:set-label-separator (label-separator &optional set-default-p)
|
|
|
987 "Set the LABEL-SEPARATOR (a string) between labels and cell contents for the current kview.
|
|
|
988 With optional prefix arg SET-DEFAULT-P, the default separator value used for
|
|
|
989 new outlines is also set to this new value."
|
|
|
990 (interactive
|
|
|
991 (progn (barf-if-buffer-read-only)
|
|
|
992 (list (if (kview:is-p kview)
|
|
|
993 (read-string
|
|
|
994 (format
|
|
|
995 "Change current%s label separator from \"%s\" to: "
|
|
|
996 (if current-prefix-arg " and default" "")
|
|
|
997 (kview:label-separator kview))))
|
|
|
998 current-prefix-arg)))
|
|
|
999
|
|
|
1000 (barf-if-buffer-read-only)
|
|
|
1001 (cond ((not (kview:is-p kview))
|
|
|
1002 (error "(kview:set-label-separator): This is not a koutline"))
|
|
|
1003 ((not (stringp label-separator))
|
|
|
1004 (error "(kview:set-label-separator): Invalid separator, \"%s\""
|
|
|
1005 label-separator))
|
|
|
1006 ((< (length label-separator) 2)
|
|
|
1007 (error "(kview:set-label-separator): Separator must be two or more characters, \"%s\""
|
|
|
1008 label-separator)))
|
|
|
1009
|
|
|
1010 (let* ((old-sep-len (kview:label-separator-length kview))
|
|
|
1011 (sep-len (length label-separator))
|
|
|
1012 (sep-len-increase (- sep-len old-sep-len))
|
|
|
1013 (indent)
|
|
|
1014 (reindent-function
|
|
|
1015 (cond ((zerop sep-len-increase)
|
|
|
1016 (function (lambda ())))
|
|
|
1017 ((> sep-len-increase 0)
|
|
|
1018 ;; Increase indent in each cell line.
|
|
|
1019 (function (lambda ()
|
|
|
1020 (goto-char (point-min))
|
|
|
1021 (setq indent (make-string
|
|
|
1022 sep-len-increase ?\ ))
|
|
|
1023 (while (re-search-forward "[^\n\r][\n\r] " nil t)
|
|
|
1024 (insert indent)))))
|
|
|
1025 (t
|
|
|
1026 ;; Decrease indent in each cell line.
|
|
|
1027 (function (lambda ()
|
|
|
1028 (goto-char (point-min))
|
|
|
1029 (setq indent
|
|
|
1030 (concat "[^\n\r][\n\r]"
|
|
|
1031 (make-string
|
|
|
1032 (- sep-len-increase) ?\ )))
|
|
|
1033 (while (re-search-forward indent nil t)
|
|
|
1034 (delete-region
|
|
|
1035 (+ (match-beginning 0) 2) (match-end 0))))))))
|
|
|
1036 pos)
|
|
|
1037 (save-excursion
|
|
|
1038 (goto-char (point-min))
|
|
|
1039 (kproperty:replace-separator pos label-separator old-sep-len)
|
|
|
1040 ;; Reindent all lines in cells except the first line which has already
|
|
|
1041 ;; been done.
|
|
|
1042 (funcall reindent-function))
|
|
|
1043 (kview:set-attr kview 'label-separator label-separator)
|
|
|
1044 (kview:set-attr kview 'label-separator-length sep-len)
|
|
|
1045 (if set-default-p
|
|
|
1046 (setq kview:default-label-separator label-separator))))
|
|
|
1047
|
|
|
1048 (provide 'kview)
|
