🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: gnu.epoch.misc
Article #1059

Re: help about icon-name, title, *shell*

#1059
From: Mark Burhans
Date: Mon, 15 Feb 1993 23:24
178 lines
7945 bytes
In article <C270EH.AD7@ens-lyon.fr>, lperroto@ens-lyon.fr (Laurent Perroton) writes:
|> Hi, world, 
|> 
|> Here are some requests to all the "neters epoch - guru" :
|> 
|> 1) When editing a text with epoch, it displays something like
|> "--**-Epoch: textname.c" at the bottom left of each "emacs window",
|> in the information line.  The  title of the "X window" is always
|> "*scratch*" , the name of the first edited file, and it is the same
|> problem for the icon name which is not significant.
|> 
|> -> Is there some way, or some lines of code that I would put in my
|> .emacs file, to automaticly update the "icon-name" and "title"
|> variables, to display the info line "Epoch: textname.c" in the
|> corresponding X window and the corresponding icon (and which would
|> choose the upper one for example if there is more than one emacs
|> window in the X window) ? ? ? ?

Put something like this near the top of your  ~/.emacs file:

(setq load-path (append (list (expand-file-name "~/elisp")) load-path
                  (list "/usr/local/another/epoch/lispdir"
												"/dept/confident/emacs/lisp" )))

Then on down the .emacs somewhere put this in there:

(if running-epoch
    (progn

;;;------------------------------
;;; Icon and Window name routines
;;;------------------------------
		(setq include-system-name nil)   ; Takes out the "@ $HOST" from filename
		(load "scr-title")
		(setq screen-title-is-buffer-name t)

Here is "scr-title.el".  Put it in ~/elisp subdir:

----CUT----HERE---------------------------CUT----HERE-----------------------
;;; ----------------------scr-title.el------------------------------------
;;;
;;; -*- 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)

----CUT----HERE---------------------------CUT----HERE-----------------------




-- 
---Mark C. Burhans---sasmob@chewy.unx.sas.com---919/677-8001 ext 7324
SAS Institute, Inc., USA, SAS Campus Drive, Cary, NC 27513.
"Before arguing with a fool, make sure he's not doing the same thing."
Technical Details
Message-ID: <C2IJp3.DKq@unx.sas.com>
Path: arc1-ca.pugleaf.net!sparky!uunet!stanford.edu!ames!agate!spool.mu.edu!howland.reston.ans.net!gatech!concert!sas!ewe!mozart.unx.sas.com!sasmob
References: <C270EH.AD7@ens-lyon.fr>

Show Full Headers
Complete Article Headers
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: fc7ee,39e140c750a12f90
X-Google-Attributes: gidfc7ee,public
X-Google-ArrivalTime: 1993-02-15 15:24:38 PST
Newsgroups: gnu.epoch.misc
Path: arc1-ca.pugleaf.net!sparky!uunet!stanford.edu!ames!agate!spool.mu.edu!howland.reston.ans.net!gatech!concert!sas!ewe!mozart.unx.sas.com!sasmob
From: sasmob@chewy.unx.sas.com (Mark Burhans)
Subject: Re: help about icon-name, title, *shell*
Originator: sasmob@chewy.unx.sas.com
Sender: news@unx.sas.com (Noter of Newsworthy Events)
Message-ID: <C2IJp3.DKq@unx.sas.com>
Date: Mon, 15 Feb 1993 23:24:38 GMT
References:  <C270EH.AD7@ens-lyon.fr>
Nntp-Posting-Host: chewy.unx.sas.com
Organization: SAS Institute Inc.
Keywords: icon-name,title,shell
Lines: 178