diff lisp/hyperbole/kotl/knode.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/knode.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,98 @@
+;;!emacs
+;;
+;; FILE:         knode.el
+;; SUMMARY:      Generic nodes for use as elements in data structures.
+;; USAGE:        GNU Emacs Lisp Library
+;; KEYWORDS:     extensions, hypermedia, outlines
+;;
+;; AUTHOR:       Kellie Clark & Bob Weiner
+;;
+;; ORIG-DATE:    5/1/93
+;; LAST-MOD:     14-Jun-95 at 12:45:49 by Bob Weiner
+;;
+;; This file is part of Hyperbole.
+;; Available for use and distribution under the same terms as GNU Emacs.
+;;
+;; Copyright (C) 1993-1995, Free Software Foundation, Inc.
+;; Developed with support from Motorola Inc.
+;;
+;; DESCRIPTION:  
+;;
+;; DESCRIP-END.
+
+;;; ************************************************************************
+;;; Public functions
+;;; ************************************************************************
+
+;;;
+;;; Knodes
+;;;
+
+(defun knode:create (contents &optional prop-list)
+  "Return a new knode which stores CONTENTS and optional PROP-LIST."
+  (list   'knode
+	  'contents contents
+	  'plist prop-list))
+
+(defun knode:contents (knode)
+   "Return KNODE's contents."
+   (if (knode:is-p knode)
+       (car (cdr (memq 'contents knode)))
+     (error "(knode:contents): Argument must be a knode.")))
+
+(fset 'knode:copy 'copy-tree)
+
+(defun knode:is-p (object)
+  "Is OBJECT a knode?"
+  (and (listp object) (eq (car object) 'knode)))
+
+(defun knode:set-contents (knode contents)
+  "Set KNODE's CONTENTS."
+  (if (knode:is-p knode)
+      (setcar (cdr (memq 'contents knode)) contents)
+    (error "(knode:set-contents): First arg must be a knode.")))
+
+;;; ************************************************************************
+;;; Private functions
+;;; ************************************************************************
+
+(defun knode:get-attr (obj attribute)
+  "Return the value of OBJECT's ATTRIBUTE."
+  (car (cdr (memq attribute obj))))
+
+(defun knode:remove-attr (obj attribute)
+  "Remove OBJECT's ATTRIBUTE, if any, and return modified OBJECT.
+Use (setq object (knode:remove-attr object attribute)) to ensure that OBJECT
+is updated."
+  (let ((tail obj)
+	sym
+	prev)
+    (setq sym (car tail))
+    (while (and sym (eq sym attribute))
+      (setq tail (cdr (cdr tail))
+	    sym (car tail)))
+    (setq obj tail
+	  prev tail
+	  tail (cdr (cdr tail)))
+    (while tail
+      (setq sym (car tail))
+      (if (eq sym attribute)
+	  (setcdr (cdr prev) (cdr (cdr tail))))
+      (setq prev tail
+	    tail (cdr (cdr tail))))
+    obj))
+
+(defun knode:set-attr (obj attribute value)
+  "Set OBJECT's ATTRIBUTE to VALUE and return OBJECT."
+  (let ((attr (memq attribute obj)))
+    (if attr
+	(setcar (cdr attr) value)
+      (setq obj (nconc obj (list attribute value)))))
+  obj)
+
+;;; ************************************************************************
+;;; Private variables
+;;; ************************************************************************
+
+(provide 'knode)
+