home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 4 / FreshFish_May-June1994.bin / bbs / may94 / util / edit / jade.lha / Jade / lisp / windows.jl < prev    next >
Lisp/Scheme  |  1994-04-16  |  3KB  |  97 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. (setq window-list (cons (current-window) nil))
  21.  
  22. (defun open-window (&optional buffer x y w h)
  23.   "(open-window [BUFFER] [X] [Y] [WIDTH] [HEIGHT])
  24. Creates a new window display BUFFER or the buffer that the current window is
  25. showing."
  26.   (let
  27.       ((old-buf-list buffer-list)
  28.        win)
  29.     (unless buffer
  30.       (setq buffer (current-buffer)))
  31.     (when (setq win (make-window x y w h))
  32.       (setq window-list (cons win window-list))
  33.       (with-window win
  34.     (setq buffer-list (cons buffer (delq buffer (copy-list old-buf-list))))
  35.     (set-current-buffer buffer win))
  36.       win)))
  37.  
  38. (defun close-window (&optional win)
  39.   "(close-window [WIN])
  40. Close window WIN, or the current window."
  41.   (unless win
  42.     (setq win (current-window)))
  43.   (if (= (window-count) 1)
  44.       (save-and-quit)
  45.     (setq window-list (delq win window-list))
  46.     (destroy-window win)))
  47.  
  48. (defun close-other-windows (&optional win)
  49.   "(close-other-windows [WIN])
  50. Close all windows except for WIN, or the current one."
  51.   (unless win
  52.     (setq win (current-window)))
  53.   (setq window-list (delq win window-list))
  54.   (while window-list
  55.     (destroy-window (car window-list))
  56.     (setq window-list (cdr window-list)))
  57.   (setq window-list (cons win nil)))
  58.     
  59. (defun add-buffer (buffer)
  60.   "(add-buffer BUFFER)
  61. Make sure that BUFFER is in the `buffer-list' of all open windows. It gets
  62. put at the end of the list."
  63.   (let
  64.       ((win-list window-list))
  65.     (while (consp win-list)
  66.       (with-window (car win-list)
  67.     (setq buffer-list (nconc (delq buffer buffer-list) (cons buffer nil))))
  68.       (setq win-list (cdr win-list)))))
  69.  
  70. (defun remove-buffer (buffer)
  71.   "(remove-buffer BUFFER)
  72. Delete all references to BUFFER in any of the windows' `buffer-list'"
  73.   (let
  74.       ((win-list window-list))
  75.     (while (consp win-list)
  76.       (with-window (car win-list)
  77.     (setq buffer-list (delq buffer buffer-list))
  78.     (when (eq (current-buffer (car win-list)) buffer)
  79.       (set-current-buffer (car buffer-list) (car win-list))))
  80.       (setq win-list (cdr win-list)))))
  81.  
  82. (defmacro in-other-window (&rest body)
  83.   "(in-other-window BODY...) <MACRO>
  84. Switches to the ``other'' window and evaluates BODY in it."
  85.   (cons 'progn (cons '(goto-other-window) body)))
  86.  
  87. (defun goto-other-window ()
  88.   "(goto-other-window)
  89. Switch to the ``other'' window."
  90.   (set-current-window
  91.     (if (= 1 (window-count))
  92.     (open-window)
  93.       (if (eq (car window-list) (current-window))
  94.       (car (cdr window-list))
  95.     (car window-list)))
  96.     t))
  97.