🚀 go-pugleaf

[Maybe this bit might be included in the Epoch distribution?]

In article <7818872@MVB.SAIC.COM> you write:
>but is the initial window in epoch supposed to be named
>*scratch* even if epoch is invoked with a filename argument.  Mine is.

I use the following piece of code.  I don't know where I originally
got it from, or why I hacked up some of the things that I did, but it
does do the following:

- Changes screen and icon title whenever the screen is entered or
  iconified.
- Uses the form `buffername @ initial_hostname' for local files.
- Uses the form `buffername @ remote_host' for remote files.

For example, when I start up Epoch (from my .xsession), I get a screen
labeled `*scratch* @ trantor'.  If I then open `.bashrc', the title
eventually changes to `.bashrc @ trantor'.  If I then open
/emily.uvm.edu:/pub in dired, it eventually changes to `pub @
emily.uvm.edu'.

I no longer remember which parts are mine and which parts are the
original author's; sorry.

Here goes:

------------------------------------
;;; -*- Mode: Emacs-Lisp; Syntax: Common-lisp; Base: 10; -*-
;;; File: scr-title.el
;;; Author: Heinz Schmidt (hws@icsi.berkeley.edu)
;;; Created: Thu Nov 29 19:40:34 1990
;;; Copyright (C) 1990, International Computer Science Institute
;;;
;;; THIS CODE IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR MODIFY IT.  WE
;;; DISTRIBUTE IT IN THE HOPE THAT IT WILL BE USEFUL. BUT EXCEPT WHEN OTHERWISE
;;; STATED IN WRITING, THE INTERNATIONAL COMPUTER SCIENCE INSTITUTE AND/OR THE
;;; AUTHOR(S) PROVIDE THIS CODE "AS IS" WITHOUT WARRANTY OF ANY KIND.
;;;*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;;;* FUNCTION: Explicit and startup setting of screen and icon titles,
;;;*           Native Epoch creates screens with current buffer title, but
;;;*           titles are not changed when other buffer is selected. 
;;;*
;;;* RELATED PACKAGES: builds on epoch.el hook *create-screen-hook*
;;;*
;;;* HISTORY: 
;;;*  Dec  5 21:08 1990 (hws): fixed buffer-title-screen to work like doc says.
;;;*  Nov 29 19:40 1990 (hws): buffer-title-screen split off my .epoch 
;;;*   and added the hook functionality.
;;;*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

(defvar buffer-ange-ftp-regexp
  "/\\(\\([-a-zA-Z0-9]+@\\)?\\)\\([-.a-zA-Z0-9]+\\):/"
  "Regexp which matches any directory which is in ange-ftp such that
the third subexpression matches the host name.")

(defun buffer-title-screen (&optional arg)
  "Redefines the title of the screen to be the name of the current buffer.
The icon name is changed appropriately. 
With \\[universal-argument] 0 prompts for the title,
     \\[universal-argument] positive chooses a default title independent
of buffer names."
  (interactive "P")
  (let* ((system (if (string-match buffer-ange-ftp-regexp default-directory)
		     (substring default-directory
				(match-beginning 3)
				(match-end 3))
		   (system-name)))
				   
	 (newtitle 
	  (cond ((null arg)
		 (concat 
		  (format "%s" (buffer-name (current-buffer)))
		  (if include-system-name (format " @ %s" system) "")))
		((zerop arg) (read-input "Screen title: "))
		(t (default-screen-title))))
	 (oldtitle
	  (epoch::get-property "EpochTitle" (current-screen))))
    (if (string-equal oldtitle newtitle)
	t
      (progn
	(epoch::set-property "EpochTitle" newtitle)
	(title newtitle)
	(icon-name newtitle)))))

(defvar screen-count 0)
(defun default-screen-title ()
  (concat 
   (format "Epoch %d" (setq screen-count (1+ screen-count)))
   (if include-system-name		; respect user profile settings
       (format " @ %s" (system-name))
     "")))

(defvar epoch-screen-title-alist nil
  "* An alist mapping screen titles (symbols) to X default property lists.")

(defun title-create-screen-hook (alist)
  "A hook to push into *create-screen-alist-hook*. Defines the title for screens
and their icons. Set include-system-name to NIL if the title gets too long for
your window manager."
  (let* ((tit (assq 'title alist))
	 (props (assq (intern (cdr tit)) epoch-screen-title-alist))
	 (icon (assq 'icon-name alist))
	 (newtitle (default-screen-title)))
    (if  props
	(append props alist)
      (progn
	(rplacd tit newtitle)
	(rplacd icon newtitle)
	alist))))

(defvar screen-title-is-buffer-name nil
  "*When T, the screen title is made the buffer name whenever the screen is 
selected.")		      ; can we do better? no hook when mode-line changes.

(defun auto-buffer-title-screen-hook ()
  (when screen-title-is-buffer-name (buffer-title-screen nil)))

;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;;; Activate screen title commands

;close to title refresh \C-za, on a key free in native Epoch.
(define-key epoch-cmds-map "\C-b" 'buffer-title-screen) 

(push 'auto-buffer-title-screen-hook *select-screen-hook*)
;(push 'title-create-screen-hook *create-screen-alist-hook*)

;;; The first screen is already created when this file is processed. Set
;;; title explicitly.

;(buffer-title-screen 2)

;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;;; Customize screen sizes on a mode basis. This shows how it works.
;;;
;
;(push '(lisp-mode (geometry . "80x48+20+100") (cursor-glyph . 2)
;		  (title . "Lisp") (icon-name . "Lisp")) epoch-mode-alist)
;(push '(emacs-lisp-mode (geometry . "81x52+20+100") (cursor-glyph . 2)
;			(title . "Lisp") (icon-name . "Lisp")) epoch-mode-alist)
;(push '(c-mode (geometry . "80x40+100+0") (cursor-glyph . 2)
;			(title . "C") (icon-name . "C")) epoch-mode-alist)
;

;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;;; Customize screen sizes on a title basis. This is useful for unique screens
;;; like *compilation* or a server screen serving emacsclients.
;;;
;(push '(*compilation* (geometry . "80x48+10+100") (cursor-glyph . 2)
;		      (title . "Compilation") (icon-name . "GnuComp"))
;      epoch-screen-title-alist)
;(push '(Server\ Screen (geometry . "80x45+50+50") (cursor-glyph . 2)
;		      (title . "Server Screen") (icon-name . "GnuServe"))
;      epoch-screen-title-alist)

		      
------------------------------------
[no save]

-GAWollman

--
   Garrett A. Wollman  = wollman@emba.uvm.edu = UVM is welcome to my opinions
                       =    uvm-gen!wollman   =
   That's what being alive is all about.  No deity, no higher goal
   exists, than to bring joy to another person.    - Elf Sternberg