Skip to content

FONTPROFILE: specvars declaration for cleanliness #1351

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Oct 16, 2023
Merged

FONTPROFILE: specvars declaration for cleanliness #1351

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
146 changes: 69 additions & 77 deletions sources/FONTPROFILE
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,19 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)

(FILECREATED "13-Apr-2023 08:40:30" {DSK}<home>larry>il>medley>sources>FONTPROFILE.;2 35652
(FILECREATED "23-Jul-2023 20:42:48" {WMEDLEY}<sources>FONTPROFILE.;4 34903

:EDIT-BY "lmm"
:EDIT-BY rmk

:CHANGES-TO (ALISTS (FONTDEFS HUGE)
(FONTDEFS BIG)
(FONTDEFS MEDIUM)
(FONTDEFS STANDARD)
(FONTDEFS BIGGER)
(FONTDEFS NS)
(FONTDEFS BIGGERNS))
(VARS FONTPROFILECOMS)
:CHANGES-TO (FNS FONTSET)

:PREVIOUS-DATE " 6-Sep-2021 19:11:32" {DSK}<home>larry>il>medley>sources>FONTPROFILE.;1)
:PREVIOUS-DATE "13-Apr-2023 08:40:30" {WMEDLEY}<sources>FONTPROFILE.;3)


(PRETTYCOMPRINT FONTPROFILECOMS)
Expand Down Expand Up @@ -459,7 +452,9 @@
(DEFINEQ

(FONTSET
[LAMBDA (NAME CHANGE-WINDOWS?) (* ; "Edited 23-Jun-88 10:46 by jds")
[LAMBDA (NAME CHANGE-WINDOWS?) (* ; "Edited 23-Jul-2023 20:42 by rmk")
(* ; "Edited 23-Jun-88 10:46 by jds")
(DECLARE (SPECVARS NAME))
(COND
[NAME
(LET
Expand All @@ -470,71 +465,68 @@
(* ;; "Looks up NAME on FONTSLST and sets apropriate parameters. entries are added to fontslst by FONTNAME.")

(for X in FONTVARS when (AND (CL:SYMBOLP (CAR X))
(NEQ (CAR X)
'*)
(NEQ (CAR X)
(CADR X))) do (SETTOPVAL (CAR X)))
(NEQ (CAR X)
'*)
(NEQ (CAR X)
(CADR X))) do (SETTOPVAL (CAR X)))
[MAPC (CDR TEM)
(FUNCTION (LAMBDA (X)
(/SETTOPVAL (CAR X)
(CDR X]
[PROG (BASICCLASSES)
(for X in FONTPROFILE
do (PROG (SEEN (NAME (CAR X))
(FONTS X))
LP [COND
((MEMB (CAR FONTS)
SEEN)
(ERROR "Circular font profile specification" X))
(T (push SEEN (CAR FONTS]
[SETQ FONTS (CDR (COND
((OR (NULL (CADR FONTS))
(LISTP (CADR FONTS)))
(FONTS X))
LP [COND
((MEMB (CAR FONTS)
SEEN)
(ERROR "Circular font profile specification" X))
(T (push SEEN (CAR FONTS]
[SETQ FONTS (CDR (COND
((OR (NULL (CADR FONTS))
(LISTP (CADR FONTS)))
(*)
(* ;
 "This skips over the now-defunct NIL or list-of-escape sequence")
(CDR FONTS))
(T FONTS]
(COND
((OR (NLISTP FONTS)
(LITATOM (CAR FONTS)))(* ;
 "Indirect thru another's font spec")
(AND (SETQ FONTS (ASSOC (SELECTQ (CAR (LISTP FONTS))
((NIL DEFAULTFONT)
 "This skips over the now-defunct NIL or list-of-escape sequence")
(CDR FONTS))
(T FONTS]
(COND
((OR (NLISTP FONTS)
(LITATOM (CAR FONTS))) (* ; "Indirect thru another's font spec")
(AND (SETQ FONTS (ASSOC (SELECTQ (CAR (LISTP FONTS))
((NIL DEFAULTFONT)
(* ;
 "Don't let DEFAULTFONT loop thru itself")
(AND (NOT (MEMB 'DEFAULTFONT SEEN
))
'DEFAULTFONT))
(CAR FONTS))
FONTPROFILE))
(GO LP)))
(T [push BASICCLASSES (SETQ FONTS (FONTCLASS NAME FONTS
'DISPLAY]
 "Don't let DEFAULTFONT loop thru itself")
(AND (NOT (MEMB 'DEFAULTFONT SEEN))
'DEFAULTFONT))
(CAR FONTS))
FONTPROFILE))
(GO LP)))
(T [push BASICCLASSES (SETQ FONTS (FONTCLASS NAME FONTS 'DISPLAY]
(* ;
 "Now we have a font class datastructure")
))
(AND NAME (/SETTOPVAL NAME FONTS))
 "Now we have a font class datastructure")
))
(AND NAME (/SETTOPVAL NAME FONTS))

(* ;; "NIL for the class-name means just establish the font-correspondences but don't connect them up with a pretty class name.")
(* ;; "NIL for the class-name means just establish the font-correspondences but don't connect them up with a pretty class name.")

))
))
(AND BASICCLASSES (FONTMAPARRAY BASICCLASSES 'DISPLAY]
[for X in FONTVARS when (NEQ (CAR X)
'*)
'*)
do (COND
((LISTP (CAR X))
(EVAL (CAR X)))
[(CADDR X)
(SET (CAR X)
(FONTCREATE (OR (GETTOPVAL (CAR X))
(EVAL (CADR X))
DEFAULTFONT)
NIL NIL NIL 'DISPLAY]
(T (OR (GETTOPVAL (CAR X))
(AND (CADR X)
(SET (CAR X)
(EVAL (CADR X]
((LISTP (CAR X))
(EVAL (CAR X)))
[(CADDR X)
(SET (CAR X)
(FONTCREATE (OR (GETTOPVAL (CAR X))
(EVAL (CADR X))
DEFAULTFONT)
NIL NIL NIL 'DISPLAY]
(T (OR (GETTOPVAL (CAR X))
(AND (CADR X)
(SET (CAR X)
(EVAL (CADR X]
(CL:WHEN CHANGE-WINDOWS?
(CL:WHEN (NEQ OLDDEFAULT (FONTCREATE DEFAULTFONT NIL NIL NIL 'DISPLAY))
(for X in (OPENWINDOWS) when (EQ OLDDEFAULT (DSPFONT NIL X))
Expand All @@ -543,25 +535,25 @@
(SETQ MaxValueLeftMargin (ITIMES 35 (STRINGWIDTH 'A DEFAULTFONT)))
(MAPC CACHEDMENUS 'SET)
[for W in (OPENWINDOWS) do [COND
[(OR (EQ (WINDOWPROP W 'RESHAPEFN)
'DONT)
(WINDOWPROP W 'MAINWINDOW]
(T
(* ;;
 "don't reshape if can't or if this window is attached to another.")

(SHAPEW W (WINDOWREGION W]
(COND
((AND (NEQ (WINDOWPROP W 'WINDOWENTRYFN)
(FUNCTION \TEDIT.PROCIDLEFN))
(WINDOWPROP W 'REPAINTFN))
(REDISPLAYW W])
[(OR (EQ (WINDOWPROP W 'RESHAPEFN)
'DONT)
(WINDOWPROP W 'MAINWINDOW]
(T
(* ;;
 "don't reshape if can't or if this window is attached to another.")

(SHAPEW W (WINDOWREGION W]
(COND
((AND (NEQ (WINDOWPROP W 'WINDOWENTRYFN)
(FUNCTION \TEDIT.PROCIDLEFN))
(WINDOWPROP W 'REPAINTFN))
(REDISPLAYW W])

(* ;; "Set the new font profile name, and return the old one, so he can restore later.")

(PROG1 FONTNAME (SETQ FONTNAME NAME]
(T (* ;
 "He passed in NIL, so return font profile name in effect.")
 "He passed in NIL, so return font profile name in effect.")
FONTNAME])

(FONTPROFILE
Expand Down Expand Up @@ -700,6 +692,6 @@
(SETSEPR '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26)
1 FILERDTBL)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (21780 33364 (FONTSET 21790 . 28131) (FONTPROFILE 28133 . 30482) (FONTPROFILE.ADDDEVICE
30484 . 33362)) (33600 35499 (FONTMAPARRAY 33610 . 35497)))))
(FILEMAP (NIL (21437 32615 (FONTSET 21447 . 27382) (FONTPROFILE 27384 . 29733) (FONTPROFILE.ADDDEVICE
29735 . 32613)) (32851 34750 (FONTMAPARRAY 32861 . 34748)))))
STOP
Binary file modified sources/FONTPROFILE.LCOM
View file
Open in desktop
Binary file not shown.