|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: knode.el
|
|
|
4 ;; SUMMARY: Generic nodes for use as elements in data structures.
|
|
|
5 ;; USAGE: GNU Emacs Lisp Library
|
|
|
6 ;; KEYWORDS: extensions, hypermedia, outlines
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Kellie Clark & Bob Weiner
|
|
|
9 ;;
|
|
|
10 ;; ORIG-DATE: 5/1/93
|
|
|
11 ;; LAST-MOD: 14-Jun-95 at 12:45:49 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-1995, Free Software Foundation, Inc.
|
|
|
17 ;; Developed with support from Motorola Inc.
|
|
|
18 ;;
|
|
|
19 ;; DESCRIPTION:
|
|
|
20 ;;
|
|
|
21 ;; DESCRIP-END.
|
|
|
22
|
|
|
23 ;;; ************************************************************************
|
|
|
24 ;;; Public functions
|
|
|
25 ;;; ************************************************************************
|
|
|
26
|
|
|
27 ;;;
|
|
|
28 ;;; Knodes
|
|
|
29 ;;;
|
|
|
30
|
|
|
31 (defun knode:create (contents &optional prop-list)
|
|
|
32 "Return a new knode which stores CONTENTS and optional PROP-LIST."
|
|
|
33 (list 'knode
|
|
|
34 'contents contents
|
|
|
35 'plist prop-list))
|
|
|
36
|
|
|
37 (defun knode:contents (knode)
|
|
|
38 "Return KNODE's contents."
|
|
|
39 (if (knode:is-p knode)
|
|
|
40 (car (cdr (memq 'contents knode)))
|
|
|
41 (error "(knode:contents): Argument must be a knode.")))
|
|
|
42
|
|
|
43 (fset 'knode:copy 'copy-tree)
|
|
|
44
|
|
|
45 (defun knode:is-p (object)
|
|
|
46 "Is OBJECT a knode?"
|
|
|
47 (and (listp object) (eq (car object) 'knode)))
|
|
|
48
|
|
|
49 (defun knode:set-contents (knode contents)
|
|
|
50 "Set KNODE's CONTENTS."
|
|
|
51 (if (knode:is-p knode)
|
|
|
52 (setcar (cdr (memq 'contents knode)) contents)
|
|
|
53 (error "(knode:set-contents): First arg must be a knode.")))
|
|
|
54
|
|
|
55 ;;; ************************************************************************
|
|
|
56 ;;; Private functions
|
|
|
57 ;;; ************************************************************************
|
|
|
58
|
|
|
59 (defun knode:get-attr (obj attribute)
|
|
|
60 "Return the value of OBJECT's ATTRIBUTE."
|
|
|
61 (car (cdr (memq attribute obj))))
|
|
|
62
|
|
|
63 (defun knode:remove-attr (obj attribute)
|
|
|
64 "Remove OBJECT's ATTRIBUTE, if any, and return modified OBJECT.
|
|
|
65 Use (setq object (knode:remove-attr object attribute)) to ensure that OBJECT
|
|
|
66 is updated."
|
|
|
67 (let ((tail obj)
|
|
|
68 sym
|
|
|
69 prev)
|
|
|
70 (setq sym (car tail))
|
|
|
71 (while (and sym (eq sym attribute))
|
|
|
72 (setq tail (cdr (cdr tail))
|
|
|
73 sym (car tail)))
|
|
|
74 (setq obj tail
|
|
|
75 prev tail
|
|
|
76 tail (cdr (cdr tail)))
|
|
|
77 (while tail
|
|
|
78 (setq sym (car tail))
|
|
|
79 (if (eq sym attribute)
|
|
|
80 (setcdr (cdr prev) (cdr (cdr tail))))
|
|
|
81 (setq prev tail
|
|
|
82 tail (cdr (cdr tail))))
|
|
|
83 obj))
|
|
|
84
|
|
|
85 (defun knode:set-attr (obj attribute value)
|
|
|
86 "Set OBJECT's ATTRIBUTE to VALUE and return OBJECT."
|
|
|
87 (let ((attr (memq attribute obj)))
|
|
|
88 (if attr
|
|
|
89 (setcar (cdr attr) value)
|
|
|
90 (setq obj (nconc obj (list attribute value)))))
|
|
|
91 obj)
|
|
|
92
|
|
|
93 ;;; ************************************************************************
|
|
|
94 ;;; Private variables
|
|
|
95 ;;; ************************************************************************
|
|
|
96
|
|
|
97 (provide 'knode)
|
|
|
98
|
