Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/kotl/kview.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: 6/30/93 10 ;; ORIG-DATE: 6/30/93
11 ;; LAST-MOD: 6-Mar-97 at 01:16:42 by Bob Weiner 11 ;; LAST-MOD: 2-Nov-95 at 00:52:52 by Bob Weiner
12
13 ;;; ************************************************************************ 12 ;;; ************************************************************************
14 ;;; Other required Lisp Libraries 13 ;;; Other required Lisp Libraries
15 ;;; ************************************************************************ 14 ;;; ************************************************************************
16 (mapcar 'require '(klabel kfill hypb)) 15 (mapcar 'require '(klabel kfill hypb))
17 16
42 (defvar kview:default-label-type 'alpha 41 (defvar kview:default-label-type 'alpha
43 "*Default label-type to use for new koutlines. 42 "*Default label-type to use for new koutlines.
44 It must be one of the following symbols: 43 It must be one of the following symbols:
45 no for no labels 44 no for no labels
46 id for permanent idstamp labels, e.g. 001, 002, etc. 45 id for permanent idstamp labels, e.g. 001, 002, etc.
47 alpha for `1a2' full alphanumeric labels 46 alpha for '1a2' full alphanumeric labels
48 legal for `1.1.2' labels 47 legal for '1.1.2' labels
49 partial-alpha for partial alphanumeric labels, e.g. `2' for node `1a2' 48 partial-alpha for partial alphanumeric labels, e.g. '2' for node '1a2'
50 star for multi-star labeling, e.g. `***'.") 49 star for multi-star labeling, e.g. '***'.")
51 50
52 (defvar kview:default-level-indent 3 51 (defvar kview:default-level-indent 3
53 "*Default number of spaces to indent each succeeding level in koutlines.") 52 "*Default number of spaces to indent each succeeding level in koutlines.")
54 53
55 ;;; ************************************************************************ 54 ;;; ************************************************************************
293 "Return contents of cell line at point or optional POS as a string." 292 "Return contents of cell line at point or optional POS as a string."
294 (save-excursion 293 (save-excursion
295 (if pos (goto-char pos)) 294 (if pos (goto-char pos))
296 (if (kview:valid-position-p) 295 (if (kview:valid-position-p)
297 (buffer-substring 296 (buffer-substring
298 (kotl-mode:start-of-line) 297 (kotl-mode:beginning-of-line)
299 (kotl-mode:end-of-line)) 298 (kotl-mode:end-of-line))
300 (error "(kcell-view:line): Invalid position, `%d'" (point))))) 299 (error "(kcell-view:line): Invalid position, '%d'" (point)))))
301 300
302 (defun kcell-view:next (&optional visible-p label-sep-len) 301 (defun kcell-view:next (&optional visible-p label-sep-len)
303 "Move to start of next cell within current view. 302 "Move to start of next cell within current view.
304 With optional VISIBLE-P, consider only visible cells. 303 With optional VISIBLE-P, consider only visible cells.
305 Return t unless no next cell." 304 Return t unless no next cell."
401 (t (error "(kcell-view:to-label-end): Can't find end of current cell's label")))) 400 (t (error "(kcell-view:to-label-end): Can't find end of current cell's label"))))
402 401
403 (defun kcell-view:reference (&optional pos relative-dir) 402 (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. 403 "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 404 The reference is a string of the form, \"<kcell-file, cell-ref>\" where
406 cell-ref is as described in the documentation for `kcell:ref-to-id'. 405 cell-ref is as described in the documentation for 'kcell:ref-to-id'.
407 Kcell-file is made relative to optional RELATIVE-DIR before it is returned." 406 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) 407 (format "<%s, %s=%s>" (hpath:relative-to buffer-file-name relative-dir)
409 (kcell-view:label pos) (kcell-view:idstamp pos))) 408 (kcell-view:label pos) (kcell-view:idstamp pos)))
410 409
411 (defun kcell-view:remove-attr (attribute &optional pos) 410 (defun kcell-view:remove-attr (attribute &optional pos)
472 Optional ID-COUNTER is the maximum permanent id previously given out in this 471 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, 472 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. 473 BLANK-LINES, LEVELS-TO-SHOW, and LINES-TO-SHOW may also be given, otherwise default values are used.
475 474
476 See documentation of: 475 See documentation of:
477 `kview:default-label-type' for LABEL-TYPE, 476 'kview:default-label-type' for LABEL-TYPE,
478 `kview:default-level-indent' for LEVEL-INDENT, 477 'kview:default-level-indent' for LEVEL-INDENT,
479 `kview:default-label-separator' for LABEL-SEPARATOR, 478 'kview:default-label-separator' for LABEL-SEPARATOR,
480 `kview:default-label-min-width' for LABEL-MIN-WIDTH, 479 'kview:default-label-min-width' for LABEL-MIN-WIDTH,
481 `kview:default-blank-lines' for BLANK-LINES, 480 'kview:default-blank-lines' for BLANK-LINES,
482 `kview:default-levels-to-show' for LEVELS-TO-SHOW, 481 'kview:default-levels-to-show' for LEVELS-TO-SHOW,
483 `kview:default-lines-to-show' for LINES-TO-SHOW." 482 'kview:default-lines-to-show' for LINES-TO-SHOW."
484 483
485 (let ((buf (get-buffer buffer-name))) 484 (let ((buf (get-buffer buffer-name)))
486 (cond ((null buf) 485 (cond ((null buf)
487 (error "(kview:create): No such buffer, `%s'." buffer-name)) 486 (error "(kview:create): No such buffer, '%s'." buffer-name))
488 ((or (null id-counter) (= id-counter 0)) 487 ((or (null id-counter) (= id-counter 0))
489 (setq id-counter 0)) 488 (setq id-counter 0))
490 ((not (integerp id-counter)) 489 ((not (integerp id-counter))
491 (error "(kview:create): 2nd arg, `%s', must be an integer." id-counter))) 490 (error "(kview:create): 2nd arg, '%s', must be an integer." id-counter)))
492 (set-buffer buf) 491 (set-buffer buf)
493 (if (and (boundp 'kview) (eq (kview:buffer kview) buf)) 492 (if (and (boundp 'kview) (eq (kview:buffer kview) buf))
494 ;; Don't recreate view if it exists. 493 ;; Don't recreate view if it exists.
495 nil 494 nil
496 (make-local-variable 'kview) 495 (make-local-variable 'kview)
730 729
731 `Cell-indent' contains the indentation value of the first cell mapped when 730 `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' 731 FUNC is called so that it may test against this value. `Label-sep-len'
733 contains the label separator length. 732 contains the label separator length.
734 733
735 See also `kview:map-siblings' and `kview:map-tree'." 734 See also 'kview:map-siblings' and 'kview:map-tree'."
736 (save-excursion 735 (save-excursion
737 (set-buffer (kview:buffer kview)) 736 (set-buffer (kview:buffer kview))
738 (let ((results) 737 (let ((results)
739 (label-sep-len (kview:label-separator-length kview))) 738 (label-sep-len (kview:label-separator-length kview)))
740 (if first-p 739 (if first-p
759 758
760 `Cell-indent' contains the indentation value of the first cell mapped when 759 `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' 760 FUNC is called so that it may test against this value. `Label-sep-len'
762 contains the label separator length. 761 contains the label separator length.
763 762
764 See also `kview:map-branch' and `kview:map-tree'." 763 See also 'kview:map-branch' and 'kview:map-tree'."
765 (save-excursion 764 (save-excursion
766 (set-buffer (kview:buffer kview)) 765 (set-buffer (kview:buffer kview))
767 (let ((results) 766 (let ((results)
768 (label-sep-len (kview:label-separator-length kview))) 767 (label-sep-len (kview:label-separator-length kview)))
769 (if first-p 768 (if first-p
786 785
787 `Cell-indent' contains the indentation value of the first cell mapped when 786 `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' 787 FUNC is called so that it may test against this value. `Label-sep-len'
789 contains the label separator length. 788 contains the label separator length.
790 789
791 See also `kview:map-branch' and `kview:map-siblings'." 790 See also 'kview:map-branch' and 'kview:map-siblings'."
792 (let ((results) 791 (let ((results)
793 (label-sep-len (kview:label-separator-length kview))) 792 (label-sep-len (kview:label-separator-length kview)))
794 (save-excursion 793 (save-excursion
795 (set-buffer (kview:buffer kview)) 794 (set-buffer (kview:buffer kview))
796 (if top-p 795 (if top-p
923 ("partial-alpha") ("star")) 922 ("partial-alpha") ("star"))
924 nil t))) 923 nil t)))
925 label-type 924 label-type
926 (intern new-type-str))))) 925 (intern new-type-str)))))
927 (if (not (memq new-type '(alpha legal id no partial-alpha star))) 926 (if (not (memq new-type '(alpha legal id no partial-alpha star)))
928 (error "(kview:set-label-type): Invalid label type, `%s'." new-type)) 927 (error "(kview:set-label-type): Invalid label type, '%s'." new-type))
929 ;; Disable use of partial-alpha for now since it is broken. 928 ;; Disable use of partial-alpha for now since it is broken.
930 (if (eq new-type 'partial-alpha) 929 (if (eq new-type 'partial-alpha)
931 (error "(kview:set-label-type): Partial-alpha labels don't work, choose another type")) 930 (error "(kview:set-label-type): Partial-alpha labels don't work, choose another type"))
932 (let ((old-label-type (kview:label-type kview))) 931 (let ((old-label-type (kview:label-type kview)))
933 (if (eq old-label-type new-type) 932 (if (eq old-label-type new-type)
947 The read-only positions between cells and within cell indentations are invalid." 946 The read-only positions between cells and within cell indentations are invalid."
948 (cond ((null pos) 947 (cond ((null pos)
949 (>= (current-column) (kcell-view:indent))) 948 (>= (current-column) (kcell-view:indent)))
950 ((not (integer-or-marker-p pos)) 949 ((not (integer-or-marker-p pos))
951 (error "(kview:valid-position-p): Argument POS not an integer 950 (error "(kview:valid-position-p): Argument POS not an integer
952 or marker, `%s'" pos)) 951 or marker, '%s'" pos))
953 ((or (< pos (point-min)) (> pos (point-max))) 952 ((or (< pos (point-min)) (> pos (point-max)))
954 (error "(kview:valid-position-p): Invalid POS argument, `%d'" 953 (error "(kview:valid-position-p): Invalid POS argument, '%d'"
955 pos)) 954 pos))
956 (t (save-excursion 955 (t (save-excursion
957 (goto-char pos) 956 (goto-char pos)
958 (>= (current-column) (kcell-view:indent)))))) 957 (>= (current-column) (kcell-view:indent))))))
959 958