🚀 go-pugleaf

Some time ago i snapped the following from gnu.emacs.sources. I think
it will do the job. It works for me.

Enjoy.

----- Cut here -----
;; ---------------- title.el version 1.2 --------------------
;; File:         title.el
;; Description:  Set x-window titles for epoch screens
;; Author:       Derek Ney (derek@boingo.med.jhu.edu)
;; Created:      7Feb92
;; Modified:     10Feb92,11Feb92
;; Version:      1.2

;; Adopted by:   Thomas Jul Jensen (jul@iesd.auc.dk)
;; Date:         14.02.92
;; Modified:     14.02.92

;; E-lisp routines for Epoch that set the title of the window
;; and icon for an Epoch screen to the names of the buffers
;; being visited in that screen

;; Written by Derek Ney, February 1992
;; Copyright 1992 Derek Ney
;; Everyone is granted permission to copy, modify and redistribute
;; this file, provided the people they give it to can.

;; Modified to fix problems with a non-local minibuffer and
;; window-creation problems

;; This set of routines attempts to keep the X-window title and
;; icon title names to be the same as the names of the buffers
;; being visited in the X-window epoch screen. It allows the
;; user to specify a list of excluded buffer names which are
;; never shown in the title (such as "*Buffer List*" etc.).
;; The title is prefixed with the string in the variable
;; "epoch::window-title-prefix". Also, the routines by default
;; ignore buffers with names starting with space. This behaviour
;; can be turned off by setting the variable 
;; "epoch::exclude-buffer-names-starting-with-space" to nil.
;; These routines use the hook "set-window-buffer-hook" found
;; in src/window.c. If this is already being used by you for
;; something, these routines will conflict with it.
;;
;; Known problems: The code seems to work well. However, the titles
;; and the visited buffer names can get out of sync when the user
;; does certain things. The function "delete-other-windows" usually
;; bound to "^X1" does not update the windows using the hook that
;; these routines use. Also, if the user cancels a find file in which
;; a list of file-name completions have been asked for, the titles
;; are not updated to show the correct buffer names. I would be
;; interested in any patches that would correct this behaviour. 
;; For now, I suggest that you bind the command defined here as
;; "epoch::refresh-screen-titles" to a key, so that in these cases
;; the titles can be reset with a quick key stroke. 

;; Note that this is my first attempt at E-lisp code and I didn't
;; even have the reference manual. Please forgive any blunders.

(defvar epoch::exclude-buffer-names-from-window-titles 
  (list "*Buffer List*" "*Help*" nil )
  "A list of buffer names which you do not ever want displayed
in a window title")

(defvar epoch::exclude-buffer-names-starting-with-space t
  "Buffer names starting with space are generally temporary buffers for 
help or permenant things like minibuffers. If this variable is true
then these buffer names are never displayed.")

(defvar epoch::window-title-prefix "Epoch: " 
  "The prefix put before the list of currently displayed buffers for a window")

(defun epoch::possibly-append-buffer-name (buffer names)
  "This function appends the name of the given buffer to a list of strings
given as its second argument. It is appended only if the buffer name is not in the list of excluded files given by exclude-buffer-names-from-window-titles
and it is not already in the list. It returns the list"

  (setq the-name (buffer-name buffer))

  (setq exclude nil)
  (setq list-of-names names)

  (if epoch::exclude-buffer-names-starting-with-space 
      (if (equal (substring the-name 0 1) " ")
	  (setq exclude t)))

  (while list-of-names
    (if (equal the-name (car list-of-names)) (setq exclude t))
    (setq list-of-names (cdr list-of-names)))
  
  (setq exclusion epoch::exclude-buffer-names-from-window-titles)
  (while exclusion
    (if (equal the-name (car exclusion)) (setq exclude t))
    (setq exclusion (cdr exclusion)))

  (if (not exclude)
      (setq names (append (list the-name) names)))

  names)

(defun find-last-window (first-window)
  "Finds the last window in a chain of them beginning with first-window."

  ;; If things worked right we should be able to do this:
  ;;    (setq last-window (previous-window first-window))
  ;; But, the some routine is calling the set-window-buffer routine
  ;; with a window that has not been linked correctly. This
  ;; causes the previous-window routine to bomb. Hopefully this is
  ;; only a problem with the previous-window routine and the 
  ;; next-window routine still works. This code is a hack but
  ;; basically it traverses the window links until if gets back
  ;; to the first-window or a window count expires. If the count
  ;; expires it is assumed that the list is incorrectly formatted
  ;; and it is furthur assumed that first-window is the only window
  ;; for this chain

  ;; if their are more than 10 windows this routine will assume that
  ;; it is actually an invalid chain. Obviously it is possible to
  ;; have 10 windows, but it is very unlikely
  (setq count 10)

  ;; we will also check to see that the windows are on the screen
  ;; of the first window. If not, we assume we went past the end
  ;; of the chain
  (setq first-window-screen (epoch::screen-of-window first-window))

  (setq last-window first-window)
  (setq a-window (next-window first-window t))

  (while (and (not (eq a-window first-window)) 
	      (eq (epoch::screen-of-window a-window) first-window-screen)
	      (not (equal count 0))
	      )
    (setq last-window a-window)
    (setq a-window (next-window a-window t))
    (decf count))
    
  ;; if count expired then assume chain is malformed and return first-window
  (if (equal count 0) (setq last-window first-window))

  last-window)

(defun epoch::set-titles-for-screen (the-screen)
  "Sets the epoch screen name based upon all of the windows contained
in the screen given as an argument."  

  ;; this routine does not mess with the minibuffer screen
  (if (not (eq the-screen (epoch::minibuf-screen)))
      (let () 
	;; This is a fix for what I percieve as a bug in emacs and epoch
	;; When a screen is created, it seems that the window-list
	;; is in an invalid state sometimes when this hook is called
	;; and the list of windows does not have a link from its tail
	;; to the first-window. This causes our routine to screw up
	;; It seems to only be a problem with the first-window. Others
	;; are linked circularly. If they had just made the next-window
	;; routine return nil when you get to the end this would all
	;; be fixed, but alas it is not true->it is a circular list
	;; The fix simply finds the "tail" of the list by starting
	;; with the previous-window of the first-window
	;; However, this seems to only happen when the first-window
	;; should actually be the only window. So we can detect this
	;; a set things up accordingly by making the last-window
	;; the first window.
	(setq first-window (epoch::first-window the-screen))
	(setq last-window (find-last-window first-window))

	(setq a-window first-window)
	(setq name-list nil)

	(while (not (eq a-window last-window))
	  (setq name-list (epoch::possibly-append-buffer-name 
			   (window-buffer a-window)
			   name-list))
	  ;; the second argument to next-window means to count the minibuffer
	  ;; this is critical if the minibuf is the first-window
	  (setq a-window (next-window a-window t))
	  )
	;; get the last one
	(setq name-list (epoch::possibly-append-buffer-name
			 (window-buffer a-window)
			 name-list))

	(setq whole-name epoch::window-title-prefix)
	(setq whole-name (concat whole-name (car name-list)))
	(setq name-list (cdr name-list))
	(while name-list
	  (setq whole-name (concat whole-name "," (car name-list)))
	  (setq name-list (cdr name-list)))
	
	(epoch::title whole-name the-screen)
	(epoch::icon-name whole-name the-screen)
	))
  nil)

(defun epoch::set-titles-from-window (window)
  "Sets the epoch screen name based upon all of the windows contained
in the screen that owns the window given as the argument."

  (epoch::set-titles-for-screen (epoch::screen-of-window window))
  )

(defun epoch::refresh-screen-titles ()
  "Goes thru all of the mapped screens and refreshes the window
and icon titles."
  
  (interactive)
  (setq screens (epoch::screen-list t))
  (while screens
    (epoch::set-titles-for-screen (car screens))
    (setq screens (cdr screens)))
  )

(setq set-window-buffer-hook 'epoch::set-titles-from-window)

(epoch::refresh-screen-titles)