Mercurial > hg > xemacs-beta
diff 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 |
line wrap: on
line diff
--- a/lisp/hyperbole/hactypes.el Mon Aug 13 08:50:31 2007 +0200 +++ b/lisp/hyperbole/hactypes.el Mon Aug 13 08:51:03 2007 +0200 @@ -6,10 +6,17 @@ ;; KEYWORDS: extensions, hypermedia ;; ;; AUTHOR: Bob Weiner -;; ORG: Brown U. +;; ORG: InfoDock Associates +;; +;; This file is part of Hyperbole. +;; Available for use and distribution under the same terms as GNU Emacs. +;; +;; Copyright (C) 1991-1997 Free Software Foundation, Inc. +;; Developed with support from Motorola Inc. ;; ;; ORIG-DATE: 23-Sep-91 at 20:34:36 -;; LAST-MOD: 28-Oct-95 at 02:33:45 by Bob Weiner +;; LAST-MOD: 20-Feb-97 at 11:16:36 by Bob Weiner + ;;; ************************************************************************ ;;; Other required Elisp libraries ;;; ************************************************************************ @@ -23,22 +30,19 @@ (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 "^[*]*[ \t]*\\\[" (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))) + (let ((opoint (point)) + (key-regexp (concat "^[*]*[ \t]*\\\[" (ebut:key-to-label key) "\\\]"))) + (goto-char (point-min)) + (if (re-search-forward key-regexp nil t) + (progn (hpath:display-buffer (current-buffer)) + (beginning-of-line)) + (goto-char opoint) + (beep)))) (defact completion () - "Inserts completion at point into minibuffer or other window. -Unless at end of buffer or if completion has already been inserted, then -deletes completions window." + "Inserts completion at point into the minibuffer or a buffer. +Unless point is at the end of the buffer or if completion has already been +inserted, the completions window is deleted." (interactive) (if (eobp) (progn (bury-buffer nil) @@ -70,8 +74,8 @@ ((null last-kbd-macro) (hypb:error "(exec-kbd-macro): Define a keyboard macro first.")) - (t (fset 'zzz last-kbd-macro) - (setq macro 'zzz))) + (t (fset 'zzk last-kbd-macro) + (setq macro 'zzk))) (save-excursion (let ((standard-output (get-buffer-create "*macro-def*"))) (unwind-protect @@ -82,7 +86,7 @@ (goto-char (point-min)) (setq macro (car (cdr (cdr (read (current-buffer))))))) (kill-buffer standard-output)))) - (fmakunbound 'zzz) + (fmakunbound 'zzk) (setq repeat (hargs:read "Repeat count: " (function (lambda (repeat) @@ -99,7 +103,7 @@ (hypb:error "(exec-kbd-macro): Bad repeat count: %s" repeat-count))) (execute-kbd-macro kbd-macro repeat-count)) -;;; Support next two actypes on systems which use the 'comint' shell package +;;; Support next two actypes on systems which use the `comint' shell package ;;; rather than Emacs V18 shell.el. ;;; (if (or hyperb:lemacs-p hyperb:emacs19-p) @@ -115,14 +119,14 @@ "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." +kill the last output to the shell buffer before executing SHELL-CMD." (interactive (let ((default (car defaults)) (default1 (nth 1 defaults)) (default2 (nth 2 defaults))) (list (hargs:read "Shell cmd: " (function - (lambda (cmd) (not (string= cmd "")))) + (lambda (cmd) (not (string-equal cmd "")))) default "Enter a shell command." 'string) (y-or-n-p (format "Omit cmd from output (default = %s): " default1)) @@ -137,13 +141,7 @@ (concat "cd " default-directory "; " shell-cmd))) (if (not (get-buffer buf-name)) (save-excursion - ;; Ensure shell displays in other window unless in the - ;; OO-Browser, then use selected window. - (if (br-in-browser) - nil - (if (= (length (hypb:window-list)) 1) - (split-window-vertically)) - (other-window 1)) + (hpath:display-buffer (current-buffer)) (if (eq (minibuffer-window) (selected-window)) (other-window 1)) (shell) (rename-buffer buf-name) @@ -153,9 +151,7 @@ (setq comint-last-input-start last-input-start comint-last-input-end last-input-end) ))) - (or (equal (buffer-name (current-buffer)) buf-name) - (if (br-in-browser) (switch-to-buffer buf-name) - (pop-to-buffer buf-name))) + (hpath:display-buffer buf-name) (goto-char (point-max)) (and kill-prev last-input-end (not (equal last-input-start last-input-end)) @@ -167,12 +163,12 @@ (select-window owind)))) (defact exec-window-cmd (shell-cmd) - "Executes an external window-based SHELL-CMD string asynchronously." + "Asynchronously executes an external window-based SHELL-CMD string." (interactive (let ((default (car defaults))) (list (hargs:read "Shell cmd: " (function - (lambda (cmd) (not (string= cmd "")))) + (lambda (cmd) (not (string-equal cmd "")))) default "Enter a shell command." 'string)))) (let ((buf-name "*Hypb Shell*") (cmd (if (hpath:ange-ftp-p default-directory) @@ -206,53 +202,67 @@ (shell-send-input))) (message msg))) +(defact function-in-buffer (name pos) + "Displays the definition of function NAME found at POS in the current buffer." + (save-excursion + (goto-char pos) + (if (looking-at (regexp-quote name)) + nil + (let ((fume-scanning-message nil)) + (fume-rescan-buffer) + (setq pos (cdr-safe (assoc name fume-funclist)))))) + (if pos + (progn (hpath:display-buffer (current-buffer)) + (goto-char pos) + ;; Move to beginning of the line for compatibility with find-tag. + (beginning-of-line)))) + (defact hyp-config (&optional out-buf) - "Inserts Hyperbole configuration info at end of optional OUT-BUF or current." + "Inserts Hyperbole configuration info at end of current buffer or optional OUT-BUF." (hypb:configuration out-buf)) (defact hyp-request (&optional out-buf) - "Inserts Hyperbole mail list request help into optional OUT-BUF or current." + "Inserts Hyperbole mail list request help into current buffer or optional OUT-BUF." (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:\n -Subject: Subscribe <joe@any.com> (Joe Williams). -Subject: Unsubscribe <joe@any.com>. + (insert "Use one of the following formats in the *body* of your message:\n +subscribe <mail-list-name> [<your-email-address>] + or +unsubscribe <mail-list-name> [<your-email-address>] -To change your address, first unsubscribe by sending an unsubscribe -request from your old address. Then subscribe by sending a subscribe -request from your new address. +where possible <mail-list-names> are: + hyperbole - discussion of Hyperbole + hyperbole-announce - Hyperbole announcements only -Possible mail lists are: - hyperbole - discussion of Hyperbole - hyperbole-announce - Hyperbole announcements only\n"))) +For example: subscribe hyperbole joe@nowhere.gov\n"))) (defact hyp-source (buf-str-or-file) - "Displays a buffer or file from a line beginning with 'hbut:source-prefix'." + "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 \"?\\([^ \n\"]+\\)\"?>" 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))) + (hpath:display-buffer + (substring buf-str-or-file (match-beginning 1) (match-end 1)))) + (t (hpath:find 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. + "Displays a BUFFER. Link is generally only good for current Emacs session. -Use 'link-to-file' instead for a permanent link." +Use `link-to-file' instead for a permanent link." (interactive "bBuffer to link to: ") (if (or (stringp buffer) (bufferp buffer)) - (pop-to-buffer buffer) + (hpath:display-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." + "Displays a DIRECTORY in Dired mode." (interactive "DDirectory to link to: ") - (hpath:find-other-window directory)) + (hpath:find directory)) (defact link-to-ebut (key-file key) "Performs action given by another button, specified by KEY-FILE and KEY." @@ -261,16 +271,16 @@ (while (cond ((setq but-file (read-file-name "File of button to link to: " nil nil t)) - (if (string= but-file "") + (if (string-equal but-file "") (progn (beep) t))) ((not (file-readable-p but-file)) - (message "(link-to-ebut): You cannot read '%s'." + (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 + (while (string-equal "" (setq but-lbl (hargs:read-match "Button to link to: " (ebut:alist but-file) @@ -281,26 +291,28 @@ (setq key-file (hpath:validate (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) + (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." + (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." + (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." + (hypb:error "(link-to-elisp-doc): `%s' has no documentation." func-symbol)) - ((describe-function func-symbol)))) + (t (let ((temp-buffer-show-function 'switch-to-buffer)) + (hpath:display-buffer (current-buffer)) + (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." + "Displays file given by PATH scrolled to optional POINT. +With POINT, buffer is displayed with POINT at window top." (interactive (let ((prev-reading-p hargs:reading-p)) (unwind-protect @@ -319,22 +331,19 @@ (list path))) (list path))) (setq hargs:reading-p prev-reading-p)))) - (and (hpath:find-other-window path) + (and (hpath:find 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." + "Displays a file given by PATH scrolled to LINE-NUM." (interactive "fPath to link to: \nnDisplay at line number: ") - (and (setq path (smart-tags-file-path path)) - (hpath:find-other-window path) - (integerp line-num) - (progn (widen) - (goto-line line-num)))) + (if (setq path (smart-tags-file-path path)) + (hpath:find-line path line-num))) (defact link-to-Info-node (node) - "Displays an Info NODE in another window. + "Displays an Info NODE. NODE must be a string of the form `(file)nodename'." (interactive "+IInfo (file)nodename to link to: ") (require 'info) @@ -348,32 +357,33 @@ (if (and file (setq file (hpath:substitute-value file))) (let ((wind (get-buffer-window "*info*"))) (if wind (select-window wind) - (pop-to-buffer (other-buffer))) + (hpath:display-buffer (other-buffer))) (info) (Info-goto-node (concat "(" file ")" nodename))) - (hypb:error "(link-to-Info-node): Bad node spec: '%s'" node))))) + (hypb:error "(link-to-Info-node): Bad node spec: `%s'" node))))) (defact link-to-kcell (file cell-ref) - "Displays FILE with kcell given by CELL-REF at the top of the window. -See documentation for 'kcell:ref-to-id' for valid cell-ref formats. + "Displays FILE with kcell given by CELL-REF at window top. +See documentation for `kcell:ref-to-id' for valid cell-ref formats. If FILE is nil, the current buffer is used. If CELL-REF is nil, the first cell in the view is shown." (interactive "fKotl file to link to: \n+KKcell to link to: ") (require 'kfile) - (cond ((and (stringp cell-ref) (= ?| (aref cell-ref 0))) + (cond ((and (stringp cell-ref) (> (length cell-ref) 0) + (= ?| (aref cell-ref 0))) ;; Activate view spec in current window. (kotl-mode:goto-cell cell-ref)) ((if file - (hpath:find-other-window file) - (pop-to-buffer (current-buffer) t)) + (hpath:find file) + (hpath:display-buffer (current-buffer))) (if cell-ref (kotl-mode:goto-cell cell-ref) (kotl-mode:beginning-of-buffer)) (recenter 0)))) (defact link-to-mail (mail-msg-id &optional mail-file) - "Displays mail msg with MAIL-MSG-ID from optional MAIL-FILE in other window. -See documentation for the variable 'hmail:init-function' for information on + "Displays mail msg with MAIL-MSG-ID from optional MAIL-FILE. +See documentation for the variable `hmail:init-function' for information on how to specify a mail reader to use." (interactive "+MMail Msg: ") (if (not (fboundp 'rmail:msg-to-p)) @@ -381,11 +391,8 @@ (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))) + (let ((wconfig (current-window-configuration))) + (hpath:display-buffer (current-buffer)) ;; Initialize user-specified mail reader if need be. (if (and (symbolp hmail:init-function) (fboundp hmail:init-function) @@ -396,7 +403,7 @@ nil ;; Couldn't find message, restore old window config, report error (set-window-configuration wconfig) - (hypb:error "(link-to-mail): No msg '%s' in file \"%s\"." + (hypb:error "(link-to-mail): No msg `%s' in file \"%s\"." mail-msg-id mail-file))))) (defact link-to-regexp-match (regexp n source &optional buffer-p) @@ -412,19 +419,19 @@ ;; Source is a pathname. (if (not (stringp source)) (hypb:error - "(link-to-regexp-match): Source parameter is not a filename: '%s'" + "(link-to-regexp-match): Source parameter is not a filename: `%s'" orig-src) (setq source (find-file-noselect (hpath:substitute-value source))))) (if (not (bufferp source)) (hypb:error - "(link-to-regexp-match): Invalid source parameter: '%s'" orig-src) - (switch-to-buffer-other-window source) + "(link-to-regexp-match): Invalid source parameter: `%s'" orig-src) + (hpath:display-buffer source) (widen) (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))))) + "(link-to-regexp-match): Pattern not found: `%s'" regexp))))) (defact link-to-rfc (rfc-num) "Retrieves and displays an Internet rfc given by RFC-NUM. @@ -432,7 +439,7 @@ remote retrievals." (interactive "nRFC number to retrieve: ") (if (or (stringp rfc-num) (integerp rfc-num)) - (hpath:find-other-window (hpath:rfc rfc-num)))) + (hpath:find (hpath:rfc rfc-num)))) (defact link-to-string-match (string n source &optional buffer-p) "Finds STRING's Nth occurrence in SOURCE and displays location at window top. @@ -444,9 +451,13 @@ (regexp-quote string) n source buffer-p)) (defact man-show (topic) - "Displays man page on TOPIC, which may be of the form <command>(<section>)." + "Displays man page on TOPIC, which may be of the form <command>(<section>). +If using the Superman manual entry package, see the documentation for +`sm-notify' to control where the man page is displayed." (interactive "sManual topic: ") - (manual-entry topic)) + (let ((display-buffer-function + (function (lambda (buffer &rest unused) (hpath:display-buffer buffer))))) + (manual-entry topic))) (defact rfc-toc (&optional buf-name opoint) "Computes and displays summary of an Internet rfc in BUF-NAME. @@ -462,7 +473,9 @@ t)))) (t (if opoint (goto-char opoint)) (hypb:error "(rfc-toc): Invalid buffer name: %s" buf-name)))) - (let ((sect-regexp "^[ \t]*[1-9][0-9]*\\.[0-9.]*[ \t]+[^ \t\n]")) + (let ((sect-regexp "^[ \t]*[1-9][0-9]*\\.[0-9.]*[ \t]+[^ \t\n]") + (temp-buffer-show-function 'switch-to-buffer)) + (hpath:display-buffer (current-buffer)) (occur sect-regexp) (set-buffer "*Occur*") (rename-buffer (format "*%s toc*" buf-name))