Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/kotl/klabel.el @ 70:131b0175ea99 r20-0b30

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