Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/kotl/klink.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 4103f0995bd7
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
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)