NetNews Usenet Archive 1992 #27/NN_1992_27.iso/spool/gnu/epoch/misc/1135

Text File | 1992-11-18 | 12.1 KB | 367 lines

Path: sparky!uunet!charon.amdahl.com!pacbell.com!sgiblab!sgigate!sgi!fido!shankar
From: [e-mail] (Shankar Unni)
Newsgroups: gnu.epoch.misc
Subject: Screen-per-buffer for Epoch
Date: 19 Nov 1992 00:03:42 GMT
Organization: Silicon Graphics, Inc.
Lines: 355
Message-ID: <[e-mail]>
NNTP-Posting-Host: boris.wpd.sgi.com
X-Newsreader: Tin 1.1 PL5

I've seen enough requests for this, so I'm posting the current version
of my screen-per-buffer package.

What this package does is to force each new buffer to be put in its
own screen. If you try to find an existing buffer, it will simply
bring up its corresponding screen.

The package can be safely pre-loaded into epoch. Or else, you can load
this up in your .emacs.

Its behavior is controlled by two variables which you should set in
your .emacs:

  screen-per-buffer:  If non-nil, it will enforce the
         one-screen-per-buffer behavior (this is 'nil by default).

  buffer-no-new-screen:  This is a list of buffers for which no new
         screen is to be created. By default, it contains two buffers:
         *Completions* and *mh_temp*.  The default is generally good
         enough, though you can change this to your taste.

Either of these can be changed at any time by the user.

================ cut here ================ cut here ================
; -*-Emacs-Lisp-*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; File:         scrperbuf.el
; RCS:          $Id: scrperbuf.el,v 1.6 92/10/07 15:25:54 shankar Exp $
; Description:  Code to make Epoch create an X window per Epoch buffer (1-to-1)
; Author:       Shankar Unni, SGI.
; Created:      Fri Jun 26 11:00:00 1992
; Modified:     Wed Oct  7 15:24:54 1992 (Shankar Unni) [e-mail]
; Language:     Emacs-Lisp
; Package:      N/A
; Status:       Experimental (Do Not Distribute)
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; This piece of E-lisp allows Epoch users to associate one epoch screen (==
; X window) per Epoch buffer. It does this by overriding the definitions
; of "find-buffer" and "find-buffer-other-window", making each put up
; a new X window for each new buffer, or, if the buffer already exists,
; selecting its existing X window and raising it.

; It also overrides "kill-buffer", so that the X window for a buffer is
; deleted when the buffer is killed, and "delete-window", so that it merely
; unmaps (from the window manager, but preserves) the screen which contains
; the buffer.

; This is *NOT* a major-mode, since it is not on a per-buffer basis.

; It has a default list of buffers for which a new X window is never created.
; Keep the list as is. At the very least, " *Completions*" must be there,
; or the completion mechanism will cause a new window to be popped up,
; screwing up the focus..

; $Log:    scrperbuf.el,v $
; Revision 1.6  92/10/07  15:25:54  shankar
; Changed calls of raise-screen to mapraised-screen. This should fix the
; problem with displaying file-completions when all buffers are unmapped.
; Also added a new function to make find-alternate-file reuse current screen.
;
; Revision 1.5  92/09/24  10:17:03  shankar
; Oops. Fixed the tests in the switch-to-* defuns - I had the test
; reversed..  Also, fixed spb-delete-window to just delete the window
; if more than one window are on the screen, else just delete the screen.
;
; Revision 1.4  92/09/22  14:18:15  shankar
; More refinements to modification check in spb-kill-buffer.
; Also, put a copy of a modified find-buffer-other-screen here, rather
; than modify the copy in epoch-lisp/epoch.el. This modification is to
; prevent two copies of the same buffer from popping up.
;
; Revision 1.3  92/08/19  18:41:15  shankar
; Don't blow away screen if kill-buffer is aborted.
;
; Revision 1.2  92/07/13  15:18:45  shankar
; Fixes for enabling pre-loaded scrperbuf.el (toggled by user setting
; screen-per-buffer to non-nil).
;
; Revision 1.1  92/07/13  14:24:38  shankar
; Initial revision
;
;

(defvar screen-per-buffer 'nil
    "If non-nil, a unique Epoch screen should be associated with each Epoch
buffer, except the ones mentioned in \\[buffer-no-new-screen]")

(defvar buffer-no-new-screen '(" *Completions*" " *mh_temp*")
    "The list of buffers for which a separate screen is not created")


;
; SPB-SWITCH-TO-BUFFER is a replacement for switch-to-buffer, that creates
; a new X window for a buffer if it is not already associated with one.
; However, if the name of the buffer is in buf-no-new-screen, a new X window
; is not created.
;
(defun spb-switch-to-buffer (buffername)
  "Switch to buffer BUFFERNAME in another screen, unless it is in
the list BUFFER-NO-NEW-SCREEN"
  (interactive "BSwitch to buffer in other screen: ")
  (setq bufnm (spb-buffer-name buffername))
  (cond
     ((or (not screen-per-buffer) (strmember bufnm buffer-no-new-screen))
     (spb-real-switch-to-buffer buffername)
     )
     (t
         (find-buffer-other-screen buffername)
     )
  )
  (epoch::mapraised-screen (car (epoch::screens-of-buffer bufnm)))
  buffername
)

;
; save the old value of "switch-to-buffer" in "spb-real-switch-to-buffer",
; and replace it with the definition above.
;
(or (fboundp 'spb-real-switch-to-buffer)
    (fset 'spb-real-switch-to-buffer (symbol-function 'switch-to-buffer)))

(fset 'switch-to-buffer 'spb-switch-to-buffer)


;
; SPB-SWITCH-TO-BUFFER-OTHER-WINDOW is a replacement for switch-to-buffer-
; other-window, that creates a new X window for a buffer if it is not
; already associated with one. However, if the name of the buffer is in
; buf-no-new-screen, a new X window is not created.
;
(defun spb-switch-to-buffer-other-window (buffername)
  "Switch to buffer BUFFERNAME in another screen, unless it is in
the list BUFFER-NO-NEW-SCREEN"
  (interactive "BSwitch to buffer in other screen: ")
  (setq bufnm (spb-buffer-name buffername))
  (cond
     ((or (not screen-per-buffer) (strmember bufnm buffer-no-new-screen))
     (progn (spb-real-switch-to-buffer-other-window buffername) (other-window 1))
     )
     (t
         (find-buffer-other-screen buffername)
     )
  )
  (epoch::mapraised-screen (car (epoch::screens-of-buffer bufnm)))
  buffername
)

;
; save the old value of "switch-to-buffer-other-window" in "spb-real-switch-
; to-buffer-other-window", and replace it with the definition above.
;
(or (fboundp 'spb-real-switch-to-buffer-other-window)
    (fset 'spb-real-switch-to-buffer-other-window (symbol-function 'switch-to-buffer-other-window)))

(fset 'switch-to-buffer-other-window 'spb-switch-to-buffer-other-window)

(setq temp-buffer-show-hook 'spb-switch-to-buffer-other-window)


;
; SPB-KILL-BUFFER is replacement for kill-buffer, which also removes all
; screens (X windows) associated with the buffer.
;
(defun spb-kill-buffer (buffer)
    "Kill buffer named BUFFER, and also remove all screens showing this
buffer. If any of those screens are also showing other buffers, tough. In
any case, their screens can be brought back by calling find-buffer"
    (interactive "bKill buffer: ")
    (set-buffer buffer)
    (and (buffer-modified-p)
     (not buffer-read-only)
     (buffer-file-name)
     (not (yes-or-no-p (format "Buffer %s modified; kill anyway? "
                   (buffer-name))))
     (error "Aborted"))

    ;; hack!! to prevent a second confirmation message if the
    ;; buffer was really modified..
    (set-buffer-modified-p nil)
    ;;
    (setq screenlist (epoch::screens-of-buffer buffer))
    (spb-real-kill-buffer buffer)
    (if (and screen-per-buffer screenlist)
       (mapcar 'remove-screen screenlist)
    )
)

;
; replace kill-buffer with the definition above, saving the old symbol value
; in spb-real-kill-buffer
;
(or (fboundp 'spb-real-kill-buffer)
    (fset 'spb-real-kill-buffer (symbol-function 'kill-buffer)))

(fset 'kill-buffer 'spb-kill-buffer)

;
; SPB-DELETE-WINDOW is replacement for delete-window, which unmaps the
; screen associated with the window
;
(defun spb-delete-window (&optional window)
  "Delete WINDOW (default is current window), and optionally remove the
screen associated with it"
  ;; I only handle the current screen here. Sorry..
  (interactive)
  (setq screen (epoch::screen-of-window window))
  (cond
   ((one-window-p)
    (if (and screen-per-buffer screen)
    (remove-screen screen)
      )
   )
   (t
    (spb-real-delete-window window)
   )
  )
)

;
; replace delete-window with spb-delete-window, saving the old symbol value
; in spb-real-delete-window
;
(or (fboundp 'spb-real-delete-window)
    (fset 'spb-real-delete-window (symbol-function 'delete-window)))

(fset 'delete-window 'spb-delete-window)

;
; variant of find-alternate-file that preserves the screen (but is
; smart enough to rename it after the file is loaded). This function
; should work even if screen-per-buffer is nil, since that is basically
; all that this function is doing (i.e. setting screen-per-buffer to nil
; temporarily while executing the real find-alternate-file).
;
(defun spb-find-alternate-file(filename)
  "Find file FILENAME, select its buffer, kill previous buffer.
If the current buffer now contains an empty file that you just visited
\(presumably by mistake), use this command to visit the file you really want.

This function sets screen-per-buffer to nil and calls the real
find-alternate-file \(spb-real-find-alternate-file)"
  (interactive "FFind alternate file: ")
  (let ((screen-per-buffer nil))
    (spb-real-find-alternate-file filename)
    (let ((buf (window-buffer (epoch::selected-window (current-screen)))))
      (epoch::title (concat (buffer-name buf) (sys-name)) (current-screen) )
      (epoch::icon-name (epoch::title nil (current-screen)) (current-screen) )
    )
  )
)


(or (fboundp 'spb-real-find-alternate-file)
    (fset 'spb-real-find-alternate-file (symbol-function 'find-alternate-file)))
(fset 'find-alternate-file 'spb-find-alternate-file)

;;; --------------------------------------------------------------------------
;
; replacement for the function with the same name in epoch-lisp/epoch.el:
;
;;; --------------------------------------------------------------------------
(defun find-buffer-other-screen (buffer)
  "Switch to BUFFER in other screen.  If buffer is already in another
screen then select that, else make a new screen."
  (interactive "BSwitch to buffer other screen: ")
  (setq target-buffer (get-buffer buffer))
  (when (not target-buffer)
    (setq target-buffer (get-buffer-create buffer))
    (save-excursion
      (set-buffer target-buffer)
      (setq allowed-screens nil)
    )
  )
  (let
    (
      (scr
    (car (epoch::screens-of-buffer target-buffer))
      )
      (xname (concat (buffer-name target-buffer) (sys-name)))
    )
    (when (null scr)
      (setq scr
    (create-screen
      target-buffer
      (list (cons 'title xname) (cons 'icon-name xname))
    )
      )
    )
    (if (screen-mapped-p scr)
      (cursor-to-screen (select-screen scr))
      (progn
    (on-map-do scr 'cursor-to-screen)
    (mapraised-screen (select-screen scr))
      )
    )
    (select-window (get-buffer-window target-buffer))
    target-buffer            ;return value
  )
)

;
; utility function to canonicalize a buffer name or buffer reference to
; a string value.
;
(defun spb-buffer-name (buffernm)
   "Returns name of buffer if argument is a buffer, else returns arg."
   (let (retval)
   (cond
      ((bufferp buffernm)
          (setq retval (buffer-name buffernm))
      )
      (t
          (setq retval buffernm)
      )
   )
   retval
   )
)

;; ---------------------------------------------------------------------------

;
; string lookup in string list
;
(defun strmember (elt list)
   "Look for string ELT in list of string LIST, and return the sublist from
that element to the end of LIST"
   (let ((l1 list)
         result)
       (cond
         ((listp list)
            (while l1
                (if (string-equal elt (car l1))
                    (progn  (setq result (cdr l1))
                (if (not result) (setq result '("*DUMMYRESULT*")))
                (setq l1 nil))  ;; break out of loop
          (setq l1 (cdr l1))
                )
            )
         )
         (t
            (setq result nil)
         )
       )
       result
   )
)
================ cut here ================ cut here ================

--
Shankar Unni                E-Mail:    [e-mail]
Silicon Graphics Inc.            Phone:    [phone]