(require (quote hbut))

(require (quote hpath))

(require (quote hargs))

(require (quote hact))

(require (quote hmail))

(defact annot-bib (key) "Follows internal ref KEY within an annotated bibliography, delimiters=[]." (interactive "sReference key (no []): ") (let ((opoint (point))) (goto-char 1) (if (re-search-forward (concat "^[*]*[ 	]*\\[" (ebut:key-to-label key) "\\]") nil t) (progn (beginning-of-line) (delete-other-windows) (split-window-vertically nil) (goto-char opoint)) (beep)) (goto-char opoint)))

(defact eval-elisp (lisp-expr) "Evaluates a Lisp expression LISP-EXPR." (interactive "xLisp to eval: ") (eval lisp-expr))

(if hyperb:lemacs-p (require (quote comint)))

(and (fboundp (quote comint-send-input)) (not (fboundp (quote shell-send-input))) (fset (quote shell-send-input) (quote comint-send-input)))

(and (fboundp (quote comint-kill-output)) (not (fboundp (quote kill-output-from-shell))) (fset (quote kill-output-from-shell) (quote comint-kill-output)))

(and (fboundp (quote comint-show-output)) (not (fboundp (quote show-output-from-shell))) (fset (quote show-output-from-shell) (quote comint-show-output)))

(defact exec-shell-cmd (shell-cmd &optional internal-cmd kill-prev) "Executes a SHELL-CMD string asynchronously.
Optional non-nil second argument INTERNAL-CMD means do not display the shell
command line executed.  Optional non-nil third argument KILL-PREV means
kill last output to shell buffer before executing SHELL-CMD." (interactive (let ((default (car defaults)) (default1 (nth 1 defaults)) (default2 (nth 2 defaults))) (list (hargs:read "Shell cmd: " (quote (lambda (cmd) (not (string= cmd "")))) default "Enter a shell command." (quote string)) (y-or-n-p (format "Omit cmd from output (default = %s): " default1)) (y-or-n-p (format "Kill prior cmd's output (default = %s): " default2))))) (let ((buf-name "*Hypb Shell*") (owind (selected-window))) (unwind-protect (progn (setq shell-cmd (concat "cd " default-directory "; " shell-cmd)) (if (not (get-buffer buf-name)) (save-excursion (shell) (rename-buffer buf-name) (setq last-input-start (dot-marker) last-input-end (dot-marker)))) (or (equal (buffer-name (current-buffer)) buf-name) (pop-to-buffer buf-name)) (end-of-buffer) (and kill-prev last-input-end (kill-output-from-shell)) (insert shell-cmd) (shell-send-input) (show-output-from-shell) (or internal-cmd (scroll-down 1))) (select-window owind))))

(defact exec-window-cmd (shell-cmd) "Executes an external window-based SHELL-CMD string asynchronously." (interactive (let ((default (car defaults))) (list (hargs:read "Shell cmd: " (quote (lambda (cmd) (not (string= cmd "")))) default "Enter a shell command." (quote string))))) (let ((buf-name "*Hypb Shell*") (cmd (concat "cd " default-directory "; " shell-cmd))) (save-excursion (if (not (get-buffer buf-name)) (progn (shell) (rename-buffer buf-name) (setq last-input-start (dot-marker) last-input-end (dot-marker)))) (or (equal (buffer-name (current-buffer)) buf-name) (set-buffer buf-name)) (end-of-buffer) (insert cmd) (shell-send-input) (message "Executing: %s" shell-cmd))))

(defact exec-kbd-macro (kbd-macro &optional repeat-count) "Executes KBD-MACRO REPEAT-COUNT times.
KBD-MACRO may be a string of editor command characters or a function symbol.
Optional REPEAT-COUNT nil means execute once, zero means repeat until
error." (interactive (let (macro repeat) (setq macro (intern-soft (hargs:read-match "Unquoted macro name or nil for last one defined: " obarray (quote (lambda (sym) (and (fboundp sym) (stringp (symbol-function sym))))) nil "nil" (quote symbol)))) (or macro (if (null last-kbd-macro) (hypb:error "(exec-kbd-macro): Define a keyboard macro first.") (setq macro last-kbd-macro))) (setq repeat (hargs:read "Repeat count: " (quote (lambda (repeat) (or (null repeat) (and (integerp repeat) (>= repeat 0))))) 1)) (list macro repeat))) (if (interactive-p) nil (or (and kbd-macro (or (stringp kbd-macro) (and (symbolp kbd-macro) (fboundp kbd-macro)))) (hypb:error "(exec-kbd-macro): Bad macro: %s" kbd-macro)) (or (null repeat-count) (and (integerp repeat-count) (<= 0 repeat-count)) (hypb:error "(exec-kbd-macro): Bad repeat count: %s" repeat-count))) (execute-kbd-macro kbd-macro repeat-count))

(defact hyp-config (&optional out-buf) "Inserts Hyperbole configuration info at end of optional OUT-BUF or current." (save-excursion (and out-buf (set-buffer out-buf)) (goto-char (point-max)) (delete-blank-lines) (delete-blank-lines) (let ((start (point))) (insert (format "I use:	Hyperbole:   %s
	Editor:      %s
" hyperb:version (if (boundp (quote epoch::version)) epoch::version (hypb:replace-match-string " of .+" (emacs-version) ""))) (format "	Sys Type:    %s
	Window Sys:  %s
" system-type (or window-system hyperb:window-system "None"))) (if (and (boundp (quote hmail:reader)) hmail:reader) (insert (format "	Mailer:      %s
" (cond ((eq hmail:reader (quote rmail-mode)) "RMAIL") ((eq hmail:reader (quote vm-mode)) (concat "VM " vm-version)) ((and (eq hmail:reader (quote mh-folder-mode)) (string-match "v ?\\([0-9]+.[0-9]+\\)" mh-e-RCS-id)) (concat "MH-e " (substring mh-e-RCS-id (match-beginning 1) (match-end 1)))) ((eq hmail:reader (quote pm-fdr-mode)) (concat "PM " pm-version)))))) (if (and (boundp (quote hnews:reader)) (boundp (quote gnus-version)) hnews:reader) (insert (format "	News Rdr:    %s
" gnus-version))) (untabify start (point)))))

(defact hyp-request (&optional out-buf) "Inserts Hyperbole mail list request help into optional OUT-BUF or current." (save-excursion (and out-buf (set-buffer out-buf)) (goto-char (point-max)) (delete-blank-lines) (delete-blank-lines) (insert "Use one of the following formats on your subject line:

Subject: Add Joe Williams <joe@cs.brown.edu> to hyperbole.
Subject: Remove <joe@cs.brown.edu> from hyperbole.
Subject: Change <joe@cs.brown.edu> to <joe@mot.com> in hyperbole.

Possible mail lists are:
  hyperbole          - discussion of Hyperbole
  hyperbole-announce - Hyperbole announcements only
")))

(defact hyp-source (buf-str-or-file) "Displays a buffer or file from a line beginning with 'hbut:source-prefix'." (interactive (list (prin1-to-string (get-buffer-create (read-buffer "Buffer to link to: "))))) (if (stringp buf-str-or-file) (cond ((string-match "\\`#<buffer \\([^ 
]+\\)>" buf-str-or-file) (pop-to-buffer (substring buf-str-or-file (match-beginning 1) (match-end 1)))) (t (hpath:find-other-window buf-str-or-file))) (hypb:error "(hyp-source): Non-string argument: %s" buf-str-or-file)))

(defact link-to-buffer-tmp (buffer) "Displays a BUFFER in another window.
Link is generally only good for current Emacs session.
Use 'link-to-file' instead for a permanent link." (interactive "bBuffer to link to: ") (if (or (stringp buffer) (bufferp buffer)) (pop-to-buffer buffer) (hypb:error "(link-to-buffer-tmp): Not a current buffer: %s" buffer)))

(defact link-to-directory (directory) "Displays a DIRECTORY in Dired mode in another window." (interactive "DDirectory to link to: ") (hpath:find-other-window directory))

(defact link-to-ebut (key-file key) "Performs action given by another button, specified by KEY-FILE and KEY." (interactive (let (but-file but-lbl) (while (cond ((setq but-file (read-file-name "Loc file of but to link to: " nil nil t)) (if (string= but-file "") (progn (beep) t))) ((not (file-readable-p but-file)) (message "(link-to-ebut): You cannot read '%s'." but-file) (beep) (sit-for 3)))) (list but-file (progn (find-file-noselect but-file) (while (string= "" (setq but-lbl (hargs:read-match "Button to link to: " (ebut:alist but-file) nil nil nil (quote ebut)))) (beep)) (ebut:label-to-key but-lbl))))) (or (interactive-p) (hpath:validate (setq key-file (hpath:substitute-value key-file)))) (let ((but (ebut:get key (find-file-noselect key-file)))) (if but (hbut:act but) (hypb:error "(link-to-ebut): No button '%s' in '%s'." (ebut:key-to-label key) key-file))))

(defact link-to-elisp-doc (func-symbol) "Displays documentation for FUNC-SYMBOL." (interactive "aFunction to display doc for: ") (cond ((not (symbolp func-symbol)) (hypb:error "(link-to-elisp-doc): '%s' not a symbol." func-symbol)) ((not (fboundp func-symbol)) (hypb:error "(link-to-elisp-doc): '%s' not defined as a function." func-symbol)) ((not (documentation func-symbol)) (hypb:error "(link-to-elisp-doc): '%s' has no documentation." func-symbol)) ((describe-function func-symbol))))

(defact link-to-file (path &optional point) "Displays a PATH in another window scrolled to optional POINT.
With POINT, buffer is displayed with POINT at the top of the window." (interactive (let ((prev-reading-p hargs:reading-p)) (unwind-protect (let* ((default (car defaults)) (hargs:reading-p (quote file)) (path (read-file-name "Path to link to: " default default (if (eq system-type (quote vax-vms)) nil (quote existing)))) (path-buf (get-file-buffer path))) (if path-buf (save-excursion (set-buffer path-buf) (setq hargs:reading-p (quote character)) (if (y-or-n-p (format "y = Display at present position (line %d); n = no position: " (count-lines 1 (point)))) (list path (point)) (list path))) (list path))) (setq hargs:reading-p prev-reading-p)))) (and (hpath:find-other-window path) (integerp point) (progn (goto-char (min (point-max) point)) (recenter 0))))

(defact link-to-file-line (path line-num) "Displays a PATH in another window scrolled to LINE-NUM." (interactive "fPath to link to: 
nDisplay at line number: ") (and (hpath:find-other-window path) (integerp line-num) (goto-line line-num)))

(defact link-to-Info-node (node) "Displays an Info NODE in another window.
NODE must be a string of the form '(file)nodename'." (interactive "IInfo (file)nodename to link to: ") (require (quote info)) (if (and (stringp node) (string-match "^(\\([^)]+\\))\\(.*\\)" node)) (let ((nodename (substring node (match-beginning 2) (match-end 2))) (file (hpath:absolute-to (substring node (match-beginning 1) (match-end 1)) (if (boundp (quote Info-directory-list)) Info-directory-list Info-directory)))) (if (and file (setq file (hpath:substitute-value file)) (hpath:validate file)) (progn (pop-to-buffer (other-buffer)) (info) (Info-goto-node (concat "(" file ")" nodename))) (hypb:error "(link-to-Info-node): Bad node spec: '%s'" node)))))

(defact link-to-mail (mail-msg-id &optional mail-file) "Displays mail msg with MAIL-MSG-ID from optional MAIL-FILE in other window." (interactive "MMail Msg: ") (if (and (listp mail-msg-id) (null mail-file)) (setq mail-file (car (cdr mail-msg-id)) mail-msg-id (car mail-msg-id))) (let ((wind (selected-window)) (wconfig (current-window-configuration))) (other-window 1) (if (eq wind (selected-window)) (progn (split-window-vertically nil) (other-window 1))) (if (rmail:msg-to-p mail-msg-id mail-file) nil (set-window-configuration wconfig) (hypb:error "(link-to-mail): No msg '%s' in file \"%s\"." mail-msg-id mail-file))))

(defact link-to-regexp-match (regexp n file) "Finds REGEXP's Nth occurrence in FILE and displays location at window top.
Returns t if found, signals an error if not." (interactive "sRegexp to match: 
nOccurrence number: 
fFile to search: ") (if (stringp file) (progn (setq file (hpath:substitute-value file)) (find-file-other-window file) (goto-char (point-min)) (if (re-search-forward regexp nil t n) (progn (beginning-of-line) (recenter 0) t) (hypb:error "(link-to-regexp-match):  pattern not found: '%s'" regexp))) (hypb:error "(link-to-regexp-match):  file parameter not a string: '%s'" file)))

(defact link-to-rfc (rfc-num) "Retrieves and displays an Internet rfc given by RFC-NUM.
RFC-NUM may be a string or an integer.  Requires ange-ftp." (interactive "nRFC number to retrieve: ") (if (or (stringp rfc-num) (integerp rfc-num)) (hpath:find-other-window (format "/anonymous@ftp.nisc.sri.com:rfc/rfc%s.txt" rfc-num))))

(defact link-to-string-match (string n file) "Finds STRING's Nth occurrence in FILE and displays location at window top.
Returns t if found, nil if not." (interactive "sString to match: 
nOccurrence number: 
fFile to search: ") (funcall (actype:action (quote link-to-regexp-match)) (regexp-quote string) n file))

(defact man-show (topic) "Displays man page on TOPIC, which may be of the form <command>(<section>)." (interactive "sManual topic: ") (manual-entry topic))

(defact rfc-toc (&optional buf-name opoint) "Computes and displays summary of an Internet rfc in BUF-NAME.
Assumes point has already been moved to start of region to summarize.
Optional OPOINT is point to return to in BUF-NAME after displaying summary." (interactive) (if buf-name (cond ((get-buffer buf-name) (switch-to-buffer buf-name)) ((let ((buf (get-file-buffer buf-name))) (if buf (progn (switch-to-buffer (setq buf-name buf)) t)))) (t (if opoint (goto-char opoint)) (hypb:error "(rfc-toc): Invalid buffer name: %s" buf-name)))) (let ((sect-regexp "^[ 	]*[1-9][0-9]*\\.[0-9.]*[ 	]+[^ 	
]")) (occur sect-regexp) (set-buffer "*Occur*") (rename-buffer (format "*%s toc*" buf-name)) (re-search-forward "^[ ]*[0-9]+:" nil t) (beginning-of-line) (delete-region (point-min) (point)) (insert "Contents of " (buffer-name occur-buffer) ":
") (set-buffer-modified-p nil) (set-buffer buf-name) (if opoint (goto-char opoint))))

(provide (quote hactypes))