|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: klabel.el
|
|
|
4 ;; SUMMARY: Display label handling for koutlines.
|
|
|
5 ;; USAGE: GNU Emacs Lisp Library
|
|
|
6 ;; KEYWORDS: outlines, wp
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner & Kellie Clark
|
|
|
9 ;;
|
|
|
10 ;; ORIG-DATE: 17-Apr-94
|
|
36
|
11 ;; LAST-MOD: 6-Mar-97 at 01:19:02 by Bob Weiner
|
|
|
12
|
|
0
|
13 ;;; ************************************************************************
|
|
|
14 ;;; Public variables
|
|
|
15 ;;; ************************************************************************
|
|
|
16
|
|
|
17 (defvar klabel-type:changing-flag nil
|
|
|
18 "Non-nil only while the label type in the current view is being changed.")
|
|
|
19
|
|
|
20 ;;; ************************************************************************
|
|
|
21 ;;; Public functions
|
|
|
22 ;;; ************************************************************************
|
|
|
23
|
|
|
24 ;;;
|
|
|
25 ;;; klabel - koutline display labels
|
|
|
26 ;;;
|
|
|
27
|
|
|
28 (defun klabel:child (label)
|
|
|
29 "Return LABEL's child cell label."
|
|
|
30 (funcall (kview:get-attr kview 'label-child) label))
|
|
|
31
|
|
|
32 (defun klabel:increment (label)
|
|
|
33 "Return LABEL's sibling label."
|
|
|
34 (funcall (kview:get-attr kview 'label-increment) label))
|
|
|
35
|
|
|
36 (defun klabel:level (label)
|
|
|
37 "Return outline level of LABEL using current kview label type."
|
|
|
38 (let ((label-type (kview:label-type kview)))
|
|
|
39 (cond ((memq label-type '(alpha legal))
|
|
|
40 (funcall (intern-soft (concat "klabel:level-"
|
|
|
41 (symbol-name label-type)))
|
|
|
42 label))
|
|
|
43 ((eq label-type 'no) 1)
|
|
|
44 ((eq label-type 'star) (length label))
|
|
|
45 ((eq label-type 'id)
|
|
|
46 (error
|
|
|
47 "(klabel:level): Can't compute the level of an idstamp label"))
|
|
|
48 ((eq label-type 'partial-alpha)
|
|
|
49 (error
|
|
|
50 "(klabel:level): Can't compute the level of a partial-alpha label"))
|
|
36
|
51 (t (error "(klabel:level): Invalid label type setting: `%s'"
|
|
0
|
52 label-type)))))
|
|
|
53
|
|
|
54 (defun klabel:parent (label)
|
|
|
55 "Return LABEL's parent label."
|
|
|
56 (funcall (kview:get-attr kview 'label-parent) label))
|
|
|
57
|
|
|
58 (defun klabel-type:child (label-type)
|
|
|
59 "Return function which computes child cell label of LABEL-TYPE."
|
|
|
60 (cond ((memq label-type '(alpha legal partial-alpha))
|
|
|
61 (intern-soft (concat "klabel:child-"
|
|
|
62 (symbol-name label-type))))
|
|
|
63 ((eq label-type 'no)
|
|
|
64 (function (lambda (label) "")))
|
|
|
65 ((eq label-type 'star)
|
|
|
66 (function (lambda (label) (concat label "*"))))
|
|
|
67 ((eq label-type 'id)
|
|
|
68 (function
|
|
|
69 (lambda (label)
|
|
|
70 (error
|
|
|
71 "(klabel:child-id): Can't compute child of idstamp label"))))
|
|
|
72 (t (error
|
|
36
|
73 "(klabel-type:child): Invalid label type setting: `%s'"
|
|
0
|
74 label-type))))
|
|
|
75
|
|
|
76 (defun klabel-type:increment (label-type)
|
|
|
77 "Return function which computes sibling cell label of LABEL-TYPE."
|
|
|
78 (cond ((memq label-type '(alpha legal partial-alpha))
|
|
|
79 (intern-soft (concat "klabel:increment-"
|
|
|
80 (symbol-name label-type))))
|
|
|
81 ((eq label-type 'no)
|
|
|
82 (function
|
|
|
83 (lambda (label)
|
|
|
84 (if (equal label "0")
|
|
|
85 (error "(klabel:increment-no): 0 cell cannot have a sibling")
|
|
|
86 ""))))
|
|
|
87 ((eq label-type 'star)
|
|
|
88 (function
|
|
|
89 (lambda (label)
|
|
|
90 (if (string-equal label "0")
|
|
|
91 (error "(klabel:increment-star): 0 cell cannot have a sibling")
|
|
|
92 label))))
|
|
|
93 ((eq label-type 'id)
|
|
|
94 (function
|
|
|
95 (lambda (label)
|
|
|
96 (if (string-equal label "0")
|
|
|
97 (error "(klabel:increment-no): 0 cell cannot have a sibling")
|
|
|
98 (error "(klabel:increment-id): Can't compute sibling of idstamp label")))))
|
|
|
99 (t (error
|
|
36
|
100 "(klabel:increment): Invalid label type setting: `%s'"
|
|
0
|
101 label-type))))
|
|
|
102
|
|
|
103 (defun klabel-type:parent (label-type)
|
|
|
104 "Return function which computes parent cell label of LABEL-TYPE."
|
|
|
105 (cond ((memq label-type '(alpha legal partial-alpha))
|
|
|
106 (intern-soft (concat "klabel:parent-"
|
|
|
107 (symbol-name label-type))))
|
|
|
108 ((eq label-type 'no)
|
|
|
109 (function
|
|
|
110 (lambda (label)
|
|
|
111 (if (equal label "0")
|
|
|
112 (error "(klabel:parent-no): 0 cell cannot have a parent")
|
|
|
113 ""))))
|
|
|
114 ((eq label-type 'star)
|
|
|
115 (function
|
|
|
116 (lambda (label)
|
|
|
117 (if (string-equal label "0")
|
|
|
118 (error "(klabel:parent-star): 0 cell cannot have a parent")
|
|
|
119 (substring label 0 (1- (length label)))))))
|
|
|
120 ((eq label-type 'partial-alpha)
|
|
|
121 (function
|
|
|
122 (lambda (label)
|
|
|
123 (error
|
|
|
124 "(klabel:parent-partial-alpha): Can't compute parent of partial alpha label"))))
|
|
|
125 ((eq label-type 'id)
|
|
|
126 (function
|
|
|
127 (lambda (label)
|
|
|
128 (error
|
|
|
129 "(klabel:parent-id): Can't compute parent of idstamp label"))))
|
|
|
130 (t (error
|
|
36
|
131 "(klabel-type:parent): Invalid label type setting: `%s'"
|
|
0
|
132 label-type))))
|
|
|
133
|
|
|
134 ;;;
|
|
|
135 ;;; alpha klabels
|
|
|
136 ;;;
|
|
|
137
|
|
|
138 (defun klabel:child-alpha (label)
|
|
|
139 "Return label for first child of alpha LABEL."
|
|
|
140 (if (or (string-equal label "0")
|
|
|
141 (string-equal label ""))
|
|
|
142 "1"
|
|
|
143 (concat label (if (< (aref label (1- (length label))) ?a)
|
|
|
144 "a" "1"))))
|
|
|
145
|
|
|
146 (defun klabel:increment-alpha (alpha-label)
|
|
|
147 "Increment full ALPHA-LABEL by one and return."
|
|
|
148 (if (string-equal alpha-label "0")
|
|
|
149 (error "(klabel:increment-alpha): 0 cell cannot have a sibling")
|
|
|
150 (let ((kotl-label (klabel:to-kotl-label alpha-label)))
|
|
|
151 (concat (substring alpha-label 0 (- (length kotl-label)))
|
|
|
152 (kotl-label:increment kotl-label 1)))))
|
|
|
153
|
|
|
154 (defun klabel:level-alpha (label)
|
|
|
155 "Return outline level as an integer of alpha-style (Augment-style) LABEL.
|
|
|
156 First visible outline cell is level 1."
|
|
|
157 (if (string-equal label "0")
|
|
|
158 0
|
|
|
159 (let ((i 0)
|
|
|
160 (level 0)
|
|
|
161 (len (length label))
|
|
|
162 (digit-p nil)
|
|
|
163 chr)
|
|
|
164 (while (< i len)
|
|
|
165 (if (and (>= (setq chr (aref label i)) ?0)
|
|
|
166 (<= chr ?9))
|
|
|
167 (or digit-p (setq level (1+ level)
|
|
|
168 digit-p t))
|
|
|
169 ;; assume chr is alpha
|
|
|
170 (if digit-p (setq level (1+ level)
|
|
|
171 digit-p nil)))
|
|
|
172 (setq i (1+ i)))
|
|
|
173 level)))
|
|
|
174
|
|
|
175 (defun klabel:parent-alpha (label)
|
|
|
176 "Return parent label of full alpha LABEL."
|
|
|
177 (cond ((or (string-equal label "0")
|
|
|
178 (string-equal label ""))
|
|
|
179 (error "(klabel:parent-alpha): 0 cell cannot have a parent"))
|
|
|
180 ((kotl-label:integer-p label) ;; level 1 label
|
|
|
181 "0")
|
|
|
182 (t (substring label 0 (- (length (klabel:to-kotl-label label)))))))
|
|
|
183
|
|
|
184 ;;;
|
|
|
185 ;;; partial-alpha klabels
|
|
|
186 ;;;
|
|
|
187
|
|
|
188 (fset 'klabel:child-partial-alpha 'kotl-label:child)
|
|
|
189
|
|
|
190 (defun klabel:increment-partial-alpha (label)
|
|
|
191 "Increment partial alpha LABEL by one and return."
|
|
|
192 (if (string-equal label "0")
|
|
|
193 (error "(klabel:increment-partial-alpha): 0 cell cannot have a sibling")
|
|
|
194 (kotl-label:increment label 1)))
|
|
|
195
|
|
|
196 ;;;
|
|
|
197 ;;; legal klabels
|
|
|
198 ;;;
|
|
|
199
|
|
|
200 (defun klabel:child-legal (label)
|
|
|
201 "Return label for first child of legal LABEL."
|
|
|
202 (if (or (string-equal label "0")
|
|
|
203 (string-equal label ""))
|
|
|
204 "1"
|
|
|
205 (concat label ".1")))
|
|
|
206
|
|
|
207 (defun klabel:increment-legal (label)
|
|
|
208 "Increment full legal LABEL by one and return."
|
|
|
209 (cond ((string-equal label "0")
|
|
|
210 (error "(klabel:increment-legal): 0 cell cannot have a sibling"))
|
|
|
211 ((string-match "[0-9]+$" label)
|
|
|
212 (concat (substring label 0 (match-beginning 0))
|
|
|
213 (int-to-string
|
|
|
214 (1+ (string-to-int (substring label (match-beginning 0)))))))
|
|
36
|
215 (t (error "(klabel:increment-legal): Invalid label, `%s'" label))))
|
|
0
|
216
|
|
|
217 (defun klabel:level-legal (label)
|
|
|
218 "Return outline level as an integer of legal-style LABEL.
|
|
|
219 First visible outline cell is level 1."
|
|
|
220 (if (string-equal label "0")
|
|
|
221 0
|
|
|
222 (let ((i 0)
|
|
|
223 (level 1)
|
|
|
224 (len (length label)))
|
|
|
225 (while (< i len)
|
|
|
226 (if (= (aref label i) ?.)
|
|
|
227 (setq level (1+ level)))
|
|
|
228 (setq i (1+ i)))
|
|
|
229 level)))
|
|
|
230
|
|
|
231 (defun klabel:parent-legal (label)
|
|
|
232 "Return parent label of full legal LABEL."
|
|
|
233 (cond ((or (string-equal label "0")
|
|
|
234 (string-equal label ""))
|
|
|
235 (error "(klabel:parent-legal): 0 cell cannot have a parent"))
|
|
|
236 ((kotl-label:integer-p label) ;; level 1 label
|
|
|
237 "0")
|
|
|
238 (t (substring label 0 (string-match "\\.[0-9]+$" label)))))
|
|
|
239
|
|
|
240 ;;;
|
|
|
241 ;;; klabel-type - Sets display label format and converts among formats
|
|
|
242 ;;;
|
|
|
243 ;; Default label-type to use for new views.
|
|
|
244 ;; It must be one of the following symbols:
|
|
|
245 ;; no for no labels,
|
|
|
246 ;; id for permanent idstamp labels, e.g. 001, 002, etc.
|
|
36
|
247 ;; alpha for `1a2' full alphanumeric labels
|
|
|
248 ;; legal for `1.1.2' labels
|
|
|
249 ;; partial-alpha for partial alphanumeric labels, e.g. `2' for node `1a2'
|
|
|
250 ;; star for multi-star labeling, e.g. `***'.
|
|
0
|
251
|
|
|
252 ;;
|
|
|
253 ;; Functions to compute sibling and child labels for particular label types.
|
|
|
254 ;;
|
|
|
255 (defun klabel-type:function (&optional label-type)
|
|
|
256 "Return function which will return display label for current cell.
|
|
|
257 Label format is optional LABEL-TYPE or the default label type for the current view.
|
|
|
258
|
|
|
259 Function signature is: (func prev-label &optional child-p), where prev-label
|
|
|
260 is the display label of the cell preceding the current one and child-p is
|
|
|
261 non-nil if cell is to be the child of the preceding cell."
|
|
|
262 (or label-type (setq label-type (kview:label-type kview)))
|
|
|
263 (cond ((eq label-type 'no)
|
|
|
264 (function (lambda (prev-label &optional child-p)
|
|
|
265 "")))
|
|
|
266 ((eq label-type 'partial-alpha)
|
|
|
267 (function (lambda (prev-label &optional child-p)
|
|
|
268 (if child-p
|
|
|
269 (if (kotl-label:integer-p prev-label)
|
|
|
270 "a" "1")
|
|
|
271 (kotl-label:increment prev-label 1)))))
|
|
|
272 ((eq label-type 'id)
|
|
|
273 (function (lambda (prev-label &optional child-p)
|
|
|
274 (format "0%d" (kcell-view:idstamp)))))
|
|
|
275 (t (intern-soft (concat "klabel-type:"
|
|
|
276 (symbol-name label-type) "-label")))))
|
|
|
277
|
|
|
278 (defun klabel-type:alpha-label (prev-label &optional child-p)
|
|
|
279 "Return full alphanumeric label, e.g. 1a2, for cell following PREV-LABEL's cell.
|
|
|
280 With optional CHILD-P, return label for first child cell of PREV-LABEL cell."
|
|
|
281 (if child-p
|
|
|
282 (klabel:child prev-label)
|
|
|
283 (klabel:increment prev-label)))
|
|
|
284
|
|
|
285 (defun klabel-type:legal-label (prev-label &optional child-p)
|
|
|
286 "Return full legal label, e.g. 1.1.2, for cell following PREV-LABEL's cell.
|
|
|
287 With optional CHILD-P, return label for first child cell of PREV-LABEL cell."
|
|
|
288 (if child-p
|
|
|
289 (if (string-equal prev-label "0")
|
|
|
290 "1"
|
|
|
291 (concat prev-label ".1"))
|
|
|
292 (let* ((last-part (string-match "[0-9]+$" prev-label))
|
|
|
293 (partial-legal (substring prev-label last-part))
|
|
|
294 (next (kotl-label:create (1+ (string-to-int partial-legal)))))
|
|
|
295 (if (equal last-part prev-label)
|
|
|
296 next
|
|
|
297 (concat (substring prev-label 0 last-part) next)))))
|
|
|
298
|
|
|
299 (defun klabel-type:to-label-end (&optional label-type)
|
|
|
300 "Return function which will search backward to a the end of a cell's label.
|
|
|
301 Label format is optional LABEL-TYPE or the default label type for the current view.
|
|
|
302
|
|
|
303 Function signature is: (). It takes no arguments and begins the search from point."
|
|
|
304 (or label-type (setq label-type (kview:label-type kview)))
|
|
|
305 (or (cdr (assq label-type
|
|
|
306 (list
|
|
|
307 (cons
|
|
|
308 'alpha
|
|
|
309 (function
|
|
|
310 (lambda ()
|
|
|
311 (if (re-search-backward
|
|
|
312 "\\(\\`\\|[\n\r][\n\r]\\)[ \t]*[1-9][0-9a-zA-Z]*"
|
|
|
313 nil t)
|
|
|
314 (goto-char (match-end 0))))))
|
|
|
315 (cons
|
|
|
316 'legal
|
|
|
317 (function
|
|
|
318 (lambda ()
|
|
|
319 (if (re-search-backward
|
|
|
320 "\\(\\`\\|[\n\r][\n\r]\\)[ \t]*[0-9]+\\(\\.[0-9]+\\)*"
|
|
|
321 nil t)
|
|
|
322 (goto-char (match-end 0))))))
|
|
|
323 (cons
|
|
|
324 'star
|
|
|
325 (function
|
|
|
326 (lambda ()
|
|
|
327 (if (re-search-backward
|
|
|
328 "\\(\\`\\|[\n\r][\n\r]\\)[ \t]*\\*+" nil t)
|
|
|
329 (goto-char (match-end 0))))))
|
|
|
330 (cons
|
|
|
331 'no
|
|
|
332 (function
|
|
|
333 (lambda ()
|
|
|
334 (goto-char
|
|
|
335 (if (and (not hyperb:lemacs-p)
|
|
|
336 (string-lessp emacs-version "19.22"))
|
|
|
337 (kproperty:previous-single-change (point) 'kcell)
|
|
|
338 ;; (GNU Emacs V19.22 / Lucid Emacs V19.9) or greater
|
|
|
339 (- (kproperty:previous-single-change
|
|
|
340 (point) 'kcell) 1))))))
|
|
|
341 (cons
|
|
|
342 'partial-alpha
|
|
|
343 (function
|
|
|
344 (lambda ()
|
|
|
345 (if (re-search-backward
|
|
|
346 "\\(\\`\\|[\n\r][\n\r]\\)[ \t]*[0-9]+\\|[a-zA-Z]+"
|
|
|
347 nil t)
|
|
|
348 (goto-char (match-end 0))))))
|
|
|
349 (cons
|
|
|
350 'id
|
|
|
351 (function
|
|
|
352 (lambda ()
|
|
|
353 (if (re-search-backward
|
|
|
354 "\\(\\`\\|[\n\r][\n\r]\\)[ \t]*0[0-9]+" nil t)
|
|
|
355 (goto-char (match-end 0)))))))))
|
|
36
|
356 (error "(kview:to-label-end): Invalid label type: `%s'" label-type)))
|
|
0
|
357
|
|
|
358 (defun klabel-type:star-label (prev-label &optional child-p)
|
|
|
359 "Return full star label, e.g. ***, for cell following PREV-LABEL's cell.
|
|
|
360 With optional CHILD-P, return label for first child cell of PREV-LABEL cell."
|
|
|
361 (if child-p
|
|
|
362 (concat prev-label "*")
|
|
|
363 prev-label))
|
|
|
364
|
|
|
365 ;;
|
|
|
366 ;; Functions to compute labels for cells following point and for all cells in
|
|
|
367 ;; a view.
|
|
|
368 ;;
|
|
|
369
|
|
|
370 (defun klabel-type:set-labels (label-type)
|
|
|
371 "Replace labels of all cells in current view with those of LABEL-TYPE (a symbol)."
|
|
|
372 (let (first-label)
|
|
|
373 (save-excursion
|
|
|
374 (goto-char (point-min))
|
|
|
375 (goto-char (kcell-view:start))
|
|
|
376 (setq first-label
|
|
|
377 (cond ((memq label-type '(alpha legal partial-alpha))
|
|
|
378 "1")
|
|
|
379 ((eq label-type 'id) (kcell-view:idstamp))
|
|
|
380 ((eq label-type 'no) "")
|
|
|
381 ((eq label-type 'star) "*")
|
|
|
382 (t (error
|
|
36
|
383 "(klabel-type:set-labels): Invalid label type: `%s'"
|
|
0
|
384 label-type))))
|
|
|
385 (let ((klabel-type:changing-flag t))
|
|
|
386 (klabel-type:update-labels-from-point label-type first-label)))))
|
|
|
387
|
|
|
388 (defun klabel-type:set-alpha (current-cell-label label-sep-len current-indent
|
|
|
389 per-level-indent &optional current-tree-only)
|
|
|
390 "Set the labels of current cell, its following siblings and their subtrees.
|
|
|
391 CURRENT-CELL-LABEL is the label to display for the current cell.
|
|
|
392 LABEL-SEP-LEN is the length of the separation between a cell's label
|
|
|
393 and the start of its contents."
|
|
|
394 (let (label-prefix label-suffix suffix-val suffix-function opoint)
|
|
|
395 (if current-cell-label
|
|
|
396 (setq label-suffix (klabel:to-kotl-label current-cell-label)
|
|
|
397 label-prefix (substring current-cell-label
|
|
|
398 0 (- (length label-suffix)))
|
|
|
399 suffix-function (if (kotl-label:integer-p label-suffix)
|
|
|
400 (progn (setq suffix-val
|
|
|
401 (string-to-int label-suffix))
|
|
|
402 'int-to-string)
|
|
|
403 (setq suffix-val
|
|
|
404 (kotl-label:alpha-to-int label-suffix))
|
|
|
405 'kotl-label:int-to-alpha)))
|
|
|
406 (while current-cell-label
|
|
|
407 ;; Set current cell's label.
|
|
|
408 (klabel:set current-cell-label label-sep-len)
|
|
|
409 ;; Process any subtrees of current cell.
|
|
|
410 (if (kcell-view:child nil label-sep-len)
|
|
|
411 ;; Recurse over subtree.
|
|
|
412 (klabel-type:set-alpha
|
|
|
413 (klabel:child-alpha current-cell-label)
|
|
|
414 label-sep-len
|
|
|
415 (+ current-indent per-level-indent)
|
|
|
416 per-level-indent))
|
|
|
417 ;; Process next sibling of current cell if any.
|
|
|
418 (setq opoint (point))
|
|
|
419 (if (and (not current-tree-only)
|
|
|
420 (kcell-view:next nil label-sep-len)
|
|
|
421 (= current-indent (kcell-view:indent nil label-sep-len)))
|
|
|
422 (setq suffix-val (1+ suffix-val)
|
|
|
423 label-suffix (funcall suffix-function suffix-val)
|
|
|
424 current-cell-label (concat label-prefix label-suffix))
|
|
|
425 (goto-char opoint)
|
|
|
426 (setq current-cell-label nil)))))
|
|
|
427
|
|
|
428 (defun klabel-type:set-id (current-cell-label label-sep-len &rest ignore)
|
|
|
429 "Set the labels of current cell, its following siblings and their subtrees.
|
|
|
430 CURRENT-CELL-LABEL is the label to display for the current cell."
|
|
|
431 ;; Only need to do this when switching from one label type to another,
|
|
|
432 ;; i.e. when every cell label will be updated. So if not starting with the
|
|
|
433 ;; first cell, do nothing.
|
|
|
434 (if (kotl-mode:first-cell-p)
|
|
|
435 (while (and (klabel:set (kcell-view:idstamp) label-sep-len)
|
|
|
436 (kcell-view:next nil label-sep-len)))))
|
|
|
437
|
|
|
438 (defun klabel-type:set-legal (current-cell-label label-sep-len current-indent
|
|
|
439 per-level-indent &optional current-tree-only)
|
|
|
440 "Set the labels of current cell, its following siblings and their subtrees.
|
|
|
441 CURRENT-CELL-LABEL is the label to display for the current cell.
|
|
|
442 LABEL-SEP-LEN is the length of the separation between a cell's label
|
|
|
443 and the start of its contents."
|
|
|
444 (let (label-prefix label-suffix suffix-val opoint)
|
|
|
445 (if current-cell-label
|
|
|
446 (setq label-suffix (klabel:to-kotl-label current-cell-label)
|
|
|
447 label-prefix (substring current-cell-label
|
|
|
448 0 (- (length label-suffix)))
|
|
|
449 suffix-val (string-to-int label-suffix)))
|
|
|
450 (while current-cell-label
|
|
|
451 ;; Set current cell's label.
|
|
|
452 (klabel:set current-cell-label label-sep-len)
|
|
|
453 ;; Process any subtrees of current cell.
|
|
|
454 (if (kcell-view:child nil label-sep-len)
|
|
|
455 ;; Recurse over subtree.
|
|
|
456 (klabel-type:set-legal
|
|
|
457 (klabel:child-legal current-cell-label)
|
|
|
458 label-sep-len
|
|
|
459 (+ current-indent per-level-indent)
|
|
|
460 per-level-indent))
|
|
|
461 ;; Process next sibling of current cell if any.
|
|
|
462 (setq opoint (point))
|
|
|
463 (if (and (not current-tree-only)
|
|
|
464 (kcell-view:next nil label-sep-len)
|
|
|
465 (= current-indent (kcell-view:indent nil label-sep-len)))
|
|
|
466 (setq suffix-val (1+ suffix-val)
|
|
|
467 label-suffix (int-to-string suffix-val)
|
|
|
468 current-cell-label (concat label-prefix label-suffix))
|
|
|
469 (goto-char opoint)
|
|
|
470 (setq current-cell-label nil)))))
|
|
|
471
|
|
|
472 (defun klabel-type:set-no (current-cell-label label-sep-len &rest ignore)
|
|
|
473 "Set the labels of current cell, its following siblings and their subtrees.
|
|
|
474 CURRENT-CELL-LABEL is the label to display for the current cell."
|
|
|
475 ;; Only need to do this when switching from one label type to another,
|
|
|
476 ;; i.e. when every cell label will be updated. So if not starting with the
|
|
|
477 ;; first cell, do nothing.
|
|
|
478 (if (kotl-mode:first-cell-p)
|
|
|
479 (while (and (klabel:set "" label-sep-len)
|
|
|
480 (kcell-view:next nil label-sep-len)))))
|
|
|
481
|
|
|
482 (defun klabel-type:set-partial-alpha (current-cell-label label-sep-len
|
|
|
483 current-indent per-level-indent
|
|
|
484 &optional current-tree-only)
|
|
|
485 "Set the labels of current cell, its following siblings and their subtrees.
|
|
|
486 CURRENT-CELL-LABEL is the label to display for the current cell.
|
|
|
487 LABEL-SEP-LEN is the length of the separation between a cell's label
|
|
|
488 and the start of its contents."
|
|
|
489 (let (label-suffix suffix-val suffix-function opoint)
|
|
|
490 (if current-cell-label
|
|
|
491 (setq label-suffix current-cell-label
|
|
|
492 suffix-function (if (kotl-label:integer-p label-suffix)
|
|
|
493 (progn (setq suffix-val
|
|
|
494 (string-to-int label-suffix))
|
|
|
495 'int-to-string)
|
|
|
496 (setq suffix-val
|
|
|
497 (kotl-label:alpha-to-int label-suffix))
|
|
|
498 'kotl-label:int-to-alpha)))
|
|
|
499 (while current-cell-label
|
|
|
500 ;; Set current cell's label.
|
|
|
501 (klabel:set current-cell-label label-sep-len)
|
|
|
502 ;; Process any subtrees of current cell.
|
|
|
503 (if (kcell-view:child nil label-sep-len)
|
|
|
504 ;; Recurse over subtree.
|
|
|
505 (klabel-type:set-partial-alpha
|
|
|
506 (klabel:child-partial-alpha current-cell-label)
|
|
|
507 label-sep-len
|
|
|
508 (+ current-indent per-level-indent)
|
|
|
509 per-level-indent))
|
|
|
510 ;; Process next sibling of current cell if any.
|
|
|
511 (setq opoint (point))
|
|
|
512 (if (and (not current-tree-only)
|
|
|
513 (kcell-view:next nil label-sep-len)
|
|
|
514 (= current-indent (kcell-view:indent nil label-sep-len)))
|
|
|
515 (setq suffix-val (1+ suffix-val)
|
|
|
516 label-suffix (funcall suffix-function suffix-val)
|
|
|
517 current-cell-label label-suffix)
|
|
|
518 (goto-char opoint)
|
|
|
519 (setq current-cell-label nil)))))
|
|
|
520
|
|
|
521 (defun klabel-type:set-star (current-cell-label label-sep-len &rest ignore)
|
|
|
522 "Set the labels of current cell, its following siblings and their subtrees.
|
|
|
523 CURRENT-CELL-LABEL is the label to display for the current cell.
|
|
|
524 LABEL-SEP-LEN is the length of the separation between a cell's label
|
|
|
525 and the start of its contents."
|
|
|
526 ;; Only need to do this when switching from one label type to another,
|
|
|
527 ;; i.e. when every cell label will be updated. So if not starting with the
|
|
|
528 ;; first cell, do nothing.
|
|
|
529 (if (kotl-mode:first-cell-p)
|
|
|
530 (while (and (klabel:set (make-string
|
|
|
531 (kcell-view:level nil label-sep-len) ?*)
|
|
|
532 label-sep-len)
|
|
|
533 (kcell-view:next nil label-sep-len)))))
|
|
|
534
|
|
|
535 (defun klabel-type:update-labels (current-cell-label)
|
|
|
536 "Update the labels of current cell, its following siblings and their subtrees.
|
|
|
537 CURRENT-CELL-LABEL is the label to display for the current cell.
|
|
|
538 If, however, it is \"0\", then all cell labels are updated."
|
|
|
539 (let ((label-type (kview:label-type kview)))
|
|
|
540 (if (string-equal current-cell-label "0")
|
|
|
541 ;; Update all cells in view.
|
|
|
542 (klabel-type:set-labels label-type)
|
|
|
543 ;; Update current tree and its siblings only.
|
|
|
544 (klabel-type:update-labels-from-point
|
|
|
545 label-type current-cell-label))))
|
|
|
546
|
|
|
547 (defun klabel-type:update-tree-labels (current-cell-label)
|
|
|
548 "Update the labels of current cell and its subtree.
|
|
|
549 CURRENT-CELL-LABEL is the label to display for the current cell.
|
|
|
550 Use '(klabel-type:update-labels "0")' to update all cells in an outline."
|
|
|
551 (let ((label-type (kview:label-type kview))
|
|
|
552 (label-sep-len (kview:label-separator-length kview)))
|
|
|
553 (save-excursion
|
|
|
554 (funcall (intern-soft (concat "klabel-type:set-"
|
|
|
555 (symbol-name label-type)))
|
|
|
556 first-label label-sep-len
|
|
|
557 (kcell-view:indent nil label-sep-len)
|
|
|
558 (kview:level-indent kview)
|
|
|
559 ;; Update current tree only.
|
|
|
560 t))))
|
|
|
561
|
|
|
562 ;;;
|
|
|
563 ;;; kotl-label--the part of a full label which represents a
|
|
|
564 ;;; kcell's relative position in the koutline hierarchy,
|
|
|
565 ;;; e.g. the full label "1a2" has kotl-label "2".
|
|
|
566 ;;;
|
|
|
567 (defun kotl-label:alpha-to-int (alpha-label)
|
|
|
568 "Return integer value of ALPHA-LABEL, e.g. `b' returns 2.
|
|
|
569 Assumes ALPHA-LABEL is alphabetic."
|
|
|
570 (let ((power (length alpha-label))
|
|
|
571 (digit 0)
|
|
|
572 (min (1- ?a)))
|
|
|
573 (apply '+ (mapcar
|
|
|
574 (function (lambda (chr)
|
|
|
575 (setq digit (- chr min)
|
|
|
576 power (1- power))
|
|
|
577 (* (apply '* (make-list power 26)) digit)
|
|
|
578 ))
|
|
|
579 alpha-label))))
|
|
|
580
|
|
|
581 (defun kotl-label:alpha-p (label)
|
|
|
582 "Return LABEL if LABEL is composed of all alphabetic characters, else return nil."
|
|
|
583 (if (string-match "\\`[a-zA-Z]+\\'" label) label))
|
|
|
584
|
|
|
585 (defun kotl-label:child (label)
|
|
|
586 "Return child label of partial alpha LABEL."
|
|
|
587 (cond ((or (string-equal label "0")
|
|
|
588 (string-equal label ""))
|
|
|
589 "1")
|
|
|
590 ((kotl-label:integer-p label) "a")
|
|
|
591 (t "1")))
|
|
|
592
|
|
|
593 (defun kotl-label:create (int-or-string)
|
|
|
594 "Return new kcell label from INT-OR-STRING."
|
|
|
595 (cond ((integerp int-or-string) (int-to-string int-or-string))
|
|
|
596 ((equal int-or-string "") "0")
|
|
|
597 (t int-or-string)))
|
|
|
598
|
|
|
599 (defun kotl-label:increment (label n)
|
|
|
600 "Return LABEL incremented by N.
|
|
|
601 For example, if N were 1, 2 would become 3, z would become aa, and aa would
|
|
|
602 become bb. If N were -2, 4 would become 2, etc.
|
|
|
603 LABEL must be >= 1 or >= a. If LABEL is decremented below 1 or a, an error
|
|
|
604 is signaled."
|
|
|
605 (if (not (kotl-label:is-p label))
|
|
|
606 (error
|
|
36
|
607 "(kotl-label:increment): First arg, `%s', must be a kotl-label."
|
|
0
|
608 label))
|
|
|
609 (let ((int-p) (val 0))
|
|
|
610 (if (or (setq int-p (kotl-label:integer-p label))
|
|
|
611 (kotl-label:alpha-p label))
|
|
|
612 ;; Test if trying to decrement below 1 or a.
|
|
|
613 (if int-p
|
|
|
614 (progn (setq int-p (string-to-int label))
|
|
|
615 (if (> (setq val (+ int-p n)) 0)
|
|
|
616 (kotl-label:create val)
|
|
36
|
617 (error "(kotl-label:increment): Decrement of `%s' by `%d' is less than 1." label n)))
|
|
0
|
618 ;; alpha-p
|
|
|
619 (if (<= 0 (setq val (+ n (kotl-label:alpha-to-int label))))
|
|
|
620 (kotl-label:create
|
|
|
621 (kotl-label:int-to-alpha val))
|
|
36
|
622 (error "(kotl-label:increment): Decrement of `%s' by `%d' is illegal." label n)))
|
|
|
623 (error "(kotl-label:increment): label, `%s', must be all digits or alpha characters" label))))
|
|
0
|
624
|
|
|
625 (defun kotl-label:increment-alpha (label)
|
|
|
626 "Return alphabetic LABEL incremented by 1.
|
|
|
627 For example, z would become aa, and aa would become bb. LABEL must be >= a."
|
|
|
628 (kotl-label:int-to-alpha
|
|
|
629 (1+ (kotl-label:alpha-to-int label))))
|
|
|
630
|
|
|
631 (defun kotl-label:increment-int (int-string)
|
|
|
632 "Return INT-STRING label incremented by 1.
|
|
|
633 For example, \"14\" would become \"15\"."
|
|
|
634 (int-to-string (1+ (string-to-int int-string))))
|
|
|
635
|
|
|
636 (defun kotl-label:integer-p (label)
|
|
|
637 "Return LABEL iff LABEL is composed of all digits, else return nil."
|
|
|
638 (if (string-match "\\`[0-9]+\\'" label) label))
|
|
|
639
|
|
|
640 ;; This handles partial alphabetic labels with a maximum single level
|
|
|
641 ;; sequence of 17575 items, which = (1- (expt 26 3)), after which it gives
|
|
|
642 ;; invalid results. This should be large enough for any practical cases.
|
|
|
643
|
|
|
644 (defun kotl-label:int-to-alpha (n)
|
|
|
645 "Return alphabetic representation of N as a string.
|
|
|
646 N may be an integer or a string containing an integer."
|
|
|
647 (if (stringp n) (setq n (string-to-int n)))
|
|
|
648 (let ((lbl "") pow26 exp26 quotient remainder)
|
|
|
649 (if (= n 0)
|
|
|
650 ""
|
|
|
651 (setq pow26 (floor (kotl-label:log26
|
|
|
652 (if (= (mod (1- n) 26) 0) n (1- n)))))
|
|
|
653 (while (>= pow26 0)
|
|
|
654 (setq exp26 (expt 26 pow26)
|
|
|
655 quotient (floor (/ n exp26))
|
|
|
656 remainder (mod n exp26))
|
|
|
657 (if (= remainder 0)
|
|
|
658 (setq quotient (- quotient (1+ pow26))
|
|
|
659 n 26)
|
|
|
660 (setq n remainder
|
|
|
661 quotient (max 0 (1- quotient))))
|
|
|
662 (setq lbl (concat lbl (char-to-string (+ quotient ?a)))
|
|
|
663 pow26 (1- pow26)))
|
|
|
664 lbl)))
|
|
|
665
|
|
|
666 (defun kotl-label:is-p (object)
|
|
|
667 "Return non-nil if OBJECT is a KOTL-LABEL."
|
|
|
668 (stringp object))
|
|
|
669
|
|
|
670
|
|
|
671
|
|
|
672 ;;; ************************************************************************
|
|
|
673 ;;; Private functions
|
|
|
674 ;;; ************************************************************************
|
|
|
675
|
|
|
676 (defun klabel:set (new-label &optional label-sep-len)
|
|
|
677 "Replace label displayed in cell at point with NEW-LABEL, which may be a different label type.
|
|
|
678 Return NEW-LABEL string."
|
|
|
679 (let ((modified (buffer-modified-p))
|
|
|
680 (buffer-read-only)
|
|
|
681 (thru-label (- (kcell-view:indent nil label-sep-len)
|
|
|
682 (or label-sep-len
|
|
|
683 (kview:label-separator-length kview)))))
|
|
|
684 (save-excursion
|
|
|
685 (kcell-view:to-label-end)
|
|
|
686 ;; delete backwards thru label
|
|
|
687 (delete-backward-char thru-label)
|
|
|
688 ;; replace with new label, right justified
|
|
|
689 (insert (format (format "%%%ds" thru-label) new-label)))
|
|
|
690 (set-buffer-modified-p modified)
|
|
|
691 new-label))
|
|
|
692
|
|
|
693 (defun klabel:to-kotl-label (label)
|
|
|
694 "Given full alpha or legal LABEL, return rightmost part, called a kotl-label.
|
|
|
695 For example, the full label \"1a2\" has kotl-label \"2\", as does \"1.1.2\"."
|
|
|
696 (if (string-match "[0-9]+$\\|[a-zA-Z]+$" label)
|
|
|
697 (substring label (match-beginning 0))
|
|
36
|
698 (error "(klabel:to-kotl-label): Invalid label, `%s'" label)))
|
|
0
|
699
|
|
|
700 (defun klabel-type:update-labels-from-point (label-type first-label)
|
|
|
701 (let ((label-sep-len (kview:label-separator-length kview)))
|
|
|
702 (save-excursion
|
|
|
703 (funcall (intern-soft (concat "klabel-type:set-"
|
|
|
704 (symbol-name label-type)))
|
|
|
705 first-label label-sep-len
|
|
|
706 (kcell-view:indent nil label-sep-len)
|
|
|
707 (kview:level-indent kview)))))
|
|
|
708
|
|
|
709 (defun kotl-label:log26 (n)
|
|
|
710 "Return log base 26 of integer N."
|
|
|
711 (/ (log10 n)
|
|
|
712 ;; Next line = (log10 26.514147167125703)
|
|
|
713 1.423477662509912))
|
|
|
714
|
|
|
715 (provide 'klabel)
|
