[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Large fonts for Sore Eyes



The size of the standard fonts on the Lispm is inadequate for some of our
people.  The following is code we use to adjust the various fonts for them.
(Perhaps something else could be done, like redefining what font
FIX.ROMAN.NORMAL maps to???)

I'm throwing it out for other people to use and/or improve.  Paul: if you'd
like to put this into the library, please feel free.  Symbolics:  If you'd
like to advise us of a better way to do this or to clean things up so that
it works better or more easily, please do!

P.S.  You can probably also use something like this to make your demos 
more readable to people further from the machine.  (BUT try it out first
as changing font sizes causes all sorts of problems with layouts, menus,
and such.)

The user's login file has something like:

(load "library:sri;large-font")
(login-forms
  (cl-user::install-large-character-styles)
  (cl-user::install-large-printer-fonts))

Here is the file LIBRARY;SRI;LARGE-FONT:

;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: USER; Base: 10; Default-character-style: (:FIX :ROMAN :NORMAL) -*-

;;;1 This is for making a Lispm have large font for most windows.
0;;;1  (Some people have trouble seeing the standard size font.)
0;;;1 Please always call this within a LOGIN-FORMS, ie
0;;;1 (LOGIN-FORMS
0;;;	1(INSTALL-LARGE-CHARACTER-STYLES)
0;;;	1(INSTALL-LARGE-PRINTER-FONTS))

0;;;1 NOTE:  SRI has some non-standard size printers and you WILL need to
0;;;1 do something different for your printers in INSTALL-LARGE-PRINTER-FONTS

0;;;1 This code handles Lisp listeners, All Dynamic Windows(?), Editors,
0;;;1 and Telnet windows.

0;;;1 The most obvious problem not handled is that the mode-line of an editor
0;;;1 can't change in size once the window was originally set up (possibly
0;;;1 with a smaller font).  Thus the typeout to that window may not quite fit.
0;;; Don't forget you can create a new Editor after installing the large styles.

(defmethod 2(:UPDATE-DEFAULT-CHARACTER-STYLE TV:MAIN-SCREEN)0 (style)
  (send self :set-default-character-style style)
  (loop for i in tv:inferiors
	do (send-if-handles i :update-default-character-style style)))

(defmethod 2(:UPDATE-DEFAULT-CHARACTER-STYLE DW::DYNAMIC-WINDOW)0 (&optional style)
  (unless style
    (setq style (send tv:superior :default-style)))
  (send self :set-default-character-style style)
  (loop for i in tv:inferiors
	do (send-if-handles i :update-default-character-style style)))

(defmethod 2(:UPDATE-DEFAULT-CHARACTER-STYLE ZWEI:ZMACS-FRAME)0 (&optional style)
  (unless style
    (setq style (send tv:superior :default-style)))
  (send self :set-default-character-style style)
  (loop for i in tv:inferiors
	do (send-if-handles i :update-default-character-style style))
  (send self :change-of-size-or-margins))

(defmethod 2(:UPDATE-DEFAULT-CHARACTER-STYLE ZWEI:ZMACS-MODE-LINE-WINDOW)0 (&optional style)
  (unless style
    (setq style (send tv:superior :default-style)))
  (send self :set-default-character-style style)
  (send zwei:mini-buffer-window :set-default-character-style style)
  (send zwei:search-mini-buffer-window :set-default-character-style style)
  (send zwei:typein-window :set-default-character-style style)
  (loop for i in tv:inferiors
	    do (send-if-handles i :update-default-character-style style))
;  (send self :change-of-size-or-margins)	;3Can't do this as inferiors are fixed-height... BOO
0  )

(defmethod 2(:UPDATE-DEFAULT-CHARACTER-STYLE ZWEI:ZMACS-WINDOW-PANE)0 (&optional style)
  (unless style
    (setq style (send tv:superior :default-style)))
  (send self :set-default-character-style style)
  (send tv:typeout-window :set-default-character-style style))

(defmethod 2(:UPDATE-DEFAULT-CHARACTER-STYLE TELNET:NVT-WINDOW)0 (&optional style)
  (unless style
    (setq style (send tv:superior :default-style)))
  (send self :set-default-character-style style)
  (send tv:typeout-window :set-default-character-style style))

(defun 2INSTALL-LARGE-CHARACTER-STYLES 0()
  (let ((cs (si:parse-character-style '(:fix :roman :large))))
3    ;; Tell ZMAIL to use large, also controls printing size (that is why :DUTCH)
0    (setq ZWEI:*ZMAIL-DEFAULT-DEFAULT-CHARACTER-STYLE*
	  (si:parse-character-style '(:dutch :roman :large)))
    ;;3 Tell the editor to use a large font for default
0    (si:advise-permanently (flavor:method :DEFAULT-CHARACTER-STYLE zwei:MAJOR-MODE :DEFAULT)
	    :around Use-large-characters nil
      (si:parse-character-style '(:fix :roman :large)))	;3Don't use "CS" here!
0    ;;3 Tell the editor to use the appropriate fill column
0    (setf zwei:*fill-column* (* 70 (zwei:font-space-width
				     (si:get-font si:*b&w-screen* si:*standard-character-set*
						  (si:parse-character-style '(:fix :roman :large))))))
    ;;3 Tell the mode line to use a large font for mouse documentation
0    (tv:setq-who-line-control-variables
      tv:*wholine-documentation-character-style*
      (si:parse-character-style '(:fix :bold :large)))
    ;;3 This is to tell new windows to be in the right size
0    (send tv:main-screen :update-default-character-style cs)
    ))

(defun 2(:PROPERTY INSTALL-LARGE-CHARACTER-STYLES :UNDO-FUNCTION)0 (form)
  form
  `(progn
     ;;3 Tell ZMAIL to reset the default character style
0     (setq ZWEI:*ZMAIL-DEFAULT-DEFAULT-CHARACTER-STYLE* ',ZWEI:*ZMAIL-DEFAULT-DEFAULT-CHARACTER-STYLE*)
     ;;3 Tell the editor to start using the smaller font
0     (si:unadvise-permanent (flavor:method :DEFAULT-CHARACTER-STYLE zwei:MAJOR-MODE :DEFAULT)
	       :around Use-large-characters)
     (setf zwei:*fill-column* ',zwei:*fill-column*)
     ;;3 Reset the mode line
0     (tv:setq-who-line-control-variables
       tv:*wholine-documentation-character-style*
       ',tv:*wholine-documentation-character-style*)
     ;;3 Tell new windows to be in the right size
0     (send tv:main-screen :update-default-character-style
	   ',(send tv:main-screen :default-character-style))))



(defun 2INSTALL-LARGE-PRINTER-FONTS 0()
  (setq hardcopy:*hardcopy-default-character-styles*
	(loop for printer in (net:find-objects-from-property-list :printer :site net:*local-site*)
	      when (eq (send printer :type)2 :IMAGEN3000)	;3SRI-only type...
0		collect (cons (send printer :string-for-printing)
			      ;;3 6/17/88  These were :<body>-CHARACTER-STYLE rather than :DEFAULT-<body>-CHARACTER-STYLE
0			      ;;3 Seems to me they used to work that way, but maybe something has changed.
0			      '(:default-body-character-style (:dutch :roman :large)
				:default-heading-character-style (:fix :bold :small)
				:body-character-style (:dutch :roman :large)
				:heading-character-style (:fix :bold :small)))))
   ;; The ZMAIL Hardcopy Message goes through this but doesn't reset the spacing size
   ;;  unless we specifically say this.
   (si:advise-permanently 4(FLAVOR:METHOD ZWEI:REAL-HARDCOPY-OPTIONS ZWEI:HARDCOPY-OPTIONS)
0	   :around DEFAULT-CHARACTER-STYLE nil
     (let ((printer (zwei:hardcopy-device (first arglist)))
	   (val :do-it)
	   plist)
       (setq plist
	       (copy-list
		 (cdr (assoc
		      (send printer :string-for-printing)
		      hardcopy:*hardcopy-default-character-styles*
		      :test #'string-equal))))
       (remf plist ':default-body-character-style)	;These mess it up.
       (remf plist ':default-heading-character-style)
       (append val plist)
	       ))
   )


(defun 2(:PROPERTY INSTALL-LARGE-PRINTER-FONTS0 2:UNDO-FUNCTION)0 (form)
  form
  `(progn
     (setq hardcopy:*hardcopy-default-character-styles* ',hardcopy:*hardcopy-default-character-styles*)
     (si:unadvise-permanent (FLAVOR:METHOD ZWEI:REAL-HARDCOPY-OPTIONS ZWEI:HARDCOPY-OPTIONS)
	       :around DEFAULT-CHARACTER-STYLE)))

;;;1 This is to keep things from breaking...
0(si:define-character-style-families 2SI:*B&W-SCREEN* 0si:*standard-character-set*
  '(:family :fix (:size :large (:face :bold-extended fonts:medfntb))))