0
|
1 ;;!emacs
|
|
2 ;;
|
|
3 ;; FILE: hactypes.el
|
|
4 ;; SUMMARY: Default action types for Hyperbole.
|
|
5 ;; USAGE: GNU Emacs Lisp Library
|
|
6 ;; KEYWORDS: extensions, hypermedia
|
|
7 ;;
|
|
8 ;; AUTHOR: Bob Weiner
|
24
|
9 ;; ORG: InfoDock Associates
|
|
10 ;;
|
|
11 ;; This file is part of Hyperbole.
|
|
12 ;; Available for use and distribution under the same terms as GNU Emacs.
|
|
13 ;;
|
|
14 ;; Copyright (C) 1991-1997 Free Software Foundation, Inc.
|
|
15 ;; Developed with support from Motorola Inc.
|
0
|
16 ;;
|
|
17 ;; ORIG-DATE: 23-Sep-91 at 20:34:36
|
24
|
18 ;; LAST-MOD: 20-Feb-97 at 11:16:36 by Bob Weiner
|
|
19
|
0
|
20 ;;; ************************************************************************
|
|
21 ;;; Other required Elisp libraries
|
|
22 ;;; ************************************************************************
|
|
23
|
|
24 (mapcar 'require '(hbut hpath hargs hact hmail))
|
|
25
|
|
26 ;;; ************************************************************************
|
|
27 ;;; Standard Hyperbole action types
|
|
28 ;;; ************************************************************************
|
|
29
|
|
30 (defact annot-bib (key)
|
|
31 "Follows internal ref KEY within an annotated bibliography, delimiters=[]."
|
|
32 (interactive "sReference key (no []): ")
|
24
|
33 (let ((opoint (point))
|
|
34 (key-regexp (concat "^[*]*[ \t]*\\\[" (ebut:key-to-label key) "\\\]")))
|
|
35 (goto-char (point-min))
|
|
36 (if (re-search-forward key-regexp nil t)
|
|
37 (progn (hpath:display-buffer (current-buffer))
|
|
38 (beginning-of-line))
|
|
39 (goto-char opoint)
|
|
40 (beep))))
|
0
|
41
|
|
42 (defact completion ()
|
24
|
43 "Inserts completion at point into the minibuffer or a buffer.
|
|
44 Unless point is at the end of the buffer or if completion has already been
|
|
45 inserted, the completions window is deleted."
|
0
|
46 (interactive)
|
|
47 (if (eobp)
|
|
48 (progn (bury-buffer nil)
|
|
49 (delete-window))
|
|
50 (hargs:completion)))
|
|
51
|
|
52 (defact eval-elisp (lisp-expr)
|
|
53 "Evaluates a Lisp expression LISP-EXPR."
|
|
54 (interactive "xLisp to eval: ")
|
|
55 (eval lisp-expr))
|
|
56
|
|
57 (defact exec-kbd-macro (kbd-macro &optional repeat-count)
|
|
58 "Executes KBD-MACRO REPEAT-COUNT times.
|
|
59 KBD-MACRO may be a string of editor command characters, a function symbol or
|
|
60 nil to use the last defined keyboard macro.
|
|
61 Optional REPEAT-COUNT nil means execute once, zero means repeat until
|
|
62 error."
|
|
63 (interactive
|
|
64 (let (macro repeat)
|
|
65 (setq macro (intern-soft
|
|
66 (hargs:read-match
|
|
67 "Unquoted macro name or nil for last one defined: "
|
|
68 obarray (function
|
|
69 (lambda (sym)
|
|
70 (and (fboundp sym)
|
|
71 (stringp (hypb:indirect-function sym)))))
|
|
72 nil "nil" 'symbol)))
|
|
73 (cond ((fboundp macro))
|
|
74 ((null last-kbd-macro)
|
|
75 (hypb:error
|
|
76 "(exec-kbd-macro): Define a keyboard macro first."))
|
24
|
77 (t (fset 'zzk last-kbd-macro)
|
|
78 (setq macro 'zzk)))
|
0
|
79 (save-excursion
|
|
80 (let ((standard-output (get-buffer-create "*macro-def*")))
|
|
81 (unwind-protect
|
|
82 (progn (set-buffer standard-output)
|
|
83 (setq buffer-read-only nil)
|
|
84 (erase-buffer)
|
|
85 (insert-kbd-macro macro)
|
|
86 (goto-char (point-min))
|
|
87 (setq macro (car (cdr (cdr (read (current-buffer)))))))
|
|
88 (kill-buffer standard-output))))
|
24
|
89 (fmakunbound 'zzk)
|
0
|
90 (setq repeat (hargs:read "Repeat count: "
|
|
91 (function
|
|
92 (lambda (repeat)
|
|
93 (or (null repeat)
|
|
94 (and (integerp repeat) (>= repeat 0)))))
|
|
95 1))
|
|
96 (list macro repeat)))
|
|
97 (if (interactive-p)
|
|
98 nil
|
|
99 (or (and kbd-macro (or (stringp kbd-macro)
|
|
100 (and (symbolp kbd-macro) (fboundp kbd-macro))))
|
|
101 (hypb:error "(exec-kbd-macro): Bad macro: %s" kbd-macro))
|
|
102 (or (null repeat-count) (and (integerp repeat-count) (<= 0 repeat-count))
|
|
103 (hypb:error "(exec-kbd-macro): Bad repeat count: %s" repeat-count)))
|
|
104 (execute-kbd-macro kbd-macro repeat-count))
|
|
105
|
24
|
106 ;;; Support next two actypes on systems which use the `comint' shell package
|
0
|
107 ;;; rather than Emacs V18 shell.el.
|
|
108 ;;;
|
|
109 (if (or hyperb:lemacs-p hyperb:emacs19-p)
|
|
110 (require 'comint))
|
|
111 (and (fboundp 'comint-send-input) (not (fboundp 'shell-send-input))
|
|
112 (fset 'shell-send-input 'comint-send-input))
|
|
113 (and (fboundp 'comint-kill-output) (not (fboundp 'kill-output-from-shell))
|
|
114 (fset 'kill-output-from-shell 'comint-kill-output))
|
|
115 (and (fboundp 'comint-show-output) (not (fboundp 'show-output-from-shell))
|
|
116 (fset 'show-output-from-shell 'comint-show-output))
|
|
117
|
|
118 (defact exec-shell-cmd (shell-cmd &optional internal-cmd kill-prev)
|
|
119 "Executes a SHELL-CMD string asynchronously.
|
|
120 Optional non-nil second argument INTERNAL-CMD means do not display the shell
|
|
121 command line executed. Optional non-nil third argument KILL-PREV means
|
24
|
122 kill the last output to the shell buffer before executing SHELL-CMD."
|
0
|
123 (interactive
|
|
124 (let ((default (car defaults))
|
|
125 (default1 (nth 1 defaults))
|
|
126 (default2 (nth 2 defaults)))
|
|
127 (list (hargs:read "Shell cmd: "
|
|
128 (function
|
24
|
129 (lambda (cmd) (not (string-equal cmd ""))))
|
0
|
130 default "Enter a shell command." 'string)
|
|
131 (y-or-n-p (format "Omit cmd from output (default = %s): "
|
|
132 default1))
|
|
133 (y-or-n-p (format "Kill prior cmd's output (default = %s): "
|
|
134 default2)))))
|
|
135 (let ((buf-name "*Hypb Shell*")
|
|
136 (owind (selected-window)))
|
|
137 (unwind-protect
|
|
138 (progn
|
|
139 (if (not (hpath:ange-ftp-p default-directory))
|
|
140 (setq shell-cmd
|
|
141 (concat "cd " default-directory "; " shell-cmd)))
|
|
142 (if (not (get-buffer buf-name))
|
|
143 (save-excursion
|
24
|
144 (hpath:display-buffer (current-buffer))
|
0
|
145 (if (eq (minibuffer-window) (selected-window))
|
|
146 (other-window 1))
|
|
147 (shell) (rename-buffer buf-name)
|
|
148 (setq last-input-start (point-marker)
|
|
149 last-input-end (point-marker))
|
|
150 (if (fboundp 'comint-kill-output)
|
|
151 (setq comint-last-input-start last-input-start
|
|
152 comint-last-input-end last-input-end)
|
|
153 )))
|
24
|
154 (hpath:display-buffer buf-name)
|
0
|
155 (goto-char (point-max))
|
|
156 (and kill-prev last-input-end
|
|
157 (not (equal last-input-start last-input-end))
|
|
158 (kill-output-from-shell))
|
|
159 (insert shell-cmd)
|
|
160 (shell-send-input)
|
|
161 (show-output-from-shell)
|
|
162 (or internal-cmd (scroll-down 1)))
|
|
163 (select-window owind))))
|
|
164
|
|
165 (defact exec-window-cmd (shell-cmd)
|
24
|
166 "Asynchronously executes an external window-based SHELL-CMD string."
|
0
|
167 (interactive
|
|
168 (let ((default (car defaults)))
|
|
169 (list (hargs:read "Shell cmd: "
|
|
170 (function
|
24
|
171 (lambda (cmd) (not (string-equal cmd ""))))
|
0
|
172 default "Enter a shell command." 'string))))
|
|
173 (let ((buf-name "*Hypb Shell*")
|
|
174 (cmd (if (hpath:ange-ftp-p default-directory)
|
|
175 (concat "(" shell-cmd ") &")
|
|
176 (concat "(cd " default-directory "; " shell-cmd ") &")))
|
|
177 (msg (format "Executing: %s" shell-cmd))
|
|
178 (shell-buf))
|
|
179 (message msg)
|
|
180 (save-excursion
|
|
181 (save-window-excursion
|
|
182 (if (not (get-buffer buf-name))
|
|
183 (progn (save-excursion
|
|
184 (save-window-excursion
|
|
185 (shell)
|
|
186 (setq shell-buf (current-buffer))))
|
|
187 (message msg)
|
|
188 ;; Wait for shell to startup before sending it input.
|
|
189 (sit-for 1)
|
|
190 (set-buffer shell-buf)
|
|
191 (rename-buffer buf-name)
|
|
192 (setq last-input-start (point-marker)
|
|
193 last-input-end (point-marker))
|
|
194 (if (fboundp 'comint-kill-output)
|
|
195 (setq comint-last-input-start last-input-start
|
|
196 comint-last-input-end last-input-end)
|
|
197 )))
|
|
198 (or (equal (buffer-name (current-buffer)) buf-name)
|
|
199 (set-buffer buf-name))
|
|
200 (goto-char (point-max))
|
|
201 (insert cmd)
|
|
202 (shell-send-input)))
|
|
203 (message msg)))
|
|
204
|
24
|
205 (defact function-in-buffer (name pos)
|
|
206 "Displays the definition of function NAME found at POS in the current buffer."
|
|
207 (save-excursion
|
|
208 (goto-char pos)
|
|
209 (if (looking-at (regexp-quote name))
|
|
210 nil
|
|
211 (let ((fume-scanning-message nil))
|
|
212 (fume-rescan-buffer)
|
|
213 (setq pos (cdr-safe (assoc name fume-funclist))))))
|
|
214 (if pos
|
|
215 (progn (hpath:display-buffer (current-buffer))
|
|
216 (goto-char pos)
|
|
217 ;; Move to beginning of the line for compatibility with find-tag.
|
|
218 (beginning-of-line))))
|
|
219
|
0
|
220 (defact hyp-config (&optional out-buf)
|
24
|
221 "Inserts Hyperbole configuration info at end of current buffer or optional OUT-BUF."
|
0
|
222 (hypb:configuration out-buf))
|
|
223
|
|
224 (defact hyp-request (&optional out-buf)
|
24
|
225 "Inserts Hyperbole mail list request help into current buffer or optional OUT-BUF."
|
0
|
226 (save-excursion
|
|
227 (and out-buf (set-buffer out-buf))
|
|
228 (goto-char (point-max))
|
|
229 (delete-blank-lines) (delete-blank-lines)
|
24
|
230 (insert "Use one of the following formats in the *body* of your message:\n
|
|
231 subscribe <mail-list-name> [<your-email-address>]
|
|
232 or
|
|
233 unsubscribe <mail-list-name> [<your-email-address>]
|
0
|
234
|
24
|
235 where possible <mail-list-names> are:
|
|
236 hyperbole - discussion of Hyperbole
|
|
237 hyperbole-announce - Hyperbole announcements only
|
0
|
238
|
24
|
239 For example: subscribe hyperbole joe@nowhere.gov\n")))
|
0
|
240
|
|
241 (defact hyp-source (buf-str-or-file)
|
24
|
242 "Displays a buffer or file from a line beginning with `hbut:source-prefix'."
|
0
|
243 (interactive
|
|
244 (list (prin1-to-string (get-buffer-create
|
|
245 (read-buffer "Buffer to link to: ")))))
|
|
246 (if (stringp buf-str-or-file)
|
|
247 (cond ((string-match "\\`#<buffer \"?\\([^ \n\"]+\\)\"?>" buf-str-or-file)
|
24
|
248 (hpath:display-buffer
|
|
249 (substring buf-str-or-file (match-beginning 1) (match-end 1))))
|
|
250 (t (hpath:find buf-str-or-file)))
|
0
|
251 (hypb:error "(hyp-source): Non-string argument: %s" buf-str-or-file)))
|
|
252
|
|
253 (defact link-to-buffer-tmp (buffer)
|
24
|
254 "Displays a BUFFER.
|
0
|
255 Link is generally only good for current Emacs session.
|
24
|
256 Use `link-to-file' instead for a permanent link."
|
0
|
257 (interactive "bBuffer to link to: ")
|
|
258 (if (or (stringp buffer) (bufferp buffer))
|
24
|
259 (hpath:display-buffer buffer)
|
0
|
260 (hypb:error "(link-to-buffer-tmp): Not a current buffer: %s" buffer)))
|
|
261
|
|
262 (defact link-to-directory (directory)
|
24
|
263 "Displays a DIRECTORY in Dired mode."
|
0
|
264 (interactive "DDirectory to link to: ")
|
24
|
265 (hpath:find directory))
|
0
|
266
|
|
267 (defact link-to-ebut (key-file key)
|
|
268 "Performs action given by another button, specified by KEY-FILE and KEY."
|
|
269 (interactive
|
|
270 (let (but-file but-lbl)
|
|
271 (while (cond ((setq but-file
|
|
272 (read-file-name
|
|
273 "File of button to link to: " nil nil t))
|
24
|
274 (if (string-equal but-file "")
|
0
|
275 (progn (beep) t)))
|
|
276 ((not (file-readable-p but-file))
|
24
|
277 (message "(link-to-ebut): You cannot read `%s'."
|
0
|
278 but-file)
|
|
279 (beep) (sit-for 3))))
|
|
280 (list but-file
|
|
281 (progn
|
|
282 (find-file-noselect but-file)
|
24
|
283 (while (string-equal "" (setq but-lbl
|
0
|
284 (hargs:read-match
|
|
285 "Button to link to: "
|
|
286 (ebut:alist but-file)
|
|
287 nil nil nil 'ebut)))
|
|
288 (beep))
|
|
289 (ebut:label-to-key but-lbl)))))
|
|
290 (or (interactive-p)
|
|
291 (setq key-file (hpath:validate (hpath:substitute-value key-file))))
|
|
292 (let ((but (ebut:get key (find-file-noselect key-file))))
|
|
293 (if but (hbut:act but)
|
24
|
294 (hypb:error "(link-to-ebut): No button `%s' in `%s'." (ebut:key-to-label key)
|
0
|
295 key-file))))
|
|
296
|
|
297 (defact link-to-elisp-doc (func-symbol)
|
|
298 "Displays documentation for FUNC-SYMBOL."
|
|
299 (interactive "aFunction to display doc for: ")
|
|
300 (cond ((not (symbolp func-symbol))
|
24
|
301 (hypb:error "(link-to-elisp-doc): `%s' not a symbol."
|
0
|
302 func-symbol))
|
|
303 ((not (fboundp func-symbol))
|
24
|
304 (hypb:error "(link-to-elisp-doc): `%s' not defined as a function."
|
0
|
305 func-symbol))
|
|
306 ((not (documentation func-symbol))
|
24
|
307 (hypb:error "(link-to-elisp-doc): `%s' has no documentation."
|
0
|
308 func-symbol))
|
24
|
309 (t (let ((temp-buffer-show-function 'switch-to-buffer))
|
|
310 (hpath:display-buffer (current-buffer))
|
|
311 (describe-function func-symbol)))))
|
0
|
312
|
|
313 (defact link-to-file (path &optional point)
|
24
|
314 "Displays file given by PATH scrolled to optional POINT.
|
|
315 With POINT, buffer is displayed with POINT at window top."
|
0
|
316 (interactive
|
|
317 (let ((prev-reading-p hargs:reading-p))
|
|
318 (unwind-protect
|
|
319 (let* ((default (car defaults))
|
|
320 (hargs:reading-p 'file)
|
|
321 (path (read-file-name "Path to link to: " default default))
|
|
322 (path-buf (get-file-buffer path)))
|
|
323 (if path-buf
|
|
324 (save-excursion
|
|
325 (set-buffer path-buf)
|
|
326 (setq hargs:reading-p 'character)
|
|
327 (if (y-or-n-p
|
|
328 (format "y = Display at present position (line %d); n = no position: "
|
|
329 (count-lines 1 (point))))
|
|
330 (list path (point))
|
|
331 (list path)))
|
|
332 (list path)))
|
|
333 (setq hargs:reading-p prev-reading-p))))
|
24
|
334 (and (hpath:find path)
|
0
|
335 (integerp point)
|
|
336 (progn (goto-char (min (point-max) point))
|
|
337 (recenter 0))))
|
|
338
|
|
339 (defact link-to-file-line (path line-num)
|
24
|
340 "Displays a file given by PATH scrolled to LINE-NUM."
|
0
|
341 (interactive "fPath to link to: \nnDisplay at line number: ")
|
24
|
342 (if (setq path (smart-tags-file-path path))
|
|
343 (hpath:find-line path line-num)))
|
0
|
344
|
|
345 (defact link-to-Info-node (node)
|
24
|
346 "Displays an Info NODE.
|
0
|
347 NODE must be a string of the form `(file)nodename'."
|
|
348 (interactive "+IInfo (file)nodename to link to: ")
|
|
349 (require 'info)
|
|
350 (if (and (stringp node) (string-match "^(\\([^\)]+\\))\\(.*\\)" node))
|
|
351 (let ((nodename (substring node (match-beginning 2) (match-end 2)))
|
|
352 (file (hpath:absolute-to
|
|
353 (substring node (match-beginning 1) (match-end 1))
|
|
354 (if (boundp 'Info-directory-list)
|
|
355 Info-directory-list
|
|
356 Info-directory))))
|
|
357 (if (and file (setq file (hpath:substitute-value file)))
|
|
358 (let ((wind (get-buffer-window "*info*")))
|
|
359 (if wind (select-window wind)
|
24
|
360 (hpath:display-buffer (other-buffer)))
|
0
|
361 (info) (Info-goto-node (concat "(" file ")" nodename)))
|
24
|
362 (hypb:error "(link-to-Info-node): Bad node spec: `%s'" node)))))
|
0
|
363
|
|
364 (defact link-to-kcell (file cell-ref)
|
24
|
365 "Displays FILE with kcell given by CELL-REF at window top.
|
|
366 See documentation for `kcell:ref-to-id' for valid cell-ref formats.
|
0
|
367
|
|
368 If FILE is nil, the current buffer is used.
|
|
369 If CELL-REF is nil, the first cell in the view is shown."
|
|
370 (interactive "fKotl file to link to: \n+KKcell to link to: ")
|
|
371 (require 'kfile)
|
24
|
372 (cond ((and (stringp cell-ref) (> (length cell-ref) 0)
|
|
373 (= ?| (aref cell-ref 0)))
|
0
|
374 ;; Activate view spec in current window.
|
|
375 (kotl-mode:goto-cell cell-ref))
|
|
376 ((if file
|
24
|
377 (hpath:find file)
|
|
378 (hpath:display-buffer (current-buffer)))
|
0
|
379 (if cell-ref
|
|
380 (kotl-mode:goto-cell cell-ref)
|
|
381 (kotl-mode:beginning-of-buffer))
|
|
382 (recenter 0))))
|
|
383
|
|
384 (defact link-to-mail (mail-msg-id &optional mail-file)
|
24
|
385 "Displays mail msg with MAIL-MSG-ID from optional MAIL-FILE.
|
|
386 See documentation for the variable `hmail:init-function' for information on
|
0
|
387 how to specify a mail reader to use."
|
|
388 (interactive "+MMail Msg: ")
|
|
389 (if (not (fboundp 'rmail:msg-to-p))
|
|
390 (hypb:error "(link-to-mail): Invoke mail reader before trying to follow a mail link.")
|
|
391 (if (and (listp mail-msg-id) (null mail-file))
|
|
392 (setq mail-file (car (cdr mail-msg-id))
|
|
393 mail-msg-id (car mail-msg-id)))
|
24
|
394 (let ((wconfig (current-window-configuration)))
|
|
395 (hpath:display-buffer (current-buffer))
|
0
|
396 ;; Initialize user-specified mail reader if need be.
|
|
397 (if (and (symbolp hmail:init-function)
|
|
398 (fboundp hmail:init-function)
|
|
399 (listp (symbol-function hmail:init-function))
|
|
400 (eq 'autoload (car (symbol-function hmail:init-function))))
|
|
401 (funcall hmail:init-function))
|
|
402 (if (rmail:msg-to-p mail-msg-id mail-file)
|
|
403 nil
|
|
404 ;; Couldn't find message, restore old window config, report error
|
|
405 (set-window-configuration wconfig)
|
24
|
406 (hypb:error "(link-to-mail): No msg `%s' in file \"%s\"."
|
0
|
407 mail-msg-id mail-file)))))
|
|
408
|
|
409 (defact link-to-regexp-match (regexp n source &optional buffer-p)
|
|
410 "Finds REGEXP's Nth occurrence in SOURCE and displays location at window top.
|
|
411 SOURCE is a pathname unless optional BUFFER-P is non-nil, then SOURCE must be
|
|
412 a buffer name or buffer.
|
|
413 Returns t if found, signals an error if not."
|
|
414 (interactive "sRegexp to match: \nnOccurrence number: \nfFile to search: ")
|
|
415 (let ((orig-src source))
|
|
416 (if buffer-p
|
|
417 (if (stringp source)
|
|
418 (setq source (get-buffer source)))
|
|
419 ;; Source is a pathname.
|
|
420 (if (not (stringp source))
|
|
421 (hypb:error
|
24
|
422 "(link-to-regexp-match): Source parameter is not a filename: `%s'"
|
0
|
423 orig-src)
|
|
424 (setq source (find-file-noselect (hpath:substitute-value source)))))
|
|
425 (if (not (bufferp source))
|
|
426 (hypb:error
|
24
|
427 "(link-to-regexp-match): Invalid source parameter: `%s'" orig-src)
|
|
428 (hpath:display-buffer source)
|
0
|
429 (widen)
|
|
430 (goto-char (point-min))
|
|
431 (if (re-search-forward regexp nil t n)
|
|
432 (progn (beginning-of-line) (recenter 0) t)
|
|
433 (hypb:error
|
24
|
434 "(link-to-regexp-match): Pattern not found: `%s'" regexp)))))
|
0
|
435
|
|
436 (defact link-to-rfc (rfc-num)
|
|
437 "Retrieves and displays an Internet rfc given by RFC-NUM.
|
|
438 RFC-NUM may be a string or an integer. Requires ange-ftp or efs for
|
|
439 remote retrievals."
|
|
440 (interactive "nRFC number to retrieve: ")
|
|
441 (if (or (stringp rfc-num) (integerp rfc-num))
|
24
|
442 (hpath:find (hpath:rfc rfc-num))))
|
0
|
443
|
|
444 (defact link-to-string-match (string n source &optional buffer-p)
|
|
445 "Finds STRING's Nth occurrence in SOURCE and displays location at window top.
|
|
446 SOURCE is a pathname unless optional BUFFER-P is non-nil, then SOURCE must be
|
|
447 a buffer name or buffer.
|
|
448 Returns t if found, nil if not."
|
|
449 (interactive "sString to match: \nnOccurrence number: \nfFile to search: ")
|
|
450 (funcall (actype:action 'link-to-regexp-match)
|
|
451 (regexp-quote string) n source buffer-p))
|
|
452
|
|
453 (defact man-show (topic)
|
24
|
454 "Displays man page on TOPIC, which may be of the form <command>(<section>).
|
|
455 If using the Superman manual entry package, see the documentation for
|
|
456 `sm-notify' to control where the man page is displayed."
|
0
|
457 (interactive "sManual topic: ")
|
24
|
458 (let ((display-buffer-function
|
|
459 (function (lambda (buffer &rest unused) (hpath:display-buffer buffer)))))
|
|
460 (manual-entry topic)))
|
0
|
461
|
|
462 (defact rfc-toc (&optional buf-name opoint)
|
|
463 "Computes and displays summary of an Internet rfc in BUF-NAME.
|
|
464 Assumes point has already been moved to start of region to summarize.
|
|
465 Optional OPOINT is point to return to in BUF-NAME after displaying summary."
|
|
466 (interactive)
|
|
467 (if buf-name
|
|
468 (cond ((get-buffer buf-name)
|
|
469 (switch-to-buffer buf-name))
|
|
470 ((let ((buf (get-file-buffer buf-name)))
|
|
471 (if buf
|
|
472 (progn (switch-to-buffer (setq buf-name buf))
|
|
473 t))))
|
|
474 (t (if opoint (goto-char opoint))
|
|
475 (hypb:error "(rfc-toc): Invalid buffer name: %s" buf-name))))
|
24
|
476 (let ((sect-regexp "^[ \t]*[1-9][0-9]*\\.[0-9.]*[ \t]+[^ \t\n]")
|
|
477 (temp-buffer-show-function 'switch-to-buffer))
|
|
478 (hpath:display-buffer (current-buffer))
|
0
|
479 (occur sect-regexp)
|
|
480 (set-buffer "*Occur*")
|
|
481 (rename-buffer (format "*%s toc*" buf-name))
|
|
482 (re-search-forward "^[ ]*[0-9]+:" nil t)
|
|
483 (beginning-of-line)
|
|
484 (delete-region (point-min) (point))
|
|
485 (insert "Contents of " (buffer-name occur-buffer) ":\n")
|
|
486 (set-buffer-modified-p nil)
|
|
487 (set-buffer buf-name)
|
|
488 (if opoint (goto-char opoint))))
|
|
489
|
|
490 (defact text-toc (section)
|
|
491 "Jumps to the text file SECTION referenced by a table of contents entry at point."
|
|
492 (interactive "sGo to section named: ")
|
|
493 (if (stringp section)
|
|
494 (progn
|
|
495 (actypes::link-to-regexp-match
|
|
496 (concat "^\\*+[ \t]*" (regexp-quote section))
|
|
497 1 (current-buffer) t)
|
|
498 (while (and (= (forward-line -1) 0)
|
|
499 (looking-at "[ \t]*[-=][-=]")))
|
|
500 (forward-line 1)
|
|
501 (recenter 0))))
|
|
502
|
|
503 (provide 'hactypes)
|