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