|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: klink.el
|
|
|
4 ;; SUMMARY: Implicit reference to a kcell action type, for use in koutlines.
|
|
|
5 ;; USAGE: GNU Emacs V19 Lisp Library
|
|
|
6 ;; KEYWORDS: extensions, hypermedia, outlines, wp
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner & Kellie Clark
|
|
|
9 ;;
|
|
|
10 ;; ORIG-DATE: 15-Nov-93 at 12:15:16
|
|
|
11 ;; LAST-MOD: 1-Nov-95 at 23:07:37 by Bob Weiner
|
|
|
12 ;;
|
|
|
13 ;; DESCRIPTION:
|
|
|
14 ;;
|
|
|
15 ;;; link =
|
|
|
16 ;; < pathname [, cell-ref] [, position] >
|
|
|
17 ;; < @ cell-ref > ;; In same buffer
|
|
|
18 ;; < journal-name, journal-item-number [, cell-ref] [, position] >
|
|
|
19 ;;
|
|
|
20 ;;; pathname =
|
|
|
21 ;; path ;; display path in Emacs buffer
|
|
|
22 ;; !path ;; execute pathname within a shell
|
|
|
23 ;; &path ;; execute path as a windowed program
|
|
|
24 ;; -path ;; Load as an Emacs Lisp program
|
|
|
25 ;;
|
|
|
26 ;;; cell-ref =
|
|
|
27 ;; cell - 1a, 012, 1.2, 1a=012 (both relative and absolute ids separated
|
|
|
28 ;; by an equal sign)
|
|
|
29 ;; range - 1a-5c, 1a-+3 (include 3 cells past 1a) (not yet implemented)
|
|
|
30 ;; tree - 1a+ (not yet implemented)
|
|
|
31 ;;
|
|
|
32 ;; optionally followed by a period and 1 or more relative position specs
|
|
|
33 ;; (not yet implemented):
|
|
|
34 ;;
|
|
|
35 ;; previous-cell - .b
|
|
|
36 ;; down-a-level - .d
|
|
|
37 ;; end-of-branch - .e
|
|
|
38 ;; follow-next-link - .l
|
|
|
39 ;; return-to-prev-location - .r
|
|
|
40 ;; return-to-prev-buffer - .rf
|
|
|
41 ;; sibling - .s, .2s for 2 siblings forward
|
|
|
42 ;; tail-of-tree - .t
|
|
|
43 ;; up-a-level - .u
|
|
|
44 ;; last char of cell - .f
|
|
|
45 ;;
|
|
|
46 ;; and then optionally followed by any amount of whitespace, a pipe `|'
|
|
|
47 ;; character and then one or more view specification characters. (Augment
|
|
|
48 ;; viewspec characters may be given instead, preceded by a colon. They are
|
|
|
49 ;; ignored for now.)
|
|
|
50 ;;
|
|
|
51 ;;; position (relative to cell start) = (not yet implemented)
|
|
|
52 ;; char-pos, e.g. 28 or C28
|
|
|
53 ;; word-num, e.g. W5
|
|
|
54 ;; line-num, e.g. L2
|
|
|
55 ;; paragraph-num, e.g. P3
|
|
|
56 ;; regexp-match, e.g. "regexp"
|
|
|
57 ;;
|
|
|
58 ;; DESCRIP-END.
|
|
|
59
|
|
|
60 ;;; ************************************************************************
|
|
|
61 ;;; Public functions
|
|
|
62 ;;; ************************************************************************
|
|
|
63
|
|
|
64 ;;;###autoload
|
|
|
65 (defun klink:create (reference)
|
|
|
66 "Insert at point an implicit link to REFERENCE.
|
|
|
67 REFERENCE should be a cell-ref or a string containing \"filename, cell-ref\".
|
|
|
68 See documentation for 'kcell:ref-to-id' for valid cell-ref formats."
|
|
|
69 (interactive
|
|
|
70 ;; Don't change the name or delete default-dir used here. It is referenced
|
|
|
71 ;; in "hargs.el" for argument getting.
|
|
|
72 (let ((default-dir default-directory))
|
|
|
73 (barf-if-buffer-read-only)
|
|
|
74 (hargs:iform-read
|
|
|
75 (list 'interactive "*+LInsert link to <[file,] cell-id [|vspecs]>: "))))
|
|
|
76 (barf-if-buffer-read-only)
|
|
|
77 ;; Reference generally is a string. It may be a list as a string, e.g.
|
|
|
78 ;; "(\"file\" \"cell\")", in which case, we remove the unneeded internal
|
|
|
79 ;; double quotes and then parse it with pattern matching.
|
|
|
80 (and (stringp reference) (> (length reference) 0)
|
|
|
81 (= (aref reference 0) ?\()
|
|
|
82 (setq reference (hypb:replace-match-string "\\\"" reference "" t)))
|
|
|
83 (let ((default-dir default-directory)
|
|
|
84 file-ref cell-ref)
|
|
|
85 (setq reference (klink:parse reference)
|
|
|
86 file-ref (car reference)
|
|
|
87 cell-ref (car (cdr reference)))
|
|
|
88 ;; Don't need filename if link is to a cell in current buffer.
|
|
|
89 (if (and file-ref (equal buffer-file-name
|
|
|
90 (expand-file-name file-ref default-directory)))
|
|
|
91 (setq file-ref nil))
|
|
|
92 (cond (file-ref
|
|
|
93 (setq file-ref (hpath:relative-to file-ref))
|
|
|
94 ;; "./" prefix, if any.
|
|
|
95 (if (string-match "^\\./" file-ref)
|
|
|
96 (setq file-ref (substring file-ref (match-end 0))))
|
|
|
97 (insert "<" file-ref)
|
|
|
98 (if cell-ref (insert ", " cell-ref))
|
|
|
99 (insert ">"))
|
|
|
100 (cell-ref (insert "<@ " cell-ref ">"))
|
|
|
101 (t (error "(klink:create) Invalid reference, '%s'" reference)))))
|
|
|
102
|
|
|
103 (defun klink:at-p ()
|
|
|
104 "Return non-nil iff point is within a klink.
|
|
|
105 See documentation for the `link-to-kotl' function for valid klink formats.
|
|
|
106 Value returned is a list of: link-label, link-start-position, and
|
|
|
107 link-end-position, (including delimiters)."
|
|
|
108 (let (bol klink referent)
|
|
|
109 (if (and
|
|
|
110 ;; If this is an OO-Browser listing buffer, ignore anything that
|
|
|
111 ;; looks like a klink, e.g. a C++ <template> class.
|
|
|
112 (if (fboundp 'br-browser-buffer-p)
|
|
|
113 (not (br-browser-buffer-p))
|
|
|
114 t)
|
|
|
115 ;; Don't match to C/C++ lines like: #include < path >
|
|
|
116 (save-excursion
|
|
|
117 (beginning-of-line)
|
|
|
118 (setq bol (point))
|
|
|
119 (require 'hmouse-tag)
|
|
|
120 (not (looking-at smart-c-include-regexp)))
|
|
|
121 (save-excursion
|
|
|
122 ;; Don't match Elisp print objects such as #<buffer>
|
|
|
123 (and (search-backward "<" bol t)
|
|
|
124 (/= (preceding-char) ?#)
|
|
|
125 ;; Don't match to \<(explicit)> Hyperbole buttons
|
|
|
126 (/= (char-after (1+ (point))) ?\()))
|
|
|
127 (setq klink (hbut:label-p t "<" ">" t))
|
|
|
128 (stringp (setq referent (car klink)))
|
|
|
129 ;; Eliminate matches to e-mail address like, <user@domain>.
|
|
|
130 (not (string-match "[^<> \t\n][!&@]" referent)))
|
|
|
131 klink)))
|
|
|
132
|
|
|
133 ;;; ************************************************************************
|
|
|
134 ;;; Hyperbole type definitions
|
|
|
135 ;;; ************************************************************************
|
|
|
136
|
|
|
137 (defib klink ()
|
|
|
138 "Follows a link delimited by <> to a koutline cell.
|
|
|
139 See documentation for the `link-to-kotl' function for valid klink formats."
|
|
|
140 (let* ((link-and-pos (klink:at-p))
|
|
|
141 (link (car link-and-pos))
|
|
|
142 (start-pos (car (cdr link-and-pos))))
|
|
|
143 (if link
|
|
|
144 (progn (ibut:label-set link-and-pos)
|
|
|
145 (hact 'klink:act link start-pos)))))
|
|
|
146
|
|
|
147 (defact link-to-kotl (link)
|
|
|
148 "Displays at the top of another window the referent pointed to by LINK.
|
|
|
149 LINK may be of any of the following forms, with or without delimiters:
|
|
|
150 < pathname [, cell-ref] >
|
|
|
151 < [-!&] pathname >
|
|
|
152 < @ cell-ref >
|
|
|
153
|
|
|
154 See documentation for 'kcell:ref-to-id' for valid cell-ref formats."
|
|
|
155
|
|
|
156 (interactive "sKotl link specifier: ")
|
|
|
157 (or (stringp link) (error "(link-to-kotl): Non-string link argument, %s"
|
|
|
158 link))
|
|
|
159 (cond
|
|
|
160 ((or (string-match (format "\\`<?\\s *@\\s *\\(%s\\)\\s *>?\\'"
|
|
|
161 klink:cell-ref-regexp) link)
|
|
|
162 (string-match (format "\\`<?\\s *\\([|:]%s\\)\\s *>?\\'"
|
|
|
163 klink:cell-ref-regexp) link))
|
|
|
164 ;; < @ cell-ref > or < |viewspec > or < :augment-viewspec >
|
|
|
165 (hact 'link-to-kcell
|
|
|
166 nil
|
|
|
167 (kcell:ref-to-id
|
|
|
168 (substring link (match-beginning 1) (match-end 1)))))
|
|
|
169 ((string-match
|
|
|
170 (format "\\`<?\\s *\\([^ \t\n,<>]+\\)\\s *\\(,\\s *\\(%s\\)\\)?\\s *>?\\'"
|
|
|
171 klink:cell-ref-regexp)
|
|
|
172 link)
|
|
|
173 ;; < pathname [, cell-ref] >
|
|
|
174 (hact 'link-to-kcell
|
|
|
175 (substring link (match-beginning 1) (match-end 1))
|
|
|
176 (if (match-end 3)
|
|
|
177 (kcell:ref-to-id
|
|
|
178 (substring link (match-beginning 3) (match-end 3))))))
|
|
|
179 ((string-match
|
|
|
180 "\\`<?\\s *\\(\\([-!&]\\)?\\s *[^ \t\n,<>]+\\)\\s *>?\\'" link)
|
|
|
181 ;; < [-!&] pathname >
|
|
|
182 (hpath:find-other-window
|
|
|
183 (substring link (match-beginning 1) (match-end 1))))
|
|
|
184 (t (error "(link-to-kotl): Invalid link specifier, %s" link))))
|
|
|
185
|
|
|
186 ;;; ************************************************************************
|
|
|
187 ;;; Private functions
|
|
|
188 ;;; ************************************************************************
|
|
|
189
|
|
|
190 (defun klink:act (link start-pos)
|
|
|
191 (let ((obuf (current-buffer)))
|
|
|
192 ;; Perform klink's action which is to jump to link referent.
|
|
|
193 (hact 'link-to-kotl link)
|
|
|
194 ;; Update klink label if need be, which might be in a different buffer
|
|
|
195 ;; than the current one.
|
|
|
196 (klink:update-label link start-pos obuf)))
|
|
|
197
|
|
|
198 (defun klink:parse (reference)
|
|
|
199 "Returns (file-ref cell-ref) list parsed from REFERENCE string.
|
|
|
200 Either element of the list may be nil if REFERENCE does not contain that
|
|
|
201 element. REFERENCE should be one of the following forms (and may include an
|
|
|
202 optional pair of <> delimiters:
|
|
|
203 (pathname, cell-ref)
|
|
|
204 pathname, cell-ref
|
|
|
205 cell-ref
|
|
|
206 |viewspec
|
|
|
207 :augment-viewspec (ignored for now)
|
|
|
208
|
|
|
209 See documentation for 'kcell:ref-to-id' for valid cell-ref formats."
|
|
|
210
|
|
|
211 (or (stringp reference)
|
|
|
212 (error "(klink:parse): Non-string reference argument, %s"
|
|
|
213 reference))
|
|
|
214 (cond
|
|
|
215 ((string-match
|
|
|
216 (format
|
|
|
217 "\\`\\s *[<\(]?\\s *\\([^|: \t\n\r,<>][^ \t\n\r,<>]*\\)\\s *,\\s *\\(%s\\)\\s *[\)>]?\\s *\\'"
|
|
|
218 klink:cell-ref-regexp)
|
|
|
219 reference)
|
|
|
220 ;; pathname cell-ref
|
|
|
221 (list (substring reference (match-beginning 1) (match-end 1))
|
|
|
222 (substring reference (match-beginning 2) (match-end 2))))
|
|
|
223 ((string-match (format "\\`\\s *<?\\s *\\(%s\\)\\s *>?\\s *\\'"
|
|
|
224 klink:cell-ref-regexp)
|
|
|
225 reference)
|
|
|
226 ;; cell-ref
|
|
|
227 (list nil (substring reference (match-beginning 1) (match-end 1))))
|
|
|
228 (t (error "(klink:parse): Invalid reference specifier, %s" reference))))
|
|
|
229
|
|
|
230 (defun klink:replace-label (klink link-buf start new-label)
|
|
|
231 "Replace out of date relative id in a link reference of the form, relid=idstamp."
|
|
|
232 (save-excursion
|
|
|
233 (set-buffer link-buf)
|
|
|
234 (if buffer-read-only
|
|
|
235 (message "Relative label should be `%s' in klink <%s>."
|
|
|
236 new-label klink)
|
|
|
237 (goto-char start)
|
|
|
238 (cond ((or (looking-at "<\\s *@\\s *")
|
|
|
239 (looking-at "[^,]+,\\s *"))
|
|
|
240 (goto-char (match-end 0))
|
|
|
241 (zap-to-char 1 ?=)
|
|
|
242 (insert new-label ?=))
|
|
|
243 (t nil)))))
|
|
|
244
|
|
|
245 (defun klink:update-label (klink start link-buf)
|
|
|
246 "Update label of KLINK if its relative cell id has changed.
|
|
|
247 Assume point is in klink referent buffer, where the klink points."
|
|
|
248 (if (and (stringp klink)
|
|
|
249 (string-match
|
|
|
250 "[@,]\\s *\\([*0-9][*.0-9a-zA-Z]*\\)\\s *=\\s *0[0-9]*"
|
|
|
251 klink))
|
|
|
252 ;; Then klink has both relative and permanent ids.
|
|
|
253 (let* ((label (substring klink (match-beginning 1) (match-end 1)))
|
|
|
254 (new-label (kcell-view:label)))
|
|
|
255 (if (and new-label (not (equal label new-label)))
|
|
|
256 (klink:replace-label klink link-buf start new-label)))))
|
|
|
257
|
|
|
258 ;;; ************************************************************************
|
|
|
259 ;;; Private variables.
|
|
|
260 ;;; ************************************************************************
|
|
|
261
|
|
|
262 (defvar klink:cell-ref-regexp
|
|
|
263 "[|:0-9a-zA-Z][|:.*~=0-9a-zA-Z \t\n\r]*"
|
|
|
264 "Regexp matching a cell reference including relative and view specs.
|
|
|
265 Contains no groupings.")
|
|
|
266
|
|
|
267 (provide 'klink)
|
