Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/kotl/kotl.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;!emacs
2 ;;
3 ;; FILE: kotl.el
4 ;; SUMMARY: Internal representation of outline kcells used by kviews.
5 ;; USAGE: GNU Emacs Lisp Library
6 ;; KEYWORDS: outlines, wp
7 ;;
8 ;; AUTHOR: Kellie Clark & Bob Weiner
9 ;;
10 ;; ORIG-DATE: 5/1/93
11 ;; LAST-MOD: 29-Oct-95 at 11:13:47 by Bob Weiner
12 ;;
13 ;; This file is part of Hyperbole.
14 ;; Available for use and distribution under the same terms as GNU Emacs.
15 ;;
16 ;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
17 ;; Developed with support from Motorola Inc.
18 ;;
19 ;; DESCRIPTION:
20 ;;
21 ;; DESCRIP-END.
22
23 ;;; ************************************************************************
24 ;;; Other required Elisp libraries
25 ;;; ************************************************************************
26
27 (mapcar 'require '(klabel knode hinit htz))
28
29 ;;; ************************************************************************
30 ;;; Public variables
31 ;;; ************************************************************************
32
33 (defvar kcell:read-only-attributes
34 '(idstamp creator create-time modifier mod-time)
35 "List of kcell attributes which may not be modified by a user.
36 Add to this list but don't remove any of the default elements.")
37
38 ;;; ************************************************************************
39 ;;; Public functions
40 ;;; ************************************************************************
41
42 ;;;
43 ;;; kcell
44 ;;;
45
46 (fset 'kcell:contents 'knode:contents)
47
48 (defun kcell:copy (kcell)
49 "Return a copy of KCELL."
50 (knode:copy kcell))
51
52 (defun kcell:create (contents idstamp &optional plist)
53 "Return a new kcell which stores CONTENTS (a string or nil), has permanent IDSTAMP (an integer), and optional additional property list, PLIST.
54 User id of `creator' of cell and `create-time' are added to cell's PLIST if
55 not already there."
56 (and contents (not (stringp contents))
57 (error "(kcell:create): Invalid `contents' argument: %s" contents))
58 (if (or (not (integerp idstamp)) (< idstamp 0))
59 (error "(kcell:create): Invalid `idstamp' argument: %s" idstamp))
60 (knode:create
61 contents (nconc (list 'idstamp idstamp)
62 (if (memq 'creator plist)
63 nil
64 (list 'creator (concat (user-login-name)
65 hyperb:host-domain)
66 'create-time (htz:date-sortable-gmt)))
67 plist)))
68
69 (defun kcell:create-top (&optional file counter)
70 "Return a new koutline top cell optionally attached to FILE with current idstamp COUNTER."
71 (kcell:create nil 0
72 ;; id-counter = max idstamp value given out in this kotl
73 (list 'id-counter (or counter 0) 'file file)))
74
75 (defun kcell:get-attr (kcell attribute)
76 "Return the value of KCELL's ATTRIBUTE."
77 (knode:get-attr (kcell:plist kcell) attribute))
78
79 (defun kcell:idstamp (kcell)
80 "Return permanent idstamp of KCELL as an integer."
81 (kcell:get-attr kcell 'idstamp))
82
83 (fset 'kcell:is-p 'knode:is-p)
84
85 (defun kcell:plist (kcell)
86 (knode:get-attr kcell 'plist))
87
88 (defun kcell:ref-to-id (cell-ref)
89 "Returns a CELL-REF string converted to a cell identifier string.
90 If CELL-REF contains both a relative and a permanent id, the permanent id is
91 returned. If CELL-REF is invalid, nil is returned.
92
93 CELL-REF may be of any of the following forms:
94 1b - relative id, augment style
95 1.2 - relative id, legal style
96 012 - permanent idstamp
97 1a=012 - both relative and permanent ids (in that order) separated by =
98 |viewspec - a viewspec setting, rather than a cell reference
99 :viewspec - an augment viewspec, ignored for now.
100
101 Optionally, any of the above id forms may be followed by a period and some
102 alpha characters indicating a location relative to the id.
103
104 Optionally, any of these id forms (or the relative form) may be followed by
105 zero or more whitespace characters, a | and some view specification
106 characters. Augment viewspec characters preceded by a colon are ignored, for
107 now."
108
109 (if (not (stringp cell-ref))
110 nil
111 (setq cell-ref (hypb:replace-match-string "\\s +" cell-ref "" t))
112 (let ((specs) result)
113 ;; Ignore Augment :viewspecs.
114 (if (string-match ":" cell-ref)
115 (setq cell-ref (substring cell-ref 0 (match-beginning 0))))
116 ;; Separate koutline |viewspecs from cell id.
117 (if (string-match "\\(\\.[a-zA-Z]\\||\\)" cell-ref)
118 (setq specs (substring cell-ref (match-beginning 1))
119 cell-ref (substring cell-ref 0 (match-beginning 0))))
120 (setq result
121 (cond
122 ((string-match "[^.= \t\n0-9a-zA-Z]" cell-ref) nil)
123 ((string-match "^\\([.0-9a-zA-Z]+\\)=\\(0[0-9]*\\)$"
124 cell-ref)
125 (substring cell-ref (match-beginning 2) (match-end 2)))
126 ((string-match "^\\([.0-9a-zA-Z]+\\)$" cell-ref)
127 (substring cell-ref (match-beginning 1) (match-end 1)))))
128 (cond (result
129 (if specs (concat result specs) result))
130 (specs
131 (if (= ?| (aref specs 0)) specs))))))
132
133 (defun kcell:remove-attr (kcell attribute)
134 "Remove KCELL's ATTRIBUTE, if any, return modified KCELL."
135 (knode:set-attr
136 kcell 'plist (knode:remove-attr (kcell:plist kcell) attribute)))
137
138 (defun kcell:set-attr (kcell attribute value)
139 "Set KCELL's ATTRIBUTE to VALUE and return modified KCELL."
140 (knode:set-attr
141 kcell 'plist (knode:set-attr (kcell:plist kcell)
142 attribute value)))
143
144 (defun kcell:set-create-time (kcell)
145 "Store the time of creation of KCELL."
146 (kcell:set-attr kcell 'create-time (htz:date-sortable-gmt)))
147
148 (defun kcell:set-creator (kcell)
149 "Store the current user's id as the creator of KCELL."
150 (kcell:set-attr
151 kcell 'creator (concat (user-login-name) hyperb:host-domain)))
152
153 (defun kcell:set-idstamp (kcell idstamp)
154 "Set KCELL's permanent IDSTAMP (an integer) and return IDSTAMP."
155 (kcell:set-attr kcell 'idstamp idstamp)
156 (kcell:idstamp kcell))
157
158 ;;;
159 ;;; kotl-data - Persistent representation of kotl cells (written to files).
160 ;;;
161
162 (defun kotl-data:create (cell)
163 "Given a kotl CELL, return a kotl-data structure to write to a file.
164 If CELL, its idstamp, or its property list are nil, this repairs the cell by
165 assuming it is the cell at point and filling in the missing information."
166 (let ((idstamp (kcell:idstamp cell))
167 (plist (nthcdr 2 (kcell:plist cell))))
168 (if (and cell idstamp plist)
169 (vector idstamp plist)
170 (kotl-data:create
171 (kcell:create nil
172 (or idstamp (kview:id-increment kview))
173 plist)))))
174
175 (defun kotl-data:idstamp (kotl-data)
176 (aref kotl-data 0))
177
178 (defun kotl-data:plist-v2 (kotl-data)
179 (aref kotl-data 2))
180
181 (defun kotl-data:plist-v3 (kotl-data)
182 (aref kotl-data 1))
183
184 (defun kotl-data:to-kcell-v2 (kotl-data)
185 (if (vectorp kotl-data)
186 (kcell:create
187 ;; Cell contents are no longer put into cells themselves by default
188 ;; when a file is read. The contents are stored within the kview
189 ;; buffer, so use nil as a place-holder.
190 nil
191 ;; Repair invalid idstamps on the fly.
192 (or (kotl-data:idstamp kotl-data) (kview:id-increment kview))
193 (kotl-data:plist-v2 kotl-data))
194 ;; Repair invalid cells on the fly.
195 (kcell:create nil (kview:id-increment kview))))
196
197 (defun kotl-data:to-kcell-v3 (kotl-data)
198 (if (vectorp kotl-data)
199 (kcell:create
200 ;; Cell contents are no longer put into cells themselves by default
201 ;; when a file is read. The contents are stored within the kview
202 ;; buffer, so use nil as a place-holder.
203 nil
204 ;; Repair invalid idstamps on the fly.
205 (or (kotl-data:idstamp kotl-data) (kview:id-increment kview))
206 (kotl-data:plist-v3 kotl-data))
207 ;; Repair invalid cells on the fly.
208 (kcell:create nil (kview:id-increment kview))))
209
210 (provide 'kotl)