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

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/hyperbole/kotl/kotl.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,210 @@
+;;!emacs
+;;
+;; FILE:         kotl.el
+;; SUMMARY:      Internal representation of outline kcells used by kviews.
+;; USAGE:        GNU Emacs Lisp Library
+;; KEYWORDS:     outlines, wp
+;;
+;; AUTHOR:       Kellie Clark & Bob Weiner
+;;
+;; ORIG-DATE:    5/1/93
+;; LAST-MOD:     29-Oct-95 at 11:13:47 by Bob Weiner
+;;
+;; This file is part of Hyperbole.
+;; Available for use and distribution under the same terms as GNU Emacs.
+;;
+;; Copyright (C) 1993, 1994, 1995  Free Software Foundation, Inc.
+;; Developed with support from Motorola Inc.
+;;
+;; DESCRIPTION:  
+;;
+;; DESCRIP-END.
+
+;;; ************************************************************************
+;;; Other required Elisp libraries
+;;; ************************************************************************
+
+(mapcar 'require '(klabel knode hinit htz))
+
+;;; ************************************************************************
+;;; Public variables
+;;; ************************************************************************
+
+(defvar kcell:read-only-attributes
+  '(idstamp creator create-time modifier mod-time)
+  "List of kcell attributes which may not be modified by a user.
+Add to this list but don't remove any of the default elements.")
+
+;;; ************************************************************************
+;;; Public functions
+;;; ************************************************************************
+
+;;;
+;;; kcell
+;;;
+
+(fset 'kcell:contents     'knode:contents)
+
+(defun kcell:copy (kcell)
+  "Return a copy of KCELL."
+  (knode:copy kcell))
+
+(defun kcell:create (contents idstamp &optional plist)
+  "Return a new kcell which stores CONTENTS (a string or nil), has permanent IDSTAMP (an integer), and optional additional property list, PLIST.
+User id of `creator' of cell and `create-time' are added to cell's PLIST if
+not already there."
+  (and contents (not (stringp contents))
+       (error "(kcell:create): Invalid `contents' argument: %s" contents))
+  (if (or (not (integerp idstamp)) (< idstamp 0))
+      (error "(kcell:create): Invalid `idstamp' argument: %s" idstamp))
+  (knode:create
+   contents (nconc (list 'idstamp idstamp)
+		   (if (memq 'creator plist)
+		       nil
+		     (list 'creator (concat (user-login-name)
+					    hyperb:host-domain)
+			   'create-time (htz:date-sortable-gmt)))
+		   plist)))
+
+(defun kcell:create-top (&optional file counter)
+  "Return a new koutline top cell optionally attached to FILE with current idstamp COUNTER."
+  (kcell:create nil 0
+		;; id-counter = max idstamp value given out in this kotl
+		(list 'id-counter (or counter 0) 'file file)))
+
+(defun kcell:get-attr (kcell attribute)
+  "Return the value of KCELL's ATTRIBUTE."
+  (knode:get-attr (kcell:plist kcell) attribute))
+
+(defun kcell:idstamp (kcell)
+  "Return permanent idstamp of KCELL as an integer."
+  (kcell:get-attr kcell 'idstamp))
+
+(fset 'kcell:is-p      'knode:is-p)
+
+(defun kcell:plist (kcell)
+  (knode:get-attr kcell 'plist))
+
+(defun kcell:ref-to-id (cell-ref)
+  "Returns a CELL-REF string converted to a cell identifier string.
+If CELL-REF contains both a relative and a permanent id, the permanent id is
+returned.  If CELL-REF is invalid, nil is returned.
+
+CELL-REF may be of any of the following forms:
+  1b        - relative id, augment style
+  1.2       - relative id, legal style
+  012       - permanent idstamp
+  1a=012    - both relative and permanent ids (in that order) separated by =
+  |viewspec - a viewspec setting, rather than a cell reference
+  :viewspec - an augment viewspec, ignored for now.
+
+Optionally, any of the above id forms may be followed by a period and some
+alpha characters indicating a location relative to the id.
+
+Optionally, any of these id forms (or the relative form) may be followed by
+zero or more whitespace characters, a | and some view specification
+characters.  Augment viewspec characters preceded by a colon are ignored, for
+now."
+
+  (if (not (stringp cell-ref))
+      nil
+    (setq cell-ref (hypb:replace-match-string "\\s +" cell-ref "" t))
+    (let ((specs) result)
+      ;; Ignore Augment :viewspecs.
+      (if (string-match ":" cell-ref)
+	  (setq cell-ref (substring cell-ref 0 (match-beginning 0))))
+      ;; Separate koutline |viewspecs from cell id.
+      (if (string-match "\\(\\.[a-zA-Z]\\||\\)" cell-ref)
+	  (setq specs (substring cell-ref (match-beginning 1))
+		cell-ref (substring cell-ref 0 (match-beginning 0))))
+      (setq result
+	    (cond
+	     ((string-match "[^.= \t\n0-9a-zA-Z]" cell-ref) nil)
+	     ((string-match "^\\([.0-9a-zA-Z]+\\)=\\(0[0-9]*\\)$"
+			    cell-ref)
+	      (substring cell-ref (match-beginning 2) (match-end 2)))
+	     ((string-match "^\\([.0-9a-zA-Z]+\\)$" cell-ref)
+	      (substring cell-ref (match-beginning 1) (match-end 1)))))
+      (cond (result
+	     (if specs (concat result specs) result))
+	    (specs
+	     (if (= ?| (aref specs 0)) specs))))))
+	
+(defun kcell:remove-attr (kcell attribute)
+  "Remove KCELL's ATTRIBUTE, if any, return modified KCELL."
+  (knode:set-attr
+   kcell 'plist (knode:remove-attr (kcell:plist kcell) attribute)))
+
+(defun kcell:set-attr (kcell attribute value)
+  "Set KCELL's ATTRIBUTE to VALUE and return modified KCELL."
+  (knode:set-attr
+   kcell 'plist (knode:set-attr (kcell:plist kcell)
+				attribute value)))
+
+(defun kcell:set-create-time (kcell)
+  "Store the time of creation of KCELL."
+  (kcell:set-attr kcell 'create-time (htz:date-sortable-gmt)))
+
+(defun kcell:set-creator (kcell)
+  "Store the current user's id as the creator of KCELL."
+  (kcell:set-attr
+   kcell 'creator (concat (user-login-name) hyperb:host-domain)))
+
+(defun kcell:set-idstamp (kcell idstamp)
+  "Set KCELL's permanent IDSTAMP (an integer) and return IDSTAMP."
+  (kcell:set-attr kcell 'idstamp idstamp)
+  (kcell:idstamp kcell))
+
+;;;
+;;; kotl-data - Persistent representation of kotl cells (written to files).
+;;;
+
+(defun kotl-data:create (cell)
+  "Given a kotl CELL, return a kotl-data structure to write to a file.
+If CELL, its idstamp, or its property list are nil, this repairs the cell by
+assuming it is the cell at point and filling in the missing information."
+   (let ((idstamp (kcell:idstamp cell))
+	 (plist (nthcdr 2 (kcell:plist cell))))
+     (if (and cell idstamp plist)
+	 (vector idstamp plist)
+       (kotl-data:create
+	(kcell:create nil
+		      (or idstamp (kview:id-increment kview))
+		      plist)))))
+
+(defun kotl-data:idstamp (kotl-data)
+  (aref kotl-data 0))
+
+(defun kotl-data:plist-v2 (kotl-data)
+  (aref kotl-data 2))
+
+(defun kotl-data:plist-v3 (kotl-data)
+  (aref kotl-data 1))
+
+(defun kotl-data:to-kcell-v2 (kotl-data)
+  (if (vectorp kotl-data)
+      (kcell:create
+       ;; Cell contents are no longer put into cells themselves by default
+       ;; when a file is read.  The contents are stored within the kview
+       ;; buffer, so use nil as a place-holder.
+       nil
+       ;; Repair invalid idstamps on the fly.
+       (or (kotl-data:idstamp kotl-data) (kview:id-increment kview))
+       (kotl-data:plist-v2 kotl-data))
+    ;; Repair invalid cells on the fly.
+    (kcell:create nil (kview:id-increment kview))))
+
+(defun kotl-data:to-kcell-v3 (kotl-data)
+  (if (vectorp kotl-data)
+      (kcell:create
+       ;; Cell contents are no longer put into cells themselves by default
+       ;; when a file is read.  The contents are stored within the kview
+       ;; buffer, so use nil as a place-holder.
+       nil
+       ;; Repair invalid idstamps on the fly.
+       (or (kotl-data:idstamp kotl-data) (kview:id-increment kview))
+       (kotl-data:plist-v3 kotl-data))
+    ;; Repair invalid cells on the fly.
+    (kcell:create nil (kview:id-increment kview))))
+
+(provide 'kotl)