home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD1.bin / new / util / edit / jade / lisp / windows.jl < prev    next >
Lisp/Scheme  |  1994-08-31  |  4KB  |  119 lines
  1. ;;;; windows.jl -- Window handling
  2. ;;;  Copyright (C) 1993, 1994 John Harper <jsh@ukc.ac.uk>
  3.  
  4. ;;; This file is part of Jade.
  5.  
  6. ;;; Jade is free software; you can redistribute it and/or modify it
  7. ;;; under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 2, or (at your option)
  9. ;;; any later version.
  10.  
  11. ;;; Jade is distributed in the hope that it will be useful, but
  12. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;;; GNU General Public License for more details.
  15.  
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with Jade; see the file COPYING.  If not, write to
  18. ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. (defvar window-list (cons (current-window) nil)
  21.   "List of all opened windows.")
  22.  
  23. (defvar window-closed-hook '(close-window)
  24.   "Hook called when an input event saying that a window should be closed
  25. is received.")
  26.  
  27. (defun open-window (&optional buffer x y w h)
  28.   "Creates a new window display BUFFER or the buffer that the current window is
  29. showing."
  30.   (interactive)
  31.   (let
  32.       ((old-buf-list buffer-list)
  33.        win)
  34.     (unless buffer
  35.       (setq buffer (current-buffer)))
  36.     (when (setq win (make-window x y w h))
  37.       (setq window-list (cons win window-list))
  38.       (with-window win
  39.     (setq buffer-list (cons buffer (delq buffer
  40.                          (copy-sequence old-buf-list))))
  41.     (set-current-buffer buffer win))
  42.       win)))
  43.  
  44. (defun close-window (&optional win)
  45.   "Close window WIN, or the current window."
  46.   (interactive)
  47.   (unless win
  48.     (setq win (current-window)))
  49.   (if (= (window-count) 1)
  50.       (save-and-quit)
  51.     (setq window-list (delq win window-list))
  52.     (destroy-window win)))
  53.  
  54. (defun close-other-windows (&optional win)
  55.   "Close all windows except for WIN, or the current one."
  56.   (interactive)
  57.   (unless win
  58.     (setq win (current-window)))
  59.   (setq window-list (delq win window-list))
  60.   (while window-list
  61.     (destroy-window (car window-list))
  62.     (setq window-list (cdr window-list)))
  63.   (setq window-list (cons win nil)))
  64.  
  65. (defun add-buffer (buffer)
  66.   "Make sure that BUFFER is in the `buffer-list' of all open windows. It gets
  67. put at the end of the list."
  68.   (let
  69.       ((win-list window-list))
  70.     (while (consp win-list)
  71.       (with-window (car win-list)
  72.     (setq buffer-list (nconc (delq buffer buffer-list) (cons buffer nil))))
  73.       (setq win-list (cdr win-list)))))
  74.  
  75. (defun remove-buffer (buffer)
  76.   "Delete all references to BUFFER in any of the windows' `buffer-list'"
  77.   (let
  78.       ((win-list window-list))
  79.     (while (consp win-list)
  80.       (with-window (car win-list)
  81.     (setq buffer-list (delq buffer buffer-list))
  82.     (when (eq (current-buffer (car win-list)) buffer)
  83.       (set-current-buffer (car buffer-list) (car win-list))))
  84.       (setq win-list (cdr win-list)))))
  85.  
  86. (defun in-other-window (command)
  87.   "Switches to the `other' window then calls the command COMMAND in it."
  88.   (goto-other-window)
  89.   (call-command command))
  90.  
  91. (defun goto-other-window ()
  92.   "Switch to the `other' window."
  93.   (interactive)
  94.   (set-current-window (other-window) t))
  95.  
  96. (defun in-new-window (command)
  97.   (goto-new-window)
  98.   (call-command command))
  99.  
  100. (defun goto-new-window ()
  101.   (interactive)
  102.   (set-current-window (open-window) t))
  103.  
  104. (defun other-window ()
  105.   "(other-window)
  106. Return the `other' window."
  107.   (if (= 1 (window-count))
  108.       (open-window)
  109.     (if (eq (car window-list) (current-window))
  110.     (car (cdr window-list))
  111.       (car window-list))))
  112.  
  113. (defun toggle-iconic ()
  114.   "Toggle the current window between iconified and normal states."
  115.   (interactive)
  116.   (if (window-asleep-p)
  117.       (unsleep-window)
  118.     (sleep-window)))
  119.