Mercurial > hg > xemacs-beta
comparison lisp/hyperbole/kotl/klabel.el @ 114:8619ce7e4c50 r20-1b9
Import from CVS: tag r20-1b9
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:21:54 +0200 |
parents | 131b0175ea99 |
children |
comparison
equal
deleted
inserted
replaced
113:2ec2fe4a4c89 | 114:8619ce7e4c50 |
---|---|
6 ;; KEYWORDS: outlines, wp | 6 ;; KEYWORDS: outlines, wp |
7 ;; | 7 ;; |
8 ;; AUTHOR: Bob Weiner & Kellie Clark | 8 ;; AUTHOR: Bob Weiner & Kellie Clark |
9 ;; | 9 ;; |
10 ;; ORIG-DATE: 17-Apr-94 | 10 ;; ORIG-DATE: 17-Apr-94 |
11 ;; LAST-MOD: 1-Nov-95 at 02:33:23 by Bob Weiner | 11 ;; LAST-MOD: 6-Mar-97 at 01:19:02 by Bob Weiner |
12 | |
12 ;;; ************************************************************************ | 13 ;;; ************************************************************************ |
13 ;;; Public variables | 14 ;;; Public variables |
14 ;;; ************************************************************************ | 15 ;;; ************************************************************************ |
15 | 16 |
16 (defvar klabel-type:changing-flag nil | 17 (defvar klabel-type:changing-flag nil |
45 (error | 46 (error |
46 "(klabel:level): Can't compute the level of an idstamp label")) | 47 "(klabel:level): Can't compute the level of an idstamp label")) |
47 ((eq label-type 'partial-alpha) | 48 ((eq label-type 'partial-alpha) |
48 (error | 49 (error |
49 "(klabel:level): Can't compute the level of a partial-alpha label")) | 50 "(klabel:level): Can't compute the level of a partial-alpha label")) |
50 (t (error "(klabel:level): Invalid label type setting: '%s'" | 51 (t (error "(klabel:level): Invalid label type setting: `%s'" |
51 label-type))))) | 52 label-type))))) |
52 | 53 |
53 (defun klabel:parent (label) | 54 (defun klabel:parent (label) |
54 "Return LABEL's parent label." | 55 "Return LABEL's parent label." |
55 (funcall (kview:get-attr kview 'label-parent) label)) | 56 (funcall (kview:get-attr kview 'label-parent) label)) |
67 (function | 68 (function |
68 (lambda (label) | 69 (lambda (label) |
69 (error | 70 (error |
70 "(klabel:child-id): Can't compute child of idstamp label")))) | 71 "(klabel:child-id): Can't compute child of idstamp label")))) |
71 (t (error | 72 (t (error |
72 "(klabel-type:child): Invalid label type setting: '%s'" | 73 "(klabel-type:child): Invalid label type setting: `%s'" |
73 label-type)))) | 74 label-type)))) |
74 | 75 |
75 (defun klabel-type:increment (label-type) | 76 (defun klabel-type:increment (label-type) |
76 "Return function which computes sibling cell label of LABEL-TYPE." | 77 "Return function which computes sibling cell label of LABEL-TYPE." |
77 (cond ((memq label-type '(alpha legal partial-alpha)) | 78 (cond ((memq label-type '(alpha legal partial-alpha)) |
94 (lambda (label) | 95 (lambda (label) |
95 (if (string-equal label "0") | 96 (if (string-equal label "0") |
96 (error "(klabel:increment-no): 0 cell cannot have a sibling") | 97 (error "(klabel:increment-no): 0 cell cannot have a sibling") |
97 (error "(klabel:increment-id): Can't compute sibling of idstamp label"))))) | 98 (error "(klabel:increment-id): Can't compute sibling of idstamp label"))))) |
98 (t (error | 99 (t (error |
99 "(klabel:increment): Invalid label type setting: '%s'" | 100 "(klabel:increment): Invalid label type setting: `%s'" |
100 label-type)))) | 101 label-type)))) |
101 | 102 |
102 (defun klabel-type:parent (label-type) | 103 (defun klabel-type:parent (label-type) |
103 "Return function which computes parent cell label of LABEL-TYPE." | 104 "Return function which computes parent cell label of LABEL-TYPE." |
104 (cond ((memq label-type '(alpha legal partial-alpha)) | 105 (cond ((memq label-type '(alpha legal partial-alpha)) |
125 (function | 126 (function |
126 (lambda (label) | 127 (lambda (label) |
127 (error | 128 (error |
128 "(klabel:parent-id): Can't compute parent of idstamp label")))) | 129 "(klabel:parent-id): Can't compute parent of idstamp label")))) |
129 (t (error | 130 (t (error |
130 "(klabel-type:parent): Invalid label type setting: '%s'" | 131 "(klabel-type:parent): Invalid label type setting: `%s'" |
131 label-type)))) | 132 label-type)))) |
132 | 133 |
133 ;;; | 134 ;;; |
134 ;;; alpha klabels | 135 ;;; alpha klabels |
135 ;;; | 136 ;;; |
209 (error "(klabel:increment-legal): 0 cell cannot have a sibling")) | 210 (error "(klabel:increment-legal): 0 cell cannot have a sibling")) |
210 ((string-match "[0-9]+$" label) | 211 ((string-match "[0-9]+$" label) |
211 (concat (substring label 0 (match-beginning 0)) | 212 (concat (substring label 0 (match-beginning 0)) |
212 (int-to-string | 213 (int-to-string |
213 (1+ (string-to-int (substring label (match-beginning 0))))))) | 214 (1+ (string-to-int (substring label (match-beginning 0))))))) |
214 (t (error "(klabel:increment-legal): Invalid label, '%s'" label)))) | 215 (t (error "(klabel:increment-legal): Invalid label, `%s'" label)))) |
215 | 216 |
216 (defun klabel:level-legal (label) | 217 (defun klabel:level-legal (label) |
217 "Return outline level as an integer of legal-style LABEL. | 218 "Return outline level as an integer of legal-style LABEL. |
218 First visible outline cell is level 1." | 219 First visible outline cell is level 1." |
219 (if (string-equal label "0") | 220 (if (string-equal label "0") |
241 ;;; | 242 ;;; |
242 ;; Default label-type to use for new views. | 243 ;; Default label-type to use for new views. |
243 ;; It must be one of the following symbols: | 244 ;; It must be one of the following symbols: |
244 ;; no for no labels, | 245 ;; no for no labels, |
245 ;; id for permanent idstamp labels, e.g. 001, 002, etc. | 246 ;; id for permanent idstamp labels, e.g. 001, 002, etc. |
246 ;; alpha for '1a2' full alphanumeric labels | 247 ;; alpha for `1a2' full alphanumeric labels |
247 ;; legal for '1.1.2' labels | 248 ;; legal for `1.1.2' labels |
248 ;; partial-alpha for partial alphanumeric labels, e.g. '2' for node '1a2' | 249 ;; partial-alpha for partial alphanumeric labels, e.g. `2' for node `1a2' |
249 ;; star for multi-star labeling, e.g. '***'. | 250 ;; star for multi-star labeling, e.g. `***'. |
250 | 251 |
251 ;; | 252 ;; |
252 ;; Functions to compute sibling and child labels for particular label types. | 253 ;; Functions to compute sibling and child labels for particular label types. |
253 ;; | 254 ;; |
254 (defun klabel-type:function (&optional label-type) | 255 (defun klabel-type:function (&optional label-type) |
350 (function | 351 (function |
351 (lambda () | 352 (lambda () |
352 (if (re-search-backward | 353 (if (re-search-backward |
353 "\\(\\`\\|[\n\r][\n\r]\\)[ \t]*0[0-9]+" nil t) | 354 "\\(\\`\\|[\n\r][\n\r]\\)[ \t]*0[0-9]+" nil t) |
354 (goto-char (match-end 0))))))))) | 355 (goto-char (match-end 0))))))))) |
355 (error "(kview:to-label-end): Invalid label type: '%s'" label-type))) | 356 (error "(kview:to-label-end): Invalid label type: `%s'" label-type))) |
356 | 357 |
357 (defun klabel-type:star-label (prev-label &optional child-p) | 358 (defun klabel-type:star-label (prev-label &optional child-p) |
358 "Return full star label, e.g. ***, for cell following PREV-LABEL's cell. | 359 "Return full star label, e.g. ***, for cell following PREV-LABEL's cell. |
359 With optional CHILD-P, return label for first child cell of PREV-LABEL cell." | 360 With optional CHILD-P, return label for first child cell of PREV-LABEL cell." |
360 (if child-p | 361 (if child-p |
377 "1") | 378 "1") |
378 ((eq label-type 'id) (kcell-view:idstamp)) | 379 ((eq label-type 'id) (kcell-view:idstamp)) |
379 ((eq label-type 'no) "") | 380 ((eq label-type 'no) "") |
380 ((eq label-type 'star) "*") | 381 ((eq label-type 'star) "*") |
381 (t (error | 382 (t (error |
382 "(klabel-type:set-labels): Invalid label type: '%s'" | 383 "(klabel-type:set-labels): Invalid label type: `%s'" |
383 label-type)))) | 384 label-type)))) |
384 (let ((klabel-type:changing-flag t)) | 385 (let ((klabel-type:changing-flag t)) |
385 (klabel-type:update-labels-from-point label-type first-label))))) | 386 (klabel-type:update-labels-from-point label-type first-label))))) |
386 | 387 |
387 (defun klabel-type:set-alpha (current-cell-label label-sep-len current-indent | 388 (defun klabel-type:set-alpha (current-cell-label label-sep-len current-indent |
601 become bb. If N were -2, 4 would become 2, etc. | 602 become bb. If N were -2, 4 would become 2, etc. |
602 LABEL must be >= 1 or >= a. If LABEL is decremented below 1 or a, an error | 603 LABEL must be >= 1 or >= a. If LABEL is decremented below 1 or a, an error |
603 is signaled." | 604 is signaled." |
604 (if (not (kotl-label:is-p label)) | 605 (if (not (kotl-label:is-p label)) |
605 (error | 606 (error |
606 "(kotl-label:increment): First arg, '%s', must be a kotl-label." | 607 "(kotl-label:increment): First arg, `%s', must be a kotl-label." |
607 label)) | 608 label)) |
608 (let ((int-p) (val 0)) | 609 (let ((int-p) (val 0)) |
609 (if (or (setq int-p (kotl-label:integer-p label)) | 610 (if (or (setq int-p (kotl-label:integer-p label)) |
610 (kotl-label:alpha-p label)) | 611 (kotl-label:alpha-p label)) |
611 ;; Test if trying to decrement below 1 or a. | 612 ;; Test if trying to decrement below 1 or a. |
612 (if int-p | 613 (if int-p |
613 (progn (setq int-p (string-to-int label)) | 614 (progn (setq int-p (string-to-int label)) |
614 (if (> (setq val (+ int-p n)) 0) | 615 (if (> (setq val (+ int-p n)) 0) |
615 (kotl-label:create val) | 616 (kotl-label:create val) |
616 (error "(kotl-label:increment): Decrement of '%s' by '%d' is less than 1." label n))) | 617 (error "(kotl-label:increment): Decrement of `%s' by `%d' is less than 1." label n))) |
617 ;; alpha-p | 618 ;; alpha-p |
618 (if (<= 0 (setq val (+ n (kotl-label:alpha-to-int label)))) | 619 (if (<= 0 (setq val (+ n (kotl-label:alpha-to-int label)))) |
619 (kotl-label:create | 620 (kotl-label:create |
620 (kotl-label:int-to-alpha val)) | 621 (kotl-label:int-to-alpha val)) |
621 (error "(kotl-label:increment): Decrement of '%s' by '%d' is illegal." label n))) | 622 (error "(kotl-label:increment): Decrement of `%s' by `%d' is illegal." label n))) |
622 (error "(kotl-label:increment): label, '%s', must be all digits or alpha characters" label)))) | 623 (error "(kotl-label:increment): label, `%s', must be all digits or alpha characters" label)))) |
623 | 624 |
624 (defun kotl-label:increment-alpha (label) | 625 (defun kotl-label:increment-alpha (label) |
625 "Return alphabetic LABEL incremented by 1. | 626 "Return alphabetic LABEL incremented by 1. |
626 For example, z would become aa, and aa would become bb. LABEL must be >= a." | 627 For example, z would become aa, and aa would become bb. LABEL must be >= a." |
627 (kotl-label:int-to-alpha | 628 (kotl-label:int-to-alpha |
692 (defun klabel:to-kotl-label (label) | 693 (defun klabel:to-kotl-label (label) |
693 "Given full alpha or legal LABEL, return rightmost part, called a kotl-label. | 694 "Given full alpha or legal LABEL, return rightmost part, called a kotl-label. |
694 For example, the full label \"1a2\" has kotl-label \"2\", as does \"1.1.2\"." | 695 For example, the full label \"1a2\" has kotl-label \"2\", as does \"1.1.2\"." |
695 (if (string-match "[0-9]+$\\|[a-zA-Z]+$" label) | 696 (if (string-match "[0-9]+$\\|[a-zA-Z]+$" label) |
696 (substring label (match-beginning 0)) | 697 (substring label (match-beginning 0)) |
697 (error "(klabel:to-kotl-label): Invalid label, '%s'" label))) | 698 (error "(klabel:to-kotl-label): Invalid label, `%s'" label))) |
698 | 699 |
699 (defun klabel-type:update-labels-from-point (label-type first-label) | 700 (defun klabel-type:update-labels-from-point (label-type first-label) |
700 (let ((label-sep-len (kview:label-separator-length kview))) | 701 (let ((label-sep-len (kview:label-separator-length kview))) |
701 (save-excursion | 702 (save-excursion |
702 (funcall (intern-soft (concat "klabel-type:set-" | 703 (funcall (intern-soft (concat "klabel-type:set-" |