Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/kotl/klabel.el @ 114:8619ce7e4c50 r20-1b9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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-"