Don't update window and icon names unless they have changed.

diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index a13558f4396a052d9574a2e840c60eaa98ae37cb..3053de72b744f7d52c85313c5b115fe96fd63296 100644 (file)
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: edwin.pkg,v 1.103 1992/11/17 22:52:27 cph Exp $
+$Id: edwin.pkg,v 1.104 1992/11/20 18:24:38 cph Exp $
 
 Copyright (c) 1989-1992 Massachusetts Institute of Technology
 
@@ -905,32 +905,56 @@ MIT in each case. |#
   (files "xterm")
   (parent (edwin screen))
   (export (edwin)
+         edwin-variable$x-screen-name-format
+         edwin-variable$x-screen-name-length
+         edwin-variable$x-screen-icon-name-format
+         edwin-variable$x-screen-icon-name-length
          x-screen-auto-raise
          xterm-screen/flush!
          xterm-screen/grab-focus!)
   (export (edwin x-commands)
-         screen-xterm)
+         screen-xterm
+         xterm-screen/set-icon-name
+         xterm-screen/set-name)
   (initialization (initialize-package!)))
 
 (define-package (edwin x-commands)
   (files "xcom")
   (parent (edwin))
   (export (edwin)
+         edwin-command$x-auto-raise-mode
+         edwin-command$x-lower-screen
+         edwin-command$x-mouse-ignore
+         edwin-command$x-mouse-keep-one-window
+         edwin-command$x-mouse-select
+         edwin-command$x-mouse-select-and-split
+         edwin-command$x-mouse-set-mark
+         edwin-command$x-mouse-set-point
+         edwin-command$x-mouse-show-event
+         edwin-command$x-raise-screen
+         edwin-command$x-set-background-color
+         edwin-command$x-set-border-color
+         edwin-command$x-set-border-width
+         edwin-command$x-set-cursor-color
+         edwin-command$x-set-font
+         edwin-command$x-set-foreground-color
+         edwin-command$x-set-icon-name
+         edwin-command$x-set-internal-border-width
+         edwin-command$x-set-mouse-color
+         edwin-command$x-set-mouse-shape
+         edwin-command$x-set-position
+         edwin-command$x-set-size
+         edwin-command$x-set-window-name
          x-button1-down
-         x-button2-down
-         x-button3-down
-         x-button4-down
-         x-button5-down
          x-button1-up
+         x-button2-down
          x-button2-up
+         x-button3-down
          x-button3-up
+         x-button4-down
          x-button4-up
-         x-button5-up
-         edwin-variable$x-screen-name-format
-         edwin-variable$x-screen-icon-name-format
-         edwin-variable$x-screen-icon-name-length)
-  (export (edwin screen x-screen)
-         update-xterm-screen-names!))
+         x-button5-down
+         x-button5-up))
 
 (define-package (edwin keys)
   (files "key")

diff --git a/v7/src/edwin/xcom.scm b/v7/src/edwin/xcom.scm
index b31ed9c0a490eedd001c54f67431db012a951a7b..3e2da22d818fa2a333515050f5362fe5cbcd12d4 100644 (file)
--- a/v7/src/edwin/xcom.scm
+++ b/v7/src/edwin/xcom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/xcom.scm,v 1.8 1992/03/26 22:29:37 cph Exp $
+;;;    $Id: xcom.scm,v 1.9 1992/11/20 18:24:46 cph Exp $
 ;;;
 ;;;    Copyright (c) 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -52,11 +52,9 @@
   (x-window-set-cursor-color 2)
   (x-window-set-font 2)
   (x-window-set-foreground-color 2)
-  (x-window-set-icon-name 2)
   (x-window-set-internal-border-width 2)
   (x-window-set-mouse-color 2)
   (x-window-set-mouse-shape 2)
-  (x-window-set-name 2)
   (x-window-set-position 3)
   (x-window-set-size 3)
   (xterm-x-size 1)
@@ -141,53 +139,14 @@
 Useful only if `x-screen-name-format' is false."
   "sSet X window name"
   (lambda (name)
-    (x-window-set-name (current-xterm) name)))
+    (xterm-screen/set-name (selected-screen) name)))
 
 (define-command x-set-icon-name
   "Set X window icon name to NAME.
 Useful only if `x-screen-icon-name-format' is false."
   "sSet X window icon name"
   (lambda (name)
-    (x-window-set-icon-name (current-xterm) name)))
-
-(define-variable x-screen-name-format
-  "If not false, template for displaying X window name.
-Has same format as `mode-line-format'."
-  'mode-line-buffer-identification)
-
-(define-variable x-screen-icon-name-format
-  "If not false, template for displaying X window icon name.
-Has same format as `mode-line-format'."
-  "edwin")
-
-(define-variable x-screen-icon-name-length
-  "Maximum length of X window icon name.
-Used only if `x-screen-icon-name-format' is non-false."
-  32)
-
-(define (update-xterm-screen-names! screen)
-  (let ((window
-        (if (and (selected-screen? screen) (within-typein-edit?))
-            (typein-edit-other-window)
-            (screen-selected-window screen)))
-       (xterm (screen-xterm screen)))
-    (let ((update-name
-          (lambda (set-name variable length)
-            (let ((format
-                   (variable-local-value (window-buffer window) variable)))
-              (if format
-                  (set-name
-                   xterm
-                   (string-trim-right
-                    (format-modeline-string window format length))))))))
-      (update-name x-window-set-name
-                  (ref-variable-object x-screen-name-format)
-                  (screen-x-size screen))
-      (update-name x-window-set-icon-name
-                  (ref-variable-object x-screen-icon-name-format)
-                  (variable-local-value
-                   (window-buffer window)
-                   (ref-variable-object x-screen-icon-name-length))))))
+    (xterm-screen/set-icon-name (selected-screen) name)))
 
 (define-command x-raise-screen
   "Raise the editor screen so that it is not obscured by other X windows."

diff --git a/v7/src/edwin/xterm.scm b/v7/src/edwin/xterm.scm
index 5a76a0653661d6d60af4afffeb126eda43fde690..e044a1d32640bddf0d3422e776f3cf4b9a6f5c29 100644 (file)
--- a/v7/src/edwin/xterm.scm
+++ b/v7/src/edwin/xterm.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/xterm.scm,v 1.35 1992/09/14 20:14:31 cph Exp $
+;;;    $Id: xterm.scm,v 1.36 1992/11/20 18:24:55 cph Exp $
 ;;;
 ;;;    Copyright (c) 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -115,7 +115,9 @@
   (xterm false read-only true)
   (display false read-only true)
   (redisplay-flag true)
-  (selected? true))
+  (selected? true)
+  (name false)
+  (icon-name false))
 
 (define screen-list)
 
@@ -152,10 +154,17 @@
                        (xterm-y-size xterm)))))
     (set! screen-list (cons screen screen-list))
     screen))
-
+\f
 (define-integrable (screen-xterm screen)
   (xterm-screen-state/xterm (screen-state screen)))
 
+(define (xterm->screen xterm)
+  (let loop ((screens screen-list))
+    (and (not (null? screens))
+        (if (eq? xterm (screen-xterm (car screens)))
+            (car screens)
+            (loop (cdr screens))))))
+
 (define-integrable (screen-display screen)
   (xterm-screen-state/display (screen-state screen)))
 
@@ -171,29 +180,94 @@
 (define-integrable (set-screen-selected?! screen selected?)
   (set-xterm-screen-state/selected?! (screen-state screen) selected?))
 
-(define (xterm->screen xterm)
-  (let loop ((screens screen-list))
-    (and (not (null? screens))
-        (if (eq? xterm (screen-xterm (car screens)))
-            (car screens)
-            (loop (cdr screens))))))
+(define-integrable (screen-name screen)
+  (xterm-screen-state/name (screen-state screen)))
+
+(define-integrable (set-screen-name! screen name)
+  (set-xterm-screen-state/name! (screen-state screen) name))
+
+(define (xterm-screen/set-name screen name)
+  (let ((name* (screen-name screen)))
+    (if (or (not name*) (not (string=? name name*)))
+       (begin
+         (set-screen-name! screen name)
+         (x-window-set-name (screen-xterm screen) name)))))
+
+(define-integrable (screen-icon-name screen)
+  (xterm-screen-state/icon-name (screen-state screen)))
+
+(define-integrable (set-screen-icon-name! screen name)
+  (set-xterm-screen-state/icon-name! (screen-state screen) name))
+
+(define (xterm-screen/set-icon-name screen name)
+  (let ((name* (screen-icon-name screen)))
+    (if (or (not name*) (not (string=? name name*)))
+       (begin
+         (set-screen-icon-name! screen name)
+         (x-window-set-icon-name (screen-xterm screen) name)))))
 \f
 (define (xterm-screen/wrap-update! screen thunk)
-  (dynamic-wind
-   (lambda ()
-     (xterm-enable-cursor (screen-xterm screen) false))
-   thunk
-   (lambda ()
-     (if (screen-selected? screen)
-        (let ((xterm (screen-xterm screen)))
-          (xterm-enable-cursor xterm true)
-          (xterm-draw-cursor xterm)))
-     (if (screen-redisplay-flag screen)
-        (begin
-          (update-xterm-screen-names! screen)
-          (set-screen-redisplay-flag! screen false)))
-     (xterm-screen/flush! screen))))
-
+  (let ((finished? false))
+    (dynamic-wind
+     (lambda ()
+       (xterm-enable-cursor (screen-xterm screen) false))
+     (lambda ()
+       (let ((result (thunk)))
+        (set! finished? result)
+        result))
+     (lambda ()
+       (if (screen-selected? screen)
+          (let ((xterm (screen-xterm screen)))
+            (xterm-enable-cursor xterm true)
+            (xterm-draw-cursor xterm)))
+       (if (and finished? (screen-redisplay-flag screen))
+          (begin
+            (update-xterm-screen-names! screen)
+            (set-screen-redisplay-flag! screen false)))
+       (xterm-screen/flush! screen)))))
+
+(define (update-xterm-screen-names! screen)
+  (let ((window
+        (if (and (selected-screen? screen) (within-typein-edit?))
+            (typein-edit-other-window)
+            (screen-selected-window screen))))
+    (let ((buffer (window-buffer window))
+         (update-name
+          (lambda (set-name format length)
+            (if format
+                (set-name
+                 screen
+                 (string-trim-right
+                  (format-modeline-string window format length)))))))
+      (update-name xterm-screen/set-name
+                  (ref-variable x-screen-name-format buffer)
+                  (ref-variable x-screen-name-length buffer))
+      (update-name xterm-screen/set-icon-name
+                  (ref-variable x-screen-icon-name-format buffer)
+                  (ref-variable x-screen-icon-name-length buffer)))))
+
+(define-variable x-screen-name-format
+  "If not false, template for displaying X window name.
+Has same format as `mode-line-format'."
+  'mode-line-buffer-identification)
+
+(define-variable x-screen-name-length
+  "Maximum length of X window name.
+Used only if `x-screen-name-format' is non-false."
+  64
+  exact-nonnegative-integer?)
+
+(define-variable x-screen-icon-name-format
+  "If not false, template for displaying X window icon name.
+Has same format as `mode-line-format'."
+  "edwin")
+
+(define-variable x-screen-icon-name-length
+  "Maximum length of X window icon name.
+Used only if `x-screen-icon-name-format' is non-false."
+  32
+  exact-nonnegative-integer?)
+\f
 (define (xterm-screen/discard! screen)
   (set! screen-list (delq! screen screen-list))
   (x-close-window (screen-xterm screen)))