From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 2 Jul 2001 01:45:36 +0000 (+0000)
Subject: Add new command M-x set-default-font.
X-Git-Tag: 20090517-FFI~2684
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=7f5ad21d0327d5d39dd53f8a858bb614d3d21970;p=mit-scheme.git

Add new command M-x set-default-font.
---

diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index 92b102c5f..4a48494dc 100644
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: edwin.pkg,v 1.272 2001/06/02 16:50:47 cph Exp $
+$Id: edwin.pkg,v 1.273 2001/07/02 01:45:36 cph Exp $
 
 Copyright (c) 1989-2001 Massachusetts Institute of Technology
 
@@ -1002,6 +1002,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 	    xterm-screen/flush!
 	    xterm-screen/grab-focus!)
     (export (edwin x-commands)
+	    screen-display
 	    screen-xterm
 	    xterm-screen/set-icon-name
 	    xterm-screen/set-name)
@@ -1023,6 +1024,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 	    edwin-command$set-border-color
 	    edwin-command$set-border-width
 	    edwin-command$set-cursor-color
+	    edwin-command$set-default-font
 	    edwin-command$set-font
 	    edwin-command$set-foreground-color
 	    edwin-command$set-frame-icon-name
diff --git a/v7/src/edwin/xcom.scm b/v7/src/edwin/xcom.scm
index 729c81eaf..e8582c136 100644
--- a/v7/src/edwin/xcom.scm
+++ b/v7/src/edwin/xcom.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: xcom.scm,v 1.17 2000/12/01 06:17:00 cph Exp $
+;;; $Id: xcom.scm,v 1.18 2001/07/02 01:45:27 cph Exp $
 ;;;
-;;; Copyright (c) 1989-2000 Massachusetts Institute of Technology
+;;; Copyright (c) 1989-2001 Massachusetts Institute of Technology
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License as
@@ -16,15 +16,15 @@
 ;;;
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with this program; if not, write to the Free Software
-;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-;;;
-;;;
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;;; 02111-1307, USA.
 
 ;;;; X Commands
 
 (declare (usual-integrations))
 
 (define-primitives
+  (x-set-default-font 2)
   (x-window-clear 1)
   (x-window-lower 1)
   (x-window-raise 1)
@@ -95,6 +95,12 @@
 	    (editor-error "Unknown font name: " font))
 	(xterm-set-size xterm x-size y-size)))))
 
+(define-command set-default-font
+  "Set text font to be used in new frames."
+  "sSet default font"
+  (lambda (font)
+    (x-set-default-font (screen-display (selected-screen)) font)))
+
 (define-command set-border-width
   "Set border width of selected frame to WIDTH."
   "nSet border width"
@@ -219,7 +225,7 @@ When called interactively, completion is available on the input."
 		index)
 	       (else
 		(loop (1+ index)))))))))
-
+
 (define mouse-cursor-shapes
   '#("X-cursor"
      "arrow"
@@ -298,7 +304,6 @@ When called interactively, completion is available on the input."
      "ur-angle"
      "watch"
      "xterm"))
-
 
 ;;;; Mouse Commands
 ;;; (For compatibility with old code.)