;;; -*-Emacs-Lisp-*- ;;;%Header ;;; ;;; Rcs_Info: epoch-pop.el,v 1.18 1993/09/03 02:05:07 ivan Rel $ ;;; ;;; Shrink-wrapped temporary windows for GNU Emacs V2.11 ;;; Copyright (C) 1990, 1991, 1992 Chris McConnell, ccm@cs.cmu.edu. ;;; This file is part of GNU Emacs. ;;; GNU Emacs is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY. No author or distributor ;;; accepts responsibility to anyone for the consequences of using it ;;; or for whether it serves any particular purpose or works at all, ;;; unless he says so in writing. Refer to the GNU Emacs General Public ;;; License for full details. ;;; Everyone is granted permission to copy, modify and redistribute ;;; GNU Emacs, but only under the conditions described in the ;;; GNU Emacs General Public License. A copy of this license is ;;; supposed to have been given to you along with GNU Emacs so you ;;; can know your rights and responsibilities. It should be in a ;;; file named COPYING. Among other things, the copyright notice ;;; and this notice must be preserved on all copies. ;;; ;;; DESCRIPTION: This file is a replacement for popper.el when running ;;; under EPOCH. It provides a dedicated screen for displaying ;;; temporary text called the popper screen. It will work with any ;;; function that uses temporary windows or that has been wrapped ;;; using popper-wrap. The screen can be scrolled or buried from any ;;; other window. ;;; ;;; When a buffer is displayed using the function ;;; with-output-to-temp-buffer, the text will be displayed in the ;;; popper window if the name of the buffer is in popper-pop-buffers ;;; or popper-pop-buffers is set to T and the name is not in ;;; popper-no-pop-buffers. Many kinds of completion and help ;;; information are displayed this way. In general any buffer with ;;; *'s around its name will be a temporary buffer. Some commands ;;; like shell-command do not use with-output-to-temp-buffer even ;;; though you might like to have their output be temporary. For ;;; commands like this, you can define a wrapper like this using the ;;; macro popper-wrap. ;;; USAGE: Load this file, preferably after byte-compiling it. If you ;;; do not define key bindings using popper-load-hook, the bindings ;;; will be: ;;; ;;; C-z 1 popper-bury-output ;;; C-z v popper-scroll-output ;;; See %%User variables below for possible options. Here is a sample ;;; load hook for your .emacs: ;;; ;;; (setq popper-load-hook ;;; '(lambda () ;;; ;; Define key bindings ;;; (define-key global-map "\C-c1" 'popper-bury-output) ;;; (define-key global-map "\C-cv" 'popper-scroll-output))) ;;; (require 'epoch-pop) (require 'epoch-util) ;;;%Variables ;;;%%User (defvar popper-load-hook nil "*List of functions to run when the popper module is loaded.") ;;; (defvar popper-pop-buffers t "*List of buffers to put in the popper window. If it is T, all temporary buffers not in popper-no-pop-buffers will be put there.") (defvar popper-no-pop-buffers nil "*List of buffers to not put in the popper window when popper-pop-buffers is T.") ;;; (defvar popper-screen-properties '((icon-name . "** Popper Window **") (title . "** Popper Window **") (font . "8x13") (cursor-glyph . 58) ; pointing hand (reverse . nil) (foreground . "black") (background . "white") (cursor-foreground . "black") (geometry . "80x10+10+10") ) "*Window properties for the popper screen.") (defvar popper-mode-line-text nil "*Minor mode text for mode line of popper buffers. If nil, it will be set to a short help message on first use of popper.") ;;;%%Internal (defvar popper-screen () "The screen being used as the popper window.") (defvar popper-buffer nil "Indicates buffer is a popper for minor-mode-alist.") (make-variable-buffer-local 'popper-buffer) (or (assq 'popper-buffer minor-mode-alist) (setq minor-mode-alist (cons '(popper-buffer popper-mode-line-text) minor-mode-alist))) ;;; This should be in emacs, but it isn't. (defun popper-mem (item list &optional elt=) "Test to see if ITEM is equal to an item in LIST. Option comparison function ELT= defaults to equal." (let ((elt= (or elt= (function equal))) (done nil)) (while (and list (not done)) (if (funcall elt= item (car list)) (setq done list) (setq list (cdr list)))) done)) ;;; (defun popper-screen () "Return the popper screen, creating if necessary." (if (and popper-screen (epoch::screen-information popper-screen)) popper-screen ;; I would love to not focus here if I could figure out how (setq popper-screen (create-screen nil popper-screen-properties)))) ;;; (defun popper-output-buffer () "Return the buffer being displayed in the popper window." (if popper-screen (window-buffer (epoch::selected-window popper-screen)))) ;;; (defun popper-bury-output (&optional no-error) "Bury the popper output signalling an error if not there unless optional NO-ERROR is T." (interactive) (epoch::iconify-screen (popper-screen))) ;;; (defun popper-scroll-output (&optional n) "Scroll text of the popper window upward ARG lines ; or near full screen if no ARG. When calling from a program, supply a number as argument or nil. If the output window is not being displayed, it will be brought up." (interactive "P") (let* ((screen (popper-screen)) (window (epoch::selected-window screen))) (save-screen-excursion (epoch::map-screen screen) (epoch::select-screen screen) ;; This should not scroll unless the window was already up. ;; Now if I could only find a way to sense that. (select-window window) (condition-case () (scroll-up n) (error (if (null n) (set-window-start (selected-window) 0))))))) ;;; (defun popper-show-output (buffer) (let* ((screen (popper-screen)) (window (epoch::selected-window screen))) (save-screen-excursion (epoch::select-screen screen) (set-window-buffer window buffer) (set-buffer buffer) (or popper-mode-line-text (setq popper-mode-line-text (list (format " %s bury, %s scroll" (where-is-internal 'popper-bury-output nil t) (where-is-internal 'popper-scroll-output nil t))))) (setq popper-buffer t) (mapraised-screen screen)))) ;;; (defun popper-show (buffer) "Function to display BUFFER in a popper window if it is in popper-pop-buffers or popper-pop-buffers is T and it is not in popper-no-pop-buffers." (if (eq popper-pop-buffers t) (if (popper-mem (buffer-name buffer) popper-no-pop-buffers) (display-buffer buffer) (popper-show-output buffer)) (if (popper-mem (buffer-name buffer) popper-pop-buffers)) (popper-show-output buffer) (display-buffer buffer))) ;;; %Wrappers (defun popper-unwrap (function) "Remove the popper wrapper for NAME." (let ((var (car (read-from-string (format "popper-%s" function))))) (if (boundp var) (progn (fset function (symbol-value var)) (makunbound var))))) ;;; (defun popper-wrap (function buffer) "Define a wrapper on FUNCTION so that BUFFER will be a pop up window." (popper-unwrap function) (let* ((var (car (read-from-string (format "popper-%s" function)))) (defn (symbol-function function)) arg-spec doc int) (set var defn) (if (consp defn) (setq arg-spec (elt defn 1) doc (elt defn 2) int (elt defn 3)) (setq arg-spec (aref defn 0) doc (and (> (length defn) 4) (aref defn 4)) int (and (> (length defn) 5) (list 'interactive (aref defn 5))))) (fset function (append (list 'lambda arg-spec) (if (numberp doc) (list (documentation function))) (if (stringp doc) (list doc)) (if (eq (car int) 'interactive) (list int)) (list (list 'let '((shown nil)) (list 'save-window-excursion (cons 'funcall (cons var (let ((args nil)) (while arg-spec (if (not (eq (car arg-spec) '&optional)) (setq args (cons (car arg-spec) args))) (setq arg-spec (cdr arg-spec))) (reverse args)))) (list 'setq 'shown (list 'get-buffer-window buffer))) (list 'if 'shown (list 'funcall 'temp-buffer-show-hook buffer)))))) (if (not (eq popper-pop-buffers t)) (let ((elt popper-pop-buffers)) (while (consp elt) (if (string= (car elt) buffer) (setq elt t) (setq elt (cdr elt)))) (if (not elt) (setq popper-pop-buffers (cons buffer popper-pop-buffers))))))) ;;; (popper-wrap 'shell-command "*Shell Command Output*") (popper-wrap 'shell-command-on-region "*Shell Command Output*") ;;; (setq temp-buffer-show-hook 'popper-show) (run-hooks 'popper-load-hook) ;;; Default key bindings (if (not (where-is-internal 'popper-bury-output nil t)) (progn (if (not (keymapp (lookup-key global-map "\C-z"))) (define-key global-map "\C-z" (make-keymap))) (define-key global-map "\C-z1" 'popper-bury-output) (define-key global-map "\C-zv" 'popper-scroll-output))) (provide 'epoch-pop)