|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: hsys-hbase.el
|
|
|
4 ;; SUMMARY: Hyperbole support for the Hyperbase system.
|
|
|
5 ;; USAGE: GNU Emacs Lisp Library
|
|
|
6 ;; KEYWORDS: comm, hypermedia
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner
|
|
|
9 ;; ORG: Brown U.
|
|
|
10 ;;
|
|
|
11 ;; ORIG-DATE: 16-Oct-91 at 04:35:09
|
|
|
12 ;; LAST-MOD: 30-Oct-95 at 22:31:23 by Bob Weiner
|
|
|
13 ;;
|
|
|
14 ;; This file is part of Hyperbole.
|
|
|
15 ;; Available for use and distribution under the same terms as GNU Emacs.
|
|
|
16 ;;
|
|
|
17 ;; Copyright (C) 1991, 1995, Free Software Foundation, Inc.
|
|
|
18 ;; Developed with support from Motorola Inc.
|
|
|
19 ;;
|
|
|
20 ;; DESCRIPTION:
|
|
|
21 ;;
|
|
|
22 ;; For information and the source to HyperBase and follow-on hypermedia
|
|
|
23 ;; work, see: ftp://ftp.iesd.auc.dk/pub/packages/hypertext/
|
|
|
24 ;;
|
|
|
25 ;; In order to use this package, you must have the HyperBase system
|
|
|
26 ;; and must start up a HyperBase server and then load the HyperBase
|
|
|
27 ;; Epoch support software that comes with the HyperBase system.
|
|
|
28 ;;
|
|
|
29 ;; Then load this package and Hyperbole will do the following when
|
|
|
30 ;; in a Hyperbase buffer:
|
|
|
31 ;;
|
|
|
32 ;; Action Key press on a button follows the link, within any other
|
|
|
33 ;; text, closes current Epoch screen and kills node buffer.
|
|
|
34 ;;
|
|
|
35 ;; Assist Key press shows attributes for the current button or
|
|
|
36 ;; for the current node buffer, if no current button.
|
|
|
37 ;;
|
|
|
38 ;; DESCRIP-END.
|
|
|
39
|
|
|
40 ;;; ************************************************************************
|
|
|
41 ;;; Other required Elisp libraries
|
|
|
42 ;;; ************************************************************************
|
|
|
43
|
|
|
44 (require 'hbut)
|
|
|
45
|
|
|
46 ;;; ************************************************************************
|
|
|
47 ;;; Public variables
|
|
|
48 ;;; ************************************************************************
|
|
|
49
|
|
|
50 (defib hyperbase ()
|
|
|
51 "Detects link buttons in buffers that communicate with the Hyperbase system.
|
|
|
52 Hyperbase is a hypertext database system that interfaces to Emacs."
|
|
|
53 (and (boundp 'ehts-mode) ehts-mode
|
|
|
54 (let ((lbl (or (ebut:label-p 'as-label "[-> " "]")
|
|
|
55 "no-but")))
|
|
|
56 (ibut:label-set lbl)
|
|
|
57 (hact 'hyperbase lbl))))
|
|
|
58
|
|
|
59 (defact hyperbase (linkname)
|
|
|
60 "Follows LINKNAME in a buffer that communicates with the Hyperbase system.
|
|
|
61 If LINKNAME equals t, closes the current Epoch screen and kill the
|
|
|
62 buffer of the current Hyperbase node.
|
|
|
63 Hyperbase is a hypertext database system that interfaces to Emacs."
|
|
|
64 ;; From hb-EHTS.el by:
|
|
|
65 ;; Uffe Kock Wiil (kock@iesd.auc.dk)
|
|
|
66 ;; Claus Bo Nielsen (cbn@cci.dk)
|
|
|
67 ;;
|
|
|
68 (if (equal linkname "no-but")
|
|
|
69 (progn (ehts-mouse-kill-screen-and-buffer t)
|
|
|
70 (and (fboundp 'epoch::select-screen)
|
|
|
71 (epoch::select-screen)))
|
|
|
72 (let ((linknum (cdr (assoc linkname ehts-node-link-alist))) tonode)
|
|
|
73 (ehts-command t)
|
|
|
74 (if (< (ehts-hb-sys-call "read" linknum "to data node no" nil t) 0)
|
|
|
75 (progn
|
|
|
76 (ehts-command nil)
|
|
|
77 (error "Can't read \"to data node no\" in link, panic !!!")))
|
|
|
78 (ehts-read-4bytes)
|
|
|
79 (setq tonode (ehts-read-4bytes))
|
|
|
80 (if (< (ehts-hb-sys-call "read" tonode "n name" nil t) 0)
|
|
|
81 (progn
|
|
|
82 (ehts-command nil)
|
|
|
83 (error "Can't read \"name\" in data node, panic !!!")))
|
|
|
84 (ehts-get-node (ehts-read-null-string))
|
|
|
85 (and (fboundp 'hproperty:but-create-all)
|
|
|
86 (hproperty:but-create-all "[-> " "]"))
|
|
|
87 (ehts-command nil))))
|
|
|
88
|
|
|
89 ;;; ************************************************************************
|
|
|
90 ;;; Public functions
|
|
|
91 ;;; ************************************************************************
|
|
|
92
|
|
|
93 (defun hyperbase:init ()
|
|
|
94 "Show initial set of Hyperbase buttons."
|
|
|
95 (if (assoc (user-full-name) ehts-node-name-alist)
|
|
|
96 (progn
|
|
|
97 (ehts-get-node (user-full-name))
|
|
|
98 (let (buffer screen)
|
|
|
99 (setq buffer "*Ehts Welcome*")
|
|
|
100 (setq screen (ehts-find-buffer-screen buffer))
|
|
|
101 (kill-buffer buffer)
|
|
|
102 (switch-to-buffer (user-full-name))
|
|
|
103 (remove-screen screen)))
|
|
|
104 (if (assoc "dir ehts help" ehts-node-name-alist)
|
|
|
105 (progn
|
|
|
106 (ehts-get-node "dir ehts help")
|
|
|
107 (let (buffer screen)
|
|
|
108 (setq buffer "*Ehts Welcome*")
|
|
|
109 (setq screen (ehts-find-buffer-screen buffer))
|
|
|
110 (kill-buffer buffer)
|
|
|
111 (switch-to-buffer "dir ehts help")
|
|
|
112 (remove-screen screen)
|
|
|
113 (hproperty:but-create "[-> " "]"))))))
|
|
|
114
|
|
|
115 (defun hyperbase:help (&optional but)
|
|
|
116 "Displays attributes of a link button BUT if on one or of the current node.
|
|
|
117 Hyperbase is a hypertext database system that interfaces to Emacs."
|
|
|
118 (interactive (list (ibut:at-p)))
|
|
|
119 (or (and (boundp 'ehts-mode) ehts-mode)
|
|
|
120 (error "(hyperbase:help): Not in a Hyperbase mode buffer."))
|
|
|
121 (hyperbase:attr-help
|
|
|
122 (or (and (symbolp but)
|
|
|
123 (let ((lbl (ebut:key-to-label (hattr:get but 'lbl-key))))
|
|
|
124 (if (not (equal lbl "no-but")) lbl)))
|
|
|
125 (current-buffer))))
|
|
|
126
|
|
|
127 ;;; ************************************************************************
|
|
|
128 ;;; Private functions
|
|
|
129 ;;; ************************************************************************
|
|
|
130
|
|
|
131 (defun hyperbase:already-displayed-p (name)
|
|
|
132 "Test if a buffer allready is displayed."
|
|
|
133 (let (screenid)
|
|
|
134 (setq screenid (ehts-find-buffer-screen name))
|
|
|
135 (if screenid
|
|
|
136 (progn
|
|
|
137 (switch-screen screenid)
|
|
|
138 t)
|
|
|
139 nil)))
|
|
|
140
|
|
|
141 (defun hyperbase:attr-help (node-link-spec)
|
|
|
142 "Show the attributes of a node or a button link from NODE-LINK-SPEC.
|
|
|
143 A string value of NODE-LINK-SPEC means show attributes for that button link.
|
|
|
144 A buffer value means show attributes for the node in that buffer."
|
|
|
145 (interactive)
|
|
|
146 (or (stringp node-link-spec) (bufferp node-link-spec)
|
|
|
147 (error "(hyperbase-show-attributes): Non-string or buffer argument."))
|
|
|
148 (let (entity name string number buffer screenid)
|
|
|
149 (setq buffer (if (bufferp node-link-spec) (buffer-name node-link-spec))
|
|
|
150 entity (cdr (assoc (if buffer "node" "link") node-link-list))
|
|
|
151 buffer (or buffer (buffer-name)))
|
|
|
152 (if (eq (string-match "Attributes - " buffer) 0)
|
|
|
153 nil
|
|
|
154 (if (= entity 0)
|
|
|
155 (progn
|
|
|
156 (setq name (concat "Attributes - " buffer))
|
|
|
157 (if (not (hyperbase:already-displayed-p name))
|
|
|
158 (progn
|
|
|
159 (setq number (cdr (assoc buffer ehts-node-name-alist))
|
|
|
160 string (ehts-create-node-attribute-string number))
|
|
|
161 (ehts-setup-attribute-screen name string entity buffer))))
|
|
|
162 (if (eq ehts-node-link-alist '())
|
|
|
163 (error "No links in this node."))
|
|
|
164 (setq name (concat "Attributes - "
|
|
|
165 (car (assoc node-link-spec ehts-node-link-alist))))
|
|
|
166 (if (not (hyperbase:already-displayed-p name))
|
|
|
167 (progn
|
|
|
168 (setq number (cdr (assoc (substring name 13)
|
|
|
169 ehts-node-link-alist))
|
|
|
170 string (ehts-create-link-attribute-string number))
|
|
|
171 (ehts-setup-attribute-screen name string entity buffer)))))))
|
|
|
172
|
|
|
173 ;;; ************************************************************************
|
|
|
174 ;;; Private variables
|
|
|
175 ;;; ************************************************************************
|
|
|
176
|
|
|
177 (provide 'hsys-hbase)
|
