🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: cu.slug
Article #118

Re: Just about set.

#118
From: Rainer Joswig
Date: Fri, 04 Jun 1999 00:00
156 lines
6995 bytes
>I used the old IP addresses per mikemac's advice and disabled route(8)
>commands and ran Start X Screen and lo and behold, a centered
>1440x1080 Genera window pops up on this 1600x1200 screen. It's cool to
>see Zmacs and all the other Activities run at a different resolution.

Genera has a scaling to choose a smaller window than your screen
size by default. I once changed it a bit for me:


;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: USER; Base: 10; Patch-File: T -*-
(in-package :x-screen)

(defun-in-flavor (initialize-options x-console) ()
  ;; Assign the defaults that don't come from the resource database
  (unless resource-class (setq resource-class "Genera"))
  (unless resource-name (setq resource-name "genera"))

  (unless window-name
    (setq window-name (format nil "Genera on ~A" (send net:*local-host* :pretty-name))))
  (unless icon-name (setq icon-name "Genera"))

  (unless client-machine (setq client-machine (string net:*local-host*)))

  ;; Set up the resource database
  (setq resource-database (xlib:make-resource-database))
  (xlib:wm-resources resource-database root)

  (setq who-line-p
	(x-console-get-default-boolean
	  self "whoLine" "WhoLine"
	  (and (variable-boundp who-line-p) (if who-line-p "Yes" "No"))
	  default-who-line-p))

  ;; Compatible color if specified and if capable (has correct visual info)
  (block colormap
    (when (x-console-get-default-boolean
	    self "compatibleColor" "CompatibleColor"
	    (and (variable-boundp compatible-color-p) (if compatible-color-p "Yes" "No"))
	    default-compatible-color-p)
      (setf visual-info (find :pseudo-color (rest (assoc 8 (xlib:screen-depths screen)))
			      :key #'xlib:visual-info-class))
      (when visual-info
	(setf colormap (xlib:create-colormap visual-info root t))
	(setf compatible-color-p t)
	(return-from colormap)))
    (setf compatible-color-p nil)
    (let* ((depth (xlib:screen-root-depth screen))
	   (visuals (rest (assoc depth (xlib:screen-depths screen)))))
      (cond ((<= depth 2)
	     (setf visual-info (find :static-gray visuals :key #'xlib:visual-info-class))
	     (when visual-info
	       (setf colormap (xlib:create-colormap visual-info root))
	       (return-from colormap)))
	    ((<= depth 4)
	     (setf visual-info (find :static-color visuals :key #'xlib:visual-info-class))
	     (when visual-info
	       (setf colormap (xlib:create-colormap visual-info root))
	       (return-from colormap)))))
    (setf visual-info (xlib:screen-root-visual-info screen))
    (setf colormap (xlib:screen-default-colormap screen)))

  (unless window-min-width (setq window-min-width (if who-line-p 640 320)))
  (unless window-min-height (setq window-min-height (if who-line-p 320 160)))
  (unless window-max-width (setq window-max-width (xlib:screen-width screen)))
  (unless window-max-height (setq window-max-height (xlib:screen-height screen)))

  ;; default the stuff from the resource database that should be defaulted
  (unless (and window-x window-y window-width window-height)
    (multiple-value-setq (window-x window-y window-width window-height)
      (x-console-get-default-geometry
	self "geometry" "Geometry"
	(or window-geometry default-window-geometry)
	(or window-x (round (xlib:screen-width screen) 20))
	(or window-y (round (xlib:screen-height screen) 20))
	(or window-width (- (xlib:screen-width screen) (round (xlib:screen-width screen) 20)))
	(or window-height
	    (- (xlib:screen-height screen)
	       (round (xlib:screen-height screen) 20))))))
  (setq window-width (max (min window-width window-max-width) window-min-width))
  (setq window-height (max (min window-height window-max-height) window-min-height))

  (unless window-depth
    (setq window-depth
	(x-console-get-default-integer
	  self "depth" "Depth" window-depth default-window-depth)))
  (setq window-depth (min window-depth (xlib:screen-root-depth screen)))

  (unless (and icon-x icon-y)
    (multiple-value-setq (icon-x icon-y icon-width icon-height)
      (x-console-get-default-geometry
	self "iconGeometry" "IconGeometry"
	(or icon-geometry default-icon-geometry)
	nil nil nil nil)))

  (unless initial-state
    (setq initial-state
	  (x-console-get-default-keyword
	    self "initialState" "InitialState"
	    initial-state default-initial-state
	    '(:dont-care :normal :iconic))))

  (setq border-color
	(x-console-get-default-color
	  self "borderColor" "BorderColor"
	  border-color default-border-color))
  (setq border
	(if compatible-color-p
	    255
	    (xlib:alloc-color colormap border-color)))
  (setq border-width
	(x-console-get-default-integer
	  self "borderWidth" "BorderWidth"
	  border-width default-border-width))

  (setq foreground-color
	(x-console-get-default-color
	  self "foreground" "Foreground"
	  foreground-color default-foreground-color))
  (setq foreground
	(if compatible-color-p
	    255
	    (xlib:alloc-color colormap foreground-color)))
  (setq background-color
	(x-console-get-default-color
	  self "background" "Background"
	  background-color default-background-color))
  (setq background
	(if compatible-color-p
	    0
	    (xlib:alloc-color colormap background-color)))
  (when (= foreground background)
    (setq foreground (xlib:screen-black-pixel screen)
	  background (xlib:screen-white-pixel screen)))

  (setq cursor-foreground-color
	(x-console-get-default-color
	  self "cursorForeground" "CursorForeground"
	  cursor-foreground-color
	  (or default-cursor-foreground-color foreground-color)))
  (when (stringp cursor-foreground-color)
    (setf cursor-foreground-color (xlib:lookup-color colormap cursor-foreground-color)))
  (setq cursor-background-color
	(x-console-get-default-color
	  self "cursorBackground" "CursorBackground"
	  cursor-background-color
	  (or default-cursor-background-color background-color)))
  (when (stringp cursor-background-color)
    (setf cursor-background-color (xlib:lookup-color colormap cursor-background-color)))

  (update-command)
  ) 


Rainer Joswig, "Lavielle" EDV Systemberatung GmbH & Co. KG, Lotharstrasse 2b,
D22041 Hamburg, Tel: +49 40 658088, Fax: +49 40 65808-202,
Email: joswig@lavielle.com , WWW: http://www.lavielle.de/
Technical Details
Message-ID: <928492352.14698@news.Colorado.EDU>
Path: arc1-ca.pugleaf.net!unknown!not-for-mail
References: <87r9nsvc1o.fsf@2xtreme.net>

Show Full Headers
Complete Article Headers
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: 10077e,e4ddee7f88f541df
X-Google-Attributes: gid10077e,public
From: Rainer Joswig <joswig@lavielle.com>
Subject: Re: Just about set.
Date: 1999/06/04
Message-ID: <928492352.14698@news.Colorado.EDU>
X-Deja-AN: 485620154
Distribution: cu
Sender: daemon@peabody.colorado.edu
References: <87r9nsvc1o.fsf@2xtreme.net>
X-Sender: joswig@194.64.21.10
Content-Type: text/plain; charset="us-ascii"
X-Note1: message-id generated by recnews
X-Note2: mail msgid was   <v04205103b37d588948a5@[194.64.21.18]>
Organization: University of Colorado at Boulder
Mime-Version: 1.0
Newsgroups: cu.slug
NNTP-Posting-User: daemon