Mercurial > hg > xemacs-beta
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) +