annotate lisp/hyperbole/hactypes.el @ 24:4103f0995bd7 r19-15b95

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