Merge branch 'master' into nhb-fix-ethereventfn
This commit is contained in:
Nick Briggs
GitHub
@@ -1,23 +1,25 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "16-May-2025 15:37:36" {DSK}<home>frank>il>qmedley>internal>MEDLEY-UTILS.;8 31221
|
||||
(FILECREATED "24-Jan-2026 16:01:54" {DSK}<Users>larry>il>medley>internal>MEDLEY-UTILS.;3 26389
|
||||
|
||||
:CHANGES-TO (FNS MAKE-INDEX-HTMLS)
|
||||
:EDIT-BY "lmm"
|
||||
|
||||
:PREVIOUS-DATE "16-May-2025 13:51:08" {DSK}<home>frank>il>qmedley>internal>MEDLEY-UTILS.;7)
|
||||
:CHANGES-TO (VARS MEDLEY-UTILSCOMS)
|
||||
(FNS MAKE-INDEX-HTMLS)
|
||||
|
||||
:PREVIOUS-DATE "16-May-2025 15:37:36" {DSK}<Users>larry>il>MEDLEY>INTERNAL>MEDLEY-UTILS.;1)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MEDLEY-UTILSCOMS)
|
||||
|
||||
(RPAQQ MEDLEY-UTILSCOMS
|
||||
[(FNS GATHER-INFO MAKE-FULLER-DB MAKE-INDEX-HTMLS MEDLEY-FIX-LINKS MEDLEY-FIX-DATES)
|
||||
[(FNS GATHER-INFO MAKE-FULLER-DB MEDLEY-FIX-LINKS MEDLEY-FIX-DATES)
|
||||
(VARS MEDLEY-FIX-DIRS OKSOURCES OKLIBRARY OKLISPUSERS OKINTERNAL)
|
||||
(FNS MAKE-EXPORTS-ALL MAKE-WHEREIS-HASH MAKE-WHEREIS-LOOPS)
|
||||
(FNS HCFILES MAKE-INDEX-HTMLS)
|
||||
(PROP FILETYPE MEDLEY-UTILS)
|
||||
(ADVISE TEDIT.PROMPTPRINT)
|
||||
(FNS RECOMPILE-ONE RECMPL COMPILE-SETUP REMAKEFILES)
|
||||
(P (READVISE TEDIT.PROMPTPRINT))
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
|
||||
(NLAML)
|
||||
(LAMA])
|
||||
@@ -125,91 +127,6 @@
|
||||
(MAKESYS (OR SYSOUTFILE "fuller.sysout")
|
||||
"Welcome to Fuller sysout"])
|
||||
|
||||
(MAKE-INDEX-HTMLS
|
||||
[LAMBDA (BASE TOP LEVEL ROOT.NAME) (* ; "Edited 29-Apr-2024 14:18 by lmm")
|
||||
(* ; "Edited 26-Apr-2024 16:15 by lmm")
|
||||
(* ; "Edited 20-Apr-2024 12:34 by lmm")
|
||||
(* ; "Edited 13-Apr-2024 21:18 by lmm")
|
||||
(* ; " Edited 16-May-2025 13:17 by fgh")
|
||||
[OR BASE (SETQ BASE (TRUEFILENAME (MEDLEYDIR]
|
||||
(OR (DIRECTORYNAMEP BASE)
|
||||
(ERROR BASE "not a directory name"))
|
||||
(OR (AND (NUMBERP LEVEL)
|
||||
(IGREATERP LEVEL 0))
|
||||
(SETQ LEVEL 1))
|
||||
(OR ROOT.NAME (SETQ ROOT.NAME 'MEDLEY))
|
||||
(RESETLST
|
||||
(if (EQ LEVEL 1)
|
||||
then (RESETSAVE (PSEUDOHOSTS T))
|
||||
(PSEUDOHOST ROOT.NAME BASE))
|
||||
(SETQ BASE (PSEUDOFILENAME BASE))
|
||||
[LET*
|
||||
((SUBDIRS NIL)
|
||||
(DEST (PACKFILENAME 'NAME "index" 'EXTENSION "html" 'VERSION NIL 'BODY BASE))
|
||||
(PSEUDOHOST (EQ (NTHCHAR BASE (CL:1- 0))
|
||||
'}))
|
||||
SLASHED SHORTNAME)
|
||||
(CL:WITH-OPEN-FILE
|
||||
(S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE)
|
||||
(CL:FORMAT S "<HTML>~%%<HEAD>~%%")
|
||||
(CL:FORMAT S "<TITLE>Index page for ~a</TITLE>~%%" (SETQ SLASHED (SLASHIT BASE)))
|
||||
(CL:FORMAT S "<SCRIPT>~%%")
|
||||
(CL:FORMAT S " function up_onclick(){~%%")
|
||||
(CL:FORMAT S " var newLoc = location.href.replace(/\/index.html$/i, %"%");~%%")
|
||||
(CL:FORMAT S " location = newLoc.replace(/\/[^\/]+\/?$/, %"%");~%%")
|
||||
(CL:FORMAT S " }~%%")
|
||||
(CL:FORMAT S "</SCRIPT>~%%")
|
||||
(CL:FORMAT S "</HEAD>~%%")
|
||||
(CL:FORMAT S "<BODY><H1>Index page for ~a</H1>~%%" SLASHED)
|
||||
(CL:UNLESS (EQ LEVEL 1)
|
||||
(CL:FORMAT S
|
||||
"<DIV>~%%<BUTTON TYPE=%"BUTTON%" ONCLICK=%"up_onclick()%">Go up one level</BUTTON>~%%</DIV>~%%"
|
||||
))
|
||||
(CL:FORMAT S "<P>This is an index of the files just to link them in.~%%<UL>~%%")
|
||||
(for FULLNAME in (DIRECTORY (CONCAT BASE "*.*;"))
|
||||
do (if (EQ (NTHCHAR FULLNAME -1)
|
||||
'>)
|
||||
then
|
||||
(* ;; "A directory")
|
||||
|
||||
(if (NOT (DIRECTORYNAMEP FULLNAME))
|
||||
then (HELP (CONCAT "NOT DIRNAME " FULLNAME)))
|
||||
(SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME
|
||||
(+ (NCHARS BASE)
|
||||
(if PSEUDOHOST
|
||||
then 2
|
||||
else 1))
|
||||
-2)))
|
||||
(CL:UNLESS (OR (MEMB SHORTNAME '(.git))
|
||||
(MEMB SHORTNAME '(.GIT))
|
||||
[AND (STRPOS ".git" (L-CASE FULLNAME))
|
||||
(NOT (STRPOS ".github" (L-CASE FULLNAME]
|
||||
(INFILEP (CONCAT FULLNAME ".skip")))
|
||||
|
||||
(* ;; ".skip in the directory itself -- don't index any of it")
|
||||
|
||||
(SETQ SUBDIRS (NCONC1 SUBDIRS FULLNAME))
|
||||
(CL:FORMAT S "<LI><A HREF=%"~a/%">~a/</A></LI>~%%" SHORTNAME SHORTNAME))
|
||||
elseif (MEMB [SETQ SHORTNAME (MKATOM (SUBSTRING FULLNAME (ADD1 (NCHARS BASE))
|
||||
(SUB1 (OR (STRPOS ".;" FULLNAME)
|
||||
(STRPOS ";" FULLNAME)
|
||||
(HELP (CONCAT
|
||||
"No ; in non-directory "
|
||||
FULLNAME]
|
||||
'(index.html .skip))
|
||||
then
|
||||
(* ;; "dont index the index")
|
||||
|
||||
elseif (MEMB (FILENAMEFIELD SHORTNAME 'EXTENSION)
|
||||
'(IMPTR SKIP skip imptr))
|
||||
then
|
||||
(* ;; " don't enuerate ANY.SKIP ANY.IMPTR etc")
|
||||
|
||||
else (CL:FORMAT S "<LI><A HREF=%"~a%">~a</A></LI>~%%" SHORTNAME SHORTNAME)))
|
||||
(CL:FORMAT S "</UL></BODY></HTML>~%%"))
|
||||
(NCONC SUBDIRS (for D in SUBDIRS join (MAKE-INDEX-HTMLS D (OR TOP BASE)
|
||||
(ADD1 LEVEL])])
|
||||
|
||||
(MEDLEY-FIX-LINKS
|
||||
[LAMBDA (UNIXPATH) (* ; "Edited 18-Jan-2021 12:01 by larry")
|
||||
(OR UNIXPATH (SETQ UNIXPATH (UNIX-GETENV "MEDLEYDIR"))
|
||||
@@ -361,7 +278,8 @@
|
||||
(PRINTOUT T "DONE" T))])
|
||||
|
||||
(MAKE-INDEX-HTMLS
|
||||
[LAMBDA (BASE TOP LEVEL ROOT.NAME) (* ; "Edited 29-Apr-2024 14:18 by lmm")
|
||||
[LAMBDA (BASE TOP LEVEL ROOT.NAME) (* ; "Edited 23-Jan-2026 11:59 by lmm")
|
||||
(* ; "Edited 29-Apr-2024 14:18 by lmm")
|
||||
(* ; "Edited 26-Apr-2024 16:15 by lmm")
|
||||
(* ; "Edited 20-Apr-2024 12:34 by lmm")
|
||||
(* ; "Edited 13-Apr-2024 21:18 by lmm")
|
||||
@@ -385,7 +303,8 @@
|
||||
'}))
|
||||
SLASHED SHORTNAME)
|
||||
(CL:WITH-OPEN-FILE
|
||||
(S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE)
|
||||
(S DEST :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION :IF-DOES-NOT-EXIST :CREATE
|
||||
:EXTERNAL-FORMAT :UTF-8)
|
||||
(CL:FORMAT S "<HTML>~%%<HEAD>~%%")
|
||||
(CL:FORMAT S "<TITLE>Index page for ~a</TITLE>~%%" (SETQ SLASHED (SLASHIT BASE)))
|
||||
(CL:FORMAT S "<SCRIPT>~%%")
|
||||
@@ -539,8 +458,6 @@
|
||||
(SETQ DIFF (COMPARESOURCES X DESTFILE NIL))
|
||||
(TERPRI])
|
||||
)
|
||||
|
||||
(READVISE TEDIT.PROMPTPRINT)
|
||||
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
|
||||
|
||||
(ADDTOVAR NLAMA )
|
||||
@@ -550,9 +467,9 @@
|
||||
(ADDTOVAR LAMA )
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1086 12975 (GATHER-INFO 1096 . 6478) (MAKE-FULLER-DB 6480 . 7389) (MAKE-INDEX-HTMLS
|
||||
7391 . 12344) (MEDLEY-FIX-LINKS 12346 . 12739) (MEDLEY-FIX-DATES 12741 . 12973)) (14154 16942 (
|
||||
MAKE-EXPORTS-ALL 14164 . 15223) (MAKE-WHEREIS-HASH 15225 . 16414) (MAKE-WHEREIS-LOOPS 16416 . 16940))
|
||||
(16943 26173 (HCFILES 16953 . 21216) (MAKE-INDEX-HTMLS 21218 . 26171)) (26423 31035 (RECOMPILE-ONE
|
||||
26433 . 28330) (RECMPL 28332 . 28935) (COMPILE-SETUP 28937 . 29561) (REMAKEFILES 29563 . 31033)))))
|
||||
(FILEMAP (NIL (1092 8026 (GATHER-INFO 1102 . 6484) (MAKE-FULLER-DB 6486 . 7395) (MEDLEY-FIX-LINKS 7397
|
||||
. 7790) (MEDLEY-FIX-DATES 7792 . 8024)) (9205 11993 (MAKE-EXPORTS-ALL 9215 . 10274) (
|
||||
MAKE-WHEREIS-HASH 10276 . 11465) (MAKE-WHEREIS-LOOPS 11467 . 11991)) (11994 21371 (HCFILES 12004 .
|
||||
16267) (MAKE-INDEX-HTMLS 16269 . 21369)) (21621 26233 (RECOMPILE-ONE 21631 . 23528) (RECMPL 23530 .
|
||||
24133) (COMPILE-SETUP 24135 . 24759) (REMAKEFILES 24761 . 26231)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,21 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "26-Oct-2021 10:53:57" {DSK}<home>larry>medley>library>MAIKOCOLOR.;2 60141
|
||||
(FILECREATED "30-Dec-2025 14:53:37" {WMEDLEY}<library>MAIKOCOLOR.;3 58803
|
||||
|
||||
changes to%: (VARS MAIKOCOLORCOMS)
|
||||
(MACROS \MAIKO.CGTHREEP \MAIKO.CGFOURP \MAIKO.CGSIXP \MAIKO.CGTWOP)
|
||||
(FNS \MAIKO.COLORINIT \MAIKO.STARTCOLOR \MAIKO.STOPCOLOR \MAIKOCOLOR.EVENTFN
|
||||
\MAIKO.SENDCOLORMAPENTRY \MAIKO.CHANGESCREEN CURSOREXIT CURSORSCREEN
|
||||
WARPCURSOR \SLOWBLTCHAR \SOFTCURSORUP \BITBLT.DISPLAY \PUNT.SLOWBLTCHAR
|
||||
\PUNT.BLTSHADE.BITMAP \PUNT.BITBLT.BITMAP BITMAPOBJ.SNAPW \MAIKO.PUNTBLTCHAR
|
||||
\MAIKO.BLTCHAR)
|
||||
:EDIT-BY rmk
|
||||
|
||||
previous date%: "23-Oct-91 14:43:35" {DSK}<home>larry>medley>library>MAIKOCOLOR.;1)
|
||||
:CHANGES-TO (VARS MAIKOCOLORCOMS)
|
||||
|
||||
:PREVIOUS-DATE "26-Oct-2021 10:53:57" {WMEDLEY}<library>MAIKOCOLOR.;2)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1988-1991 by Fuji Xerox Co., Ltd..
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT MAIKOCOLORCOMS)
|
||||
|
||||
@@ -29,7 +21,7 @@ Copyright (c) 1988-1991 by Fuji Xerox Co., Ltd..
|
||||
\MAIKO.SENDCOLORMAPENTRY \MAIKO.CHANGESCREEN)
|
||||
(FNS CURSOREXIT CURSORSCREEN WARPCURSOR \SLOWBLTCHAR \SOFTCURSORUP \BITBLT.DISPLAY)
|
||||
(* ;
|
||||
"these FNS defs. will be moved to original files,later")
|
||||
"these FNS defs. will be moved to original files,later")
|
||||
(FNS \PUNT.SLOWBLTCHAR \MAIKO.PUNTBLTCHAR \MAIKO.BLTCHAR)
|
||||
(FNS \PUNT.BLTSHADE.BITMAP \PUNT.BITBLT.BITMAP)
|
||||
(FNS BITMAPOBJ.SNAPW)
|
||||
@@ -47,7 +39,7 @@ Copyright (c) 1988-1991 by Fuji Xerox Co., Ltd..
|
||||
(GLOBALVARS MAIKOCOLOR.BITSPERPIXEL)
|
||||
(FILES COLOR BIGBITMAPS)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MOVD 'CURSOREXIT 'SAVE.CURSOREXIT)
|
||||
(MOVD '\MAIKO.BLTCHAR '\BILTCHAR)
|
||||
(MOVD '\MAIKO.BLTCHAR '\BLTCHAR)
|
||||
(\MAIKO.COLORINIT)
|
||||
(COLORDISPLAY 'ON 'MAIKOCOLOR)
|
||||
(CURSORSCREEN (COLORSCREEN)
|
||||
@@ -909,28 +901,20 @@ Copyright (c) 1988-1991 by Fuji Xerox Co., Ltd..
|
||||
[PROGN (DEFMACRO \MAIKO.CGTHREEP ()
|
||||
(EQ (LOGAND 120 (fetch DEVCONFIG of \InterfacePage))
|
||||
48))
|
||||
(PUTPROPS \MAIKO.CGTHREEP MACRO (NIL (EQ (LOGAND 120 (fetch DEVCONFIG of
|
||||
|
||||
\InterfacePage
|
||||
))
|
||||
48)))]
|
||||
(PUTPROPS \MAIKO.CGTHREEP MACRO (NIL (EQ (LOGAND 120 (fetch DEVCONFIG of \InterfacePage))
|
||||
48)))]
|
||||
|
||||
(PUTPROPS \MAIKO.CGFOURP MACRO (NIL (EQ (LOGAND 120 (fetch DEVCONFIG of
|
||||
\InterfacePage
|
||||
))
|
||||
64)))
|
||||
(PUTPROPS \MAIKO.CGFOURP MACRO (NIL (EQ (LOGAND 120 (fetch DEVCONFIG of \InterfacePage))
|
||||
64)))
|
||||
|
||||
[PROGN (DEFMACRO \MAIKO.CGSIXP ()
|
||||
(EQ (LOGAND 120 (fetch DEVCONFIG of \InterfacePage))
|
||||
96))
|
||||
(PUTPROPS \MAIKO.CGSIXP MACRO (NIL (EQ (LOGAND 120 (fetch DEVCONFIG of
|
||||
\InterfacePage
|
||||
))
|
||||
96)))]
|
||||
(PUTPROPS \MAIKO.CGSIXP MACRO (NIL (EQ (LOGAND 120 (fetch DEVCONFIG of \InterfacePage))
|
||||
96)))]
|
||||
|
||||
(PUTPROPS \MAIKO.CGTWOP MACRO (NIL (EQ (LOGAND 120 (fetch DEVCONFIG of \InterfacePage
|
||||
))
|
||||
24)))
|
||||
(PUTPROPS \MAIKO.CGTWOP MACRO (NIL (EQ (LOGAND 120 (fetch DEVCONFIG of \InterfacePage))
|
||||
24)))
|
||||
)
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
@@ -974,7 +958,7 @@ Copyright (c) 1988-1991 by Fuji Xerox Co., Ltd..
|
||||
|
||||
(MOVD 'CURSOREXIT 'SAVE.CURSOREXIT)
|
||||
|
||||
(MOVD '\MAIKO.BLTCHAR '\BILTCHAR)
|
||||
(MOVD '\MAIKO.BLTCHAR '\BLTCHAR)
|
||||
|
||||
(\MAIKO.COLORINIT)
|
||||
|
||||
@@ -989,13 +973,12 @@ Copyright (c) 1988-1991 by Fuji Xerox Co., Ltd..
|
||||
|
||||
(LOGOW)
|
||||
)
|
||||
(PUTPROPS MAIKOCOLOR COPYRIGHT ("Fuji Xerox Co., Ltd." 1988 1989 1990 1991))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3229 7254 (\MAIKO.COLORINIT 3239 . 4475) (\MAIKO.STARTCOLOR 4477 . 5293) (
|
||||
\MAIKO.STOPCOLOR 5295 . 5749) (\MAIKOCOLOR.EVENTFN 5751 . 6382) (\MAIKO.SENDCOLORMAPENTRY 6384 . 6842)
|
||||
(\MAIKO.CHANGESCREEN 6844 . 7252)) (7255 28244 (CURSOREXIT 7265 . 8769) (CURSORSCREEN 8771 . 10877) (
|
||||
WARPCURSOR 10879 . 11194) (\SLOWBLTCHAR 11196 . 11608) (\SOFTCURSORUP 11610 . 17471) (\BITBLT.DISPLAY
|
||||
17473 . 28242)) (28315 40283 (\PUNT.SLOWBLTCHAR 28325 . 35163) (\MAIKO.PUNTBLTCHAR 35165 . 39855) (
|
||||
\MAIKO.BLTCHAR 39857 . 40281)) (40284 56617 (\PUNT.BLTSHADE.BITMAP 40294 . 47386) (\PUNT.BITBLT.BITMAP
|
||||
47388 . 56615)) (56618 57426 (BITMAPOBJ.SNAPW 56628 . 57424)))))
|
||||
(FILEMAP (NIL (2639 6664 (\MAIKO.COLORINIT 2649 . 3885) (\MAIKO.STARTCOLOR 3887 . 4703) (
|
||||
\MAIKO.STOPCOLOR 4705 . 5159) (\MAIKOCOLOR.EVENTFN 5161 . 5792) (\MAIKO.SENDCOLORMAPENTRY 5794 . 6252)
|
||||
(\MAIKO.CHANGESCREEN 6254 . 6662)) (6665 27654 (CURSOREXIT 6675 . 8179) (CURSORSCREEN 8181 . 10287) (
|
||||
WARPCURSOR 10289 . 10604) (\SLOWBLTCHAR 10606 . 11018) (\SOFTCURSORUP 11020 . 16881) (\BITBLT.DISPLAY
|
||||
16883 . 27652)) (27725 39693 (\PUNT.SLOWBLTCHAR 27735 . 34573) (\MAIKO.PUNTBLTCHAR 34575 . 39265) (
|
||||
\MAIKO.BLTCHAR 39267 . 39691)) (39694 56027 (\PUNT.BLTSHADE.BITMAP 39704 . 46796) (\PUNT.BITBLT.BITMAP
|
||||
46798 . 56025)) (56028 56836 (BITMAPOBJ.SNAPW 56038 . 56834)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,14 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "25-Sep-2025 18:41:59" {WMEDLEY}<library>MULTI-ALIST.;30 15648
|
||||
(FILECREATED "21-Dec-2025 20:40:36" {WMEDLEY}<library>MULTI-ALIST.;32 15606
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS EXTENDMULTI-PAIR FETCHMULTI-PAIR)
|
||||
(MACROS FETCHMULTI)
|
||||
:CHANGES-TO (PROPS (SGETMULTI ARGNAMES))
|
||||
(MACROS SGETMULTI GETMULTI)
|
||||
|
||||
:PREVIOUS-DATE "25-Sep-2025 11:35:45"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>MULTI-ALIST.;28)
|
||||
:PREVIOUS-DATE "25-Sep-2025 18:41:59" {WMEDLEY}<library>MULTI-ALIST.;30)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MULTI-ALISTCOMS)
|
||||
@@ -62,7 +61,7 @@
|
||||
(CDR ARGS))))
|
||||
|
||||
(PUTPROPS SGETMULTI MACRO ((MULTIALIST . KEYS)
|
||||
(CDR (GETMULTI-PAIR MULTIALIST . KEYS))))
|
||||
(CDR (SGETMULTI-PAIR MULTIALIST . KEYS))))
|
||||
|
||||
(PUTPROPS SGETMULTI-PAIR MACRO (ARGS (GETMULTI-PAIR.EXPAND 'SASSOC (CAR ARGS)
|
||||
(CDR ARGS))))
|
||||
@@ -282,7 +281,7 @@
|
||||
(LOCALVARS . T)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3720 10430 (MAPMULTI 3730 . 4876) (MAPMULTI1 4878 . 5935) (COLLECTMULTI 5937 . 6408) (
|
||||
FETCHMULTI-PAIR 6410 . 7470) (EXTENDMULTI-PAIR 7472 . 10428)) (10431 14805 (GETMULTI-PAIR.EXPAND 10441
|
||||
. 11942) (PUTMULTI.EXPAND 11944 . 14803)))))
|
||||
(FILEMAP (NIL (3678 10388 (MAPMULTI 3688 . 4834) (MAPMULTI1 4836 . 5893) (COLLECTMULTI 5895 . 6366) (
|
||||
FETCHMULTI-PAIR 6368 . 7428) (EXTENDMULTI-PAIR 7430 . 10386)) (10389 14763 (GETMULTI-PAIR.EXPAND 10399
|
||||
. 11900) (PUTMULTI.EXPAND 11902 . 14761)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
BIN
library/sketch/docs/00 Preface.pdf
Normal file
BIN
library/sketch/docs/00 Preface.pdf
Normal file
Binary file not shown.
BIN
library/sketch/docs/00 Sketch TOC.pdf
Normal file
BIN
library/sketch/docs/00 Sketch TOC.pdf
Normal file
Binary file not shown.
BIN
library/sketch/docs/01 Introduction.pdf
Normal file
BIN
library/sketch/docs/01 Introduction.pdf
Normal file
Binary file not shown.
BIN
library/sketch/docs/02 Getting Started.pdf
Normal file
BIN
library/sketch/docs/02 Getting Started.pdf
Normal file
Binary file not shown.
BIN
library/sketch/docs/03 Sketch Command Menu.pdf
Normal file
BIN
library/sketch/docs/03 Sketch Command Menu.pdf
Normal file
Binary file not shown.
BIN
library/sketch/docs/04 Manipulating the Sketch.pdf
Normal file
BIN
library/sketch/docs/04 Manipulating the Sketch.pdf
Normal file
Binary file not shown.
BIN
library/sketch/docs/05 Using Sketch with Tedit.pdf
Normal file
BIN
library/sketch/docs/05 Using Sketch with Tedit.pdf
Normal file
Binary file not shown.
BIN
library/sketch/docs/06 Using Bitmaps with Sketch.pdf
Normal file
BIN
library/sketch/docs/06 Using Bitmaps with Sketch.pdf
Normal file
Binary file not shown.
BIN
library/sketch/docs/07 Programmer_s Interface.pdf
Normal file
BIN
library/sketch/docs/07 Programmer_s Interface.pdf
Normal file
Binary file not shown.
BIN
library/sketch/docs/08 Glossary.pdf
Normal file
BIN
library/sketch/docs/08 Glossary.pdf
Normal file
Binary file not shown.
BIN
library/sketch/docs/09 Index.pdf
Normal file
BIN
library/sketch/docs/09 Index.pdf
Normal file
Binary file not shown.
@@ -1,223 +1,276 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 5-Sep-2025 18:50:19"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;29 17935
|
||||
(FILECREATED "13-Jan-2026 17:51:55" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;55 18063
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (VARS TEDIT-ABBREVCOMS)
|
||||
:CHANGES-TO (FNS \TEDIT.ABBREV.EXPAND)
|
||||
(VARS TEDIT-ABBREVCOMS)
|
||||
|
||||
:PREVIOUS-DATE " 5-Sep-2025 12:24:55"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;28)
|
||||
:PREVIOUS-DATE " 8-Jan-2026 09:09:58" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;53)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-ABBREVCOMS)
|
||||
|
||||
(RPAQQ TEDIT-ABBREVCOMS
|
||||
[(FNS \TEDIT.ABBREV.EXPAND \TEDIT.ABBREV.PARSE \TEDIT.EXPAND.DATE \TEDIT.TRY.ABBREV)
|
||||
(GLOBALVARS TEDIT.ABBREVS)
|
||||
(INITVARS (TEDIT.ABBREVS '(("b" "357,146" Bullet)
|
||||
("n" "357,44" Endash)
|
||||
("--" "357,44" Endash)
|
||||
("m" EMDASH)
|
||||
("---" EMDASH)
|
||||
("T" THINSPACE)
|
||||
("d" "357,60" Dagger)
|
||||
("D" "357,61" DoubleDagger)
|
||||
("s" "0,247" Section)
|
||||
("'" "0,271" RSQ)
|
||||
("`" "0,251" LSQ)
|
||||
("%"" LEFT-DOUBLEQUOTE)
|
||||
("~" RIGHT-DOUBLEQUOTE)
|
||||
("1/4" "0,274")
|
||||
("1/2" "0,275")
|
||||
("3/4" "0,276")
|
||||
("1/3" "357,375")
|
||||
("2/3" "357,376")
|
||||
("c" "0,323" Copyright)
|
||||
("c/o" "357,100" c/o)
|
||||
("%%" "357,100" c/o)
|
||||
("->" "0,256" Rightarrow)
|
||||
("ra" "0,256" Rightarrow)
|
||||
("|" "0,257" Downarrow)
|
||||
("da" "0,257" Downarrow)
|
||||
("L" "0,243" English-pound)
|
||||
("o" "0,260" Degree)
|
||||
("Y" "0,245" Yen)
|
||||
("+" "0,261" PlusMinus)
|
||||
("x" "0,264" Times)
|
||||
("/" "0,270" Divide)
|
||||
("=" "357,121")
|
||||
("p" "0,266" Paragraph)
|
||||
("r" "0,322" Register)
|
||||
("t" "0,324" Trademark)
|
||||
("tm" "0,324" Trademark)
|
||||
("bbox" "42,43" Blackbox)
|
||||
("wbox" "43,42" Whitebox)
|
||||
("-" SOFT-HYPHEN)
|
||||
("=" NONBREAKING-HYPHEN)
|
||||
(" " NONBREAKING-SPACE)
|
||||
("un" "357,127")
|
||||
("int" "357,126")
|
||||
("subset" "357,131")
|
||||
("superset" "357,130")
|
||||
("&" "357,266")
|
||||
("or" "357,267")
|
||||
("not" "357,152")
|
||||
("all" "357,265")
|
||||
("exist" "357,264")
|
||||
("def" "357,162")
|
||||
("compose" "357,147")
|
||||
("DATE" \TEDIT.EXPAND.DATE)
|
||||
(">>DATE<<" \TEDIT.EXPAND.DATE])
|
||||
[(FNS \TEDIT.ABBREV.EXPAND \TEDIT.ABBREV.EXPANSION \TEDIT.ABBREV.TREE \TEDIT.ABBREV.PARSE
|
||||
\TEDIT.ABBREV.PARSE.CHARCODE)
|
||||
(FNS \TEDIT.EXPAND.DATE)
|
||||
(GLOBALVARS TEDIT.ABBREVS \TEDIT.ABBREVS.TREE \TEDIT.ABBREVS.INTREE)
|
||||
(INITVARS (\TEDIT.ABBREVS.TREE NIL)
|
||||
(\TEDIT.ABBREVS.INTREE NIL)
|
||||
(TEDIT.ABBREVS '(("b" "357,146" Bullet)
|
||||
("n" "357,44" Endash)
|
||||
("--" "357,44" Endash)
|
||||
("m" EMDASH)
|
||||
("---" EMDASH)
|
||||
("T" THINSPACE)
|
||||
("d" "357,60" Dagger)
|
||||
("D" "357,61" DoubleDagger)
|
||||
("s" "0,247" Section)
|
||||
("'" "0,271" RSQ)
|
||||
("`" "0,251" LSQ)
|
||||
("%"" LEFT-DOUBLEQUOTE)
|
||||
("~" RIGHT-DOUBLEQUOTE)
|
||||
("1/4" "0,274")
|
||||
("1/2" "0,275")
|
||||
("3/4" "0,276")
|
||||
("1/3" "357,375")
|
||||
("2/3" "357,376")
|
||||
("c" "0,323" Copyright)
|
||||
("c/o" "357,100" c/o)
|
||||
("%%" "357,100" c/o)
|
||||
("->" "0,256" Rightarrow)
|
||||
("ra" "0,256" Rightarrow)
|
||||
("|" "0,257" Downarrow)
|
||||
("da" "0,257" Downarrow)
|
||||
("L" "0,243" English-pound)
|
||||
("o" "0,260" Degree)
|
||||
("Y" "0,245" Yen)
|
||||
("+-" "0,261" PlusMinus)
|
||||
("x" "0,264" Times)
|
||||
("/" "0,270" Divide)
|
||||
("lra" "357,121")
|
||||
("p" "0,266" Paragraph)
|
||||
("r" "0,322" Register)
|
||||
("t" "0,324" Trademark)
|
||||
("tm" "0,324" Trademark)
|
||||
("bbox" "42,43" Blackbox)
|
||||
("wbox" "43,42" Whitebox)
|
||||
("-" SOFT-HYPHEN)
|
||||
("=" NONBREAKING-HYPHEN)
|
||||
("nbsp" NONBREAKING-SPACE)
|
||||
(" " NONBREAKING-SPACE "original, but deprecated")
|
||||
("un" "357,127")
|
||||
("int" "357,126")
|
||||
("subset" "357,131")
|
||||
("superset" "357,130")
|
||||
("&" "357,266")
|
||||
("or" "357,267")
|
||||
("not" "357,152")
|
||||
("all" "357,265")
|
||||
("exist" "357,264")
|
||||
("def" "357,162")
|
||||
(in "357,112" Member)
|
||||
("compose" "357,147")
|
||||
("!" "0,241")
|
||||
(* ; " Inverted !")
|
||||
("?" "0,277")
|
||||
(* ; " Inverted ?")
|
||||
("u" "0,265" MicroSign)
|
||||
("<<" "0,253")
|
||||
(* ; " Left double guillemet")
|
||||
(">>" "0,273")
|
||||
(* ; " Right double guillemet")
|
||||
("DATE" \TEDIT.EXPAND.DATE)
|
||||
(">>DATE<<" \TEDIT.EXPAND.DATE])
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.ABBREV.EXPAND
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 20-Apr-2025 23:30 by rmk")
|
||||
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 13-Jan-2026 17:51 by rmk")
|
||||
(* ; "Edited 8-Jan-2026 09:08 by rmk")
|
||||
(* ; "Edited 3-Jan-2026 13:13 by rmk")
|
||||
(* ; "Edited 20-Apr-2025 23:30 by rmk")
|
||||
(* ; "Edited 20-Mar-2025 21:52 by rmk")
|
||||
(* ; "Edited 30-May-91 19:27 by jds")
|
||||
(* ; "Expand an abbvreviation")
|
||||
(LET ((CANDIDATES (\TEDIT.ABBREV.PARSE TSTREAM SEL))
|
||||
CAND EXPANSION)
|
||||
(\TEDIT.ABBREV.TREE)
|
||||
|
||||
(* ;; "Candidates are ordered longest first, so D doesn't override EMDASH.")
|
||||
(* ;; "If a point selection (DCH <= 1), let the tree control the match, otherwise stop at the beginning of the selection. If the character before the caret is \, then the match string consists of all characters between that \ and the first preceding one.")
|
||||
|
||||
(* ;; "Try literal match first, then fiddle the case.")
|
||||
(LET* ((LASTCHNO (GETSEL SEL CHLAST))
|
||||
(POINTSELECTION (ILEQ (FGETSEL SEL DCH)
|
||||
1))
|
||||
(FIRSTCHNO (CL:IF POINTSELECTION
|
||||
1
|
||||
(FGETSEL SEL CH#)))
|
||||
BACKSLASH ABBREV EXPANSION LEN)
|
||||
(CL:WHEN (MEMB (TEDIT.NTHCHARCODE TSTREAM LASTCHNO)
|
||||
(CHARCODE (EOL FORM Meta,EOL)))
|
||||
|
||||
(* ;; "If we don't find it in abbrevs, try for a character code.")
|
||||
(* ;; "Line or paragraph selection: back up over the terminator. Maybe we should back up over spaces too--except for the no-breaking space abbreviation?")
|
||||
|
||||
[SETQ CAND (OR (find C in CANDIDATES suchthat (SETQ EXPANSION (\TEDIT.TRY.ABBREV
|
||||
(CAR C)
|
||||
TSTREAM)))
|
||||
(for C in CANDIDATES suchthat (SETQ EXPANSION (\TEDIT.TRY.ABBREV
|
||||
(U-CASE (CAR C))
|
||||
TSTREAM)))
|
||||
(for C in CANDIDATES suchthat (SETQ EXPANSION (\TEDIT.TRY.ABBREV
|
||||
(L-CASE (CAR C))
|
||||
TSTREAM]
|
||||
(if EXPANSION
|
||||
then (\TEDIT.UPDATE.SEL SEL (CADR CAND)
|
||||
(CADDR CAND)
|
||||
'RIGHT
|
||||
'NORMAL) (* ; "Set the target")
|
||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.FROM.STRING EXPANSION TEXTOBJ NIL
|
||||
(PCHARLOOKS (\TEDIT.CHTOPC (CADR CAND)
|
||||
TEXTOBJ)))
|
||||
TSTREAM SEL)
|
||||
else (TEDIT.PROMPTPRINT TSTREAM "No abbreviation to expand" T])
|
||||
(add LASTCHNO -1))
|
||||
(CL:WHEN (EQ (CHARCODE \)
|
||||
(TEDIT.NTHCHARCODE TSTREAM LASTCHNO)) (* ;
|
||||
"But if selection ends with \, go back to previous \ to match/consume \xxx\ ")
|
||||
(SETQ BACKSLASH T) (* ;
|
||||
"Started with backslash, extend match")
|
||||
(SETQ POINTSELECTION NIL)
|
||||
(for I CH from (SUB1 LASTCHNO) by -1 as J from 1 to 25
|
||||
do (SETQ CH (TEDIT.NTHCHARCODE TSTREAM I)) (* ; "Don't cross over an image obj")
|
||||
(if (IMAGEOBJP CH)
|
||||
then (RETURN)
|
||||
elseif (EQ CH (CHARCODE \))
|
||||
then (SETQ FIRSTCHNO I)
|
||||
(RETURN)))
|
||||
(add LASTCHNO -1))
|
||||
(if (AND FIRSTCHNO [SETQ ABBREV (OR (\TEDIT.ABBREV.PARSE TSTREAM FIRSTCHNO LASTCHNO
|
||||
POINTSELECTION)
|
||||
(\TEDIT.ABBREV.PARSE TSTREAM FIRSTCHNO LASTCHNO
|
||||
POINTSELECTION T)
|
||||
(CL:UNLESS POINTSELECTION (\TEDIT.ABBREV.PARSE.CHARCODE
|
||||
TSTREAM FIRSTCHNO LASTCHNO]
|
||||
(SETQ EXPANSION (\TEDIT.ABBREV.EXPANSION ABBREV TSTREAM)))
|
||||
then (SETQ LEN (NCHARS (CAR ABBREV)))
|
||||
(SETQ FIRSTCHNO (ADD1 (IDIFFERENCE LASTCHNO LEN)))
|
||||
(CL:WHEN BACKSLASH (* ;
|
||||
"LASTCHNO and LEN include the final backslash")
|
||||
(add LASTCHNO 1)
|
||||
(add LEN 1))
|
||||
(\TEDIT.UPDATE.SEL SEL FIRSTCHNO LEN 'RIGHT 'NORMAL)
|
||||
(* ; "Set the target")
|
||||
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.FROM.STRING EXPANSION TEXTOBJ NIL
|
||||
(PCHARLOOKS (\TEDIT.CHTOPC FIRSTCHNO TEXTOBJ)))
|
||||
TSTREAM SEL)
|
||||
(TEDIT.PROMPTPRINT TSTREAM (CONCAT "Replaced " (CL:IF BACKSLASH
|
||||
(CONCAT (CAR ABBREV)
|
||||
"\")
|
||||
(CAR ABBREV))
|
||||
" with " EXPANSION)
|
||||
T)
|
||||
else (TEDIT.PROMPTPRINT TSTREAM "No abbreviation to expand" T])
|
||||
|
||||
(\TEDIT.ABBREV.PARSE
|
||||
[LAMBDA (TSTREAM SEL) (* ; "Edited 11-Aug-2025 14:40 by rmk")
|
||||
(* ; "Edited 7-Aug-2025 12:50 by rmk")
|
||||
(* ; "Edited 24-Apr-2025 23:45 by rmk")
|
||||
(* ; "Edited 28-Mar-2025 10:11 by rmk")
|
||||
(* ; "Edited 23-Mar-2025 17:08 by rmk")
|
||||
(* ; "Edited 20-Mar-2025 22:21 by rmk")
|
||||
(\TEDIT.ABBREV.EXPANSION
|
||||
[LAMBDA (ABBREV TSTREAM) (* ; "Edited 2-Jan-2026 22:46 by rmk")
|
||||
(* ; "Edited 6-Sep-2025 00:09 by rmk")
|
||||
(* ; "Edited 20-Mar-2025 21:52 by rmk")
|
||||
(* ; "Edited 6-Aug-2020 14:41 by rmk:")
|
||||
(* jds "11-Jul-85 12:46")
|
||||
|
||||
(* ;; "This produces candidate abbreviation-strings by parsing the characters around the point. Each candidate is returned as a list (KEY STARTCH# LEN).")
|
||||
(* ;; "Decode the expansion:")
|
||||
|
||||
(* ;; " A string may be a character name, otherwise itself. ")
|
||||
|
||||
(* ;;
|
||||
"It first backs up over any spaces to find the anchor position. The candidates then include")
|
||||
" A litatom may be a character name,otherwise it is a function (if it has a GETD) to be applied.")
|
||||
|
||||
(* ;; " The immediately preceding singleton character, if a point selection")
|
||||
(* ;; " Anything else is evaled. ")
|
||||
|
||||
(* ;; " The remaining (after backing up) characters of the selection.")
|
||||
(LET ((KEY (CAR ABBREV))
|
||||
(EXPANSION (CADR ABBREV))
|
||||
CH)
|
||||
(CL:WHEN (LISTP EXPANSION) (* ;
|
||||
"Originally stored in the CDR. Now can be followed by comments")
|
||||
(SETQ EXPANSION (CAR EXPANSION)))
|
||||
(if (NULL EXPANSION)
|
||||
then
|
||||
(* ;; "So basically you can use any character name to insert its character")
|
||||
|
||||
(* ;; " The word that contains the caret (backwards and forwards)")
|
||||
(CL:WHEN (SETQ CH (CHARCODE.DECODE KEY T))
|
||||
(CHARACTER CH))
|
||||
elseif (AND (OR (STRINGP EXPANSION)
|
||||
(LITATOM EXPANSION))
|
||||
(SETQ CH (CHARCODE.DECODE EXPANSION T)))
|
||||
then
|
||||
(* ;; "Could be a character code")
|
||||
|
||||
(* ;; " If the character before a candidate C is a comma, then the word before W before the comma (without or without \) is extracted, and W,C is is added to the list (a possible charname).")
|
||||
(CHARACTER CH)
|
||||
elseif (STRINGP EXPANSION)
|
||||
then
|
||||
(* ;; " Could be a character code")
|
||||
|
||||
(* ;; "If the character before a candidate C is \, the \ is included in the replacement span, and \C is also added to the list (Tex style)")
|
||||
(CL:IF (SETQ CH (CHARCODE.DECODE EXPANSION T))
|
||||
(CHARACTER CH)
|
||||
EXPANSION)
|
||||
elseif (SMALLP EXPANSION)
|
||||
then
|
||||
(* ;; "Treat a number as a character code.")
|
||||
|
||||
(* ;; "If one of the candidates is a character name, the abbreviation exapnds to the corresponding character.")
|
||||
(CHARACTER EXPANSION)
|
||||
elseif (AND (LITATOM EXPANSION)
|
||||
(OR (SETQ CH (CHARCODE.DECODE EXPANSION T))
|
||||
(GETD EXPANSION)))
|
||||
then (* ;
|
||||
" Either a character name or a function")
|
||||
(CL:IF CH
|
||||
(CHARACTER CH)
|
||||
(APPLY* EXPANSION TSTREAM KEY))
|
||||
elseif (LISTP EXPANSION)
|
||||
then (* ; "Form in the CADR, now")
|
||||
(EVAL EXPANSION)
|
||||
elseif (AND (SETQ EXPANSION (CDR (SASSOC KEY TEDIT.ABBREVS)))
|
||||
(LITATOM (CAR EXPANSION))
|
||||
(GETD (CAR EXPANSION)))
|
||||
then
|
||||
(* ;; "Form in the CDR, originally. Have to refetch EXPANSION")
|
||||
|
||||
(* ;; "Otherwise, the candidates are looked up in TEDIT.ABBREVS to find their expansions.")
|
||||
(EVAL EXPANSION])
|
||||
|
||||
(PROG ((PT# (SUB1 (TEDIT.GETPOINT TSTREAM SEL)))
|
||||
FIRST# LAST# LEN CANDIDATES KEY NSPACES)
|
||||
(\TEDIT.ABBREV.TREE
|
||||
[LAMBDA (ALWAYS) (* ; "Edited 6-Jan-2026 22:02 by rmk")
|
||||
(* ; "Edited 4-Jan-2026 09:01 by rmk")
|
||||
(CL:UNLESS (AND (NOT ALWAYS)
|
||||
(EQUAL TEDIT.ABBREVS \TEDIT.ABBREVS.INTREE))
|
||||
(SETQ \TEDIT.ABBREVS.TREE NIL)
|
||||
(for A in TEDIT.ABBREVS unless (EQ (CAR A)
|
||||
'*)
|
||||
do (STOREMULTI \TEDIT.ABBREVS.TREE [DREVERSE (LIST* 'ABBREV (UNPACK (CAR A]
|
||||
A)
|
||||
(CL:UNLESS (EQ '\ (NTHCHAR (CAR A)
|
||||
1)) (* ;
|
||||
"Backslash at the beginning, if not already there, like Tex: \cup")
|
||||
(SETQ A (CONS (PACK* "\" (CAR A))
|
||||
(CDR A)))
|
||||
(STOREMULTI \TEDIT.ABBREVS.TREE [DREVERSE (LIST* 'ABBREV (UNPACK (CAR A]
|
||||
A)))
|
||||
(SETQ \TEDIT.ABBREVS.INTREE TEDIT.ABBREVS)
|
||||
\TEDIT.ABBREVS.TREE)])
|
||||
|
||||
(* ;; "The abbreviation is taken from the CH# of the current selection. It is either the character just before a point selection, the entire selection, or the word containing the selection.")
|
||||
(\TEDIT.ABBREV.PARSE
|
||||
[LAMBDA (TSTREAM FIRSTCHNO LASTCHNO POINTSELECTION CASEINSENSITIVE)
|
||||
(* ; "Edited 7-Jan-2026 09:55 by rmk")
|
||||
(* ; "Edited 3-Jan-2026 22:50 by rmk")
|
||||
|
||||
(* ;; " The character at CH#, if it is a point selection")
|
||||
(* ;; "But if LA")
|
||||
|
||||
(* ;; " Otherwise either the current selection up to and including CH# or the full word that includes the selection. What works is determined by what it finds in the abbreviations list.")
|
||||
(for CHNO CH MATCH (DCH _ (ADD1 (IDIFFERENCE LASTCHNO FIRSTCHNO)))
|
||||
(TREE _ \TEDIT.ABBREVS.TREE) by -1 from LASTCHNO to FIRSTCHNO
|
||||
while [PROGN (SETQ CH (TEDIT.NTHCHAR TSTREAM CHNO))
|
||||
(SETQ TREE (CL:IF CASEINSENSITIVE
|
||||
(CL:ASSOC CH TREE :TEST (FUNCTION STRING.EQUAL))
|
||||
(ASSOC CH TREE))] when (SETQ MATCH (CDR (ASSOC 'ABBREV TREE)))
|
||||
do (SETQ $$VAL MATCH) finally
|
||||
|
||||
(* ;; "Back up over spaces")
|
||||
(* ;;
|
||||
"Return NIL for a multi-char selection if the longest match doesn't cover the whole thing")
|
||||
|
||||
(SETQ NSPACES (for I from PT# by -1 while (EQ (CHARCODE SPACE)
|
||||
(\TEDIT.NTHCHARCODE TSTREAM I)) sum 1))
|
||||
(add PT# (IMINUS NSPACES))
|
||||
(CL:WHEN (ZEROP PT#) (* ; "Beginning of document")
|
||||
(RETURN))
|
||||
(CL:UNLESS [OR POINTSELECTION (EQ DCH (NCHARS (CAR MATCH]
|
||||
(RETURN NIL])
|
||||
|
||||
(* ;; "Each candidate is a triple containing the key and the starting character and length of the replacement target..")
|
||||
|
||||
(push CANDIDATES (LIST (MKSTRING (TEDIT.NTHCHAR TSTREAM PT#))
|
||||
PT# 1))
|
||||
(SETQ LEN (IMAX 0 (IDIFFERENCE (FGETSEL SEL DCH)
|
||||
NSPACES))) (* ; "Last singleton predecessor")
|
||||
(CL:WHEN (IGEQ LEN 2) (* ; "At least one more character")
|
||||
(push CANDIDATES (LIST (TEDIT.SEL.AS.STRING TSTREAM (FGETSEL SEL CH#)
|
||||
LEN)
|
||||
(FGETSEL SEL CH#)
|
||||
LEN)))
|
||||
(SETQ FIRST# (\TEDIT.WORD.FIRST TSTREAM PT#))
|
||||
(SETQ LEN (ADD1 (IDIFFERENCE PT# FIRST#)))
|
||||
(CL:UNLESS (EQ LEN 1) (* ; "Already there")
|
||||
(push CANDIDATES (LIST (TEDIT.SEL.AS.STRING TSTREAM FIRST# LEN)
|
||||
FIRST# LEN)))
|
||||
(SETQ LAST# (\TEDIT.WORD.LAST TSTREAM FIRST#))
|
||||
(SETQ LEN (ADD1 (IDIFFERENCE LAST# FIRST#)))
|
||||
(CL:UNLESS (EQ LEN 1) (* ; "Already there")
|
||||
(push CANDIDATES (LIST (TEDIT.SEL.AS.STRING TSTREAM FIRST# LEN)
|
||||
FIRST# LEN))) (* ; "Extend if a ,")
|
||||
[for C KEY END in CANDIDATES
|
||||
do
|
||||
(* ;; "Comma for MCCS character names, - and / - for internal punctuation (3/4 EMDASH). Adjacent character must be text")
|
||||
|
||||
(if [AND (MEMB (\TEDIT.NTHCHARCODE TSTREAM (SUB1 (CADR C)))
|
||||
(CHARCODE (%, / -)))
|
||||
(EQ (\TEDIT.TTC TEXT)
|
||||
(TEDIT.WORDGET (\TEDIT.NTHCHARCODE TSTREAM (IDIFFERENCE (CADR C)
|
||||
2]
|
||||
then (SETQ END (\TEDIT.WORD.FIRST TSTREAM (IDIFFERENCE (CADR C)
|
||||
2)))
|
||||
(* ; "Comma before, maybe a charname")
|
||||
(SETQ KEY (CONCAT (TEDIT.SEL.AS.STRING TSTREAM END (IDIFFERENCE (CADR C)
|
||||
END))
|
||||
(CAR C)))
|
||||
(push CANDIDATES (LIST KEY END (NCHARS KEY)))
|
||||
elseif [AND (MEMB (\TEDIT.NTHCHARCODE TSTREAM (IPLUS (CADR C)
|
||||
(CADDR C)))
|
||||
(CHARCODE (%, / -)))
|
||||
(EQ (\TEDIT.TTC TEXT)
|
||||
(TEDIT.WORDGET (\TEDIT.NTHCHARCODE TSTREAM (IPLUS 1 (CADR C)
|
||||
(CADDR C]
|
||||
then [SETQ END (\TEDIT.WORD.LAST TSTREAM (ADD1 (IPLUS (CADR C)
|
||||
(CADDR C]
|
||||
(* ; "Comma after")
|
||||
[SETQ KEY (CONCAT (CAR C)
|
||||
(TEDIT.SEL.AS.STRING TSTREAM (IPLUS (CADR C)
|
||||
(CADDR C))
|
||||
(ADD1 (IDIFFERENCE END (IPLUS (CADR C)
|
||||
(CADDR C]
|
||||
(push CANDIDATES (LIST KEY (CADR C)
|
||||
(NCHARS KEY] (* ;
|
||||
"If preceded by \, include it optionally in the key, always include it in the replacement")
|
||||
(for C in CANDIDATES when [EQ (CHARCODE \)
|
||||
(\TEDIT.NTHCHARCODE TSTREAM (SUB1 (CADR C]
|
||||
do (* ; "Match and replace \KEY")
|
||||
[push CANDIDATES (LIST (CONCAT "\" (CAR C))
|
||||
(SUB1 (CADR C))
|
||||
(ADD1 (CADDR C]
|
||||
(change (CADR C)
|
||||
(SUB1 DATUM)) (* ; "Match KEY but also replace the \")
|
||||
(change (CADDR C)
|
||||
(ADD1 DATUM)))
|
||||
[SORT CANDIDATES (FUNCTION (LAMBDA (C1 C2)
|
||||
(IGEQ (CADDR C1)
|
||||
(CADDR C2] (* ; "Look for longest first")
|
||||
(RETURN CANDIDATES])
|
||||
(\TEDIT.ABBREV.PARSE.CHARCODE
|
||||
[LAMBDA (TSTREAM FIRSTCHNO LASTCHNO) (* ; "Edited 7-Jan-2026 21:53 by rmk")
|
||||
(LET ((STRING (TEDIT.SEL.AS.STRING TSTREAM FIRSTCHNO (ADD1 (IDIFFERENCE LASTCHNO FIRSTCHNO))
|
||||
0))
|
||||
CHARCODE)
|
||||
(CL:WHEN (SETQ CHARCODE (CHARCODE.DECODE (CL:IF (EQ (CHARCODE \)
|
||||
(CHCON1 STRING))
|
||||
(SUBSTRING STRING 2)
|
||||
STRING)
|
||||
T))
|
||||
(LIST STRING (CHARACTER CHARCODE)))])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.EXPAND.DATE
|
||||
[LAMBDA (STREAM CH) (* ; "Edited 23-Feb-88 10:41 by jds")
|
||||
@@ -232,54 +285,16 @@
|
||||
"August" "September" "October" "November" "December")
|
||||
(ADD1 MONTH)))
|
||||
" " DAY ", " YEAR])
|
||||
|
||||
(\TEDIT.TRY.ABBREV
|
||||
[LAMBDA (KEY TSTREAM) (* ; "Edited 5-Sep-2025 12:24 by rmk")
|
||||
(* ; "Edited 20-Mar-2025 21:52 by rmk")
|
||||
(* ; "Edited 6-Aug-2020 14:41 by rmk:")
|
||||
(* jds "11-Jul-85 12:46")
|
||||
|
||||
(* ;; "Decode the expansion. A string may be a character name, otherwise itself. A litatom is a function to be applied, anything else is evaled. ")
|
||||
|
||||
(LET [(ABBREV (CDR (SASSOC KEY TEDIT.ABBREVS]
|
||||
(CL:WHEN (LISTP ABBREV) (* ; "Originally stored in the CDR")
|
||||
(SETQ ABBREV (CAR ABBREV)))
|
||||
(if (NULL ABBREV)
|
||||
then (CL:WHEN (CHARCODE.DECODE KEY T)
|
||||
(CHARACTER (CHARCODE.DECODE KEY T)))
|
||||
elseif (STRINGP ABBREV)
|
||||
then
|
||||
(* ;; "Could be a character code")
|
||||
|
||||
(LET ((CH (CHARCODE.DECODE ABBREV T)))
|
||||
(CL:IF CH
|
||||
(CHARACTER CH)
|
||||
ABBREV))
|
||||
elseif (SMALLP ABBREV)
|
||||
then
|
||||
(* ;; "Treat a number as a character code.")
|
||||
|
||||
(CHARACTER ABBREV)
|
||||
elseif (AND (LITATOM ABBREV)
|
||||
(GETD ABBREV))
|
||||
then (* ; " A function to be applied.")
|
||||
(APPLY* ABBREV TSTREAM KEY)
|
||||
elseif (LISTP ABBREV)
|
||||
then (* ; "Form in the CADR, now")
|
||||
(EVAL ABBREV)
|
||||
elseif (AND (SETQ ABBREV (CDR (SASSOC KEY TEDIT.ABBREVS)))
|
||||
(LITATOM (CAR ABBREV))
|
||||
(GETD (CAR ABBREV)))
|
||||
then
|
||||
(* ;; "Form in the CDR, originally")
|
||||
|
||||
(EVAL ABBREV])
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS TEDIT.ABBREVS)
|
||||
(GLOBALVARS TEDIT.ABBREVS \TEDIT.ABBREVS.TREE \TEDIT.ABBREVS.INTREE)
|
||||
)
|
||||
|
||||
(RPAQ? \TEDIT.ABBREVS.TREE NIL)
|
||||
|
||||
(RPAQ? \TEDIT.ABBREVS.INTREE NIL)
|
||||
|
||||
(RPAQ? TEDIT.ABBREVS
|
||||
'(("b" "357,146" Bullet)
|
||||
("n" "357,44" Endash)
|
||||
@@ -309,10 +324,10 @@
|
||||
("L" "0,243" English-pound)
|
||||
("o" "0,260" Degree)
|
||||
("Y" "0,245" Yen)
|
||||
("+" "0,261" PlusMinus)
|
||||
("+-" "0,261" PlusMinus)
|
||||
("x" "0,264" Times)
|
||||
("/" "0,270" Divide)
|
||||
("=" "357,121")
|
||||
("lra" "357,121")
|
||||
("p" "0,266" Paragraph)
|
||||
("r" "0,322" Register)
|
||||
("t" "0,324" Trademark)
|
||||
@@ -321,7 +336,8 @@
|
||||
("wbox" "43,42" Whitebox)
|
||||
("-" SOFT-HYPHEN)
|
||||
("=" NONBREAKING-HYPHEN)
|
||||
(" " NONBREAKING-SPACE)
|
||||
("nbsp" NONBREAKING-SPACE)
|
||||
(" " NONBREAKING-SPACE "original, but deprecated")
|
||||
("un" "357,127")
|
||||
("int" "357,126")
|
||||
("subset" "357,131")
|
||||
@@ -332,10 +348,21 @@
|
||||
("all" "357,265")
|
||||
("exist" "357,264")
|
||||
("def" "357,162")
|
||||
(in "357,112" Member)
|
||||
("compose" "357,147")
|
||||
("!" "0,241")
|
||||
(* ; " Inverted !")
|
||||
("?" "0,277")
|
||||
(* ; " Inverted ?")
|
||||
("u" "0,265" MicroSign)
|
||||
("<<" "0,253")
|
||||
(* ; " Left double guillemet")
|
||||
(">>" "0,273")
|
||||
(* ; " Right double guillemet")
|
||||
("DATE" \TEDIT.EXPAND.DATE)
|
||||
(">>DATE<<" \TEDIT.EXPAND.DATE)))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3630 16182 (\TEDIT.ABBREV.EXPAND 3640 . 5860) (\TEDIT.ABBREV.PARSE 5862 . 13472) (
|
||||
\TEDIT.EXPAND.DATE 13474 . 14107) (\TEDIT.TRY.ABBREV 14109 . 16180)))))
|
||||
(FILEMAP (NIL (4390 14959 (\TEDIT.ABBREV.EXPAND 4400 . 8930) (\TEDIT.ABBREV.EXPANSION 8932 . 11996) (
|
||||
\TEDIT.ABBREV.TREE 11998 . 13129) (\TEDIT.ABBREV.PARSE 13131 . 14283) (\TEDIT.ABBREV.PARSE.CHARCODE
|
||||
14285 . 14957)) (14960 15605 (\TEDIT.EXPAND.DATE 14970 . 15603)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "19-Oct-2025 00:07:29" {WMEDLEY}<library>TEDIT>TEDIT-SCREEN.;910 186445
|
||||
(FILECREATED "31-Dec-2025 23:10:18" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;915 186658
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS \TEDIT.FORMATLINE.HORIZONTAL)
|
||||
:CHANGES-TO (VARS TEDIT-SCREENCOMS)
|
||||
|
||||
:PREVIOUS-DATE " 7-Aug-2025 12:51:00" {WMEDLEY}<library>TEDIT>TEDIT-SCREEN.;909)
|
||||
:PREVIOUS-DATE " 7-Dec-2025 16:28:01" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;914)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT TEDIT-SCREENCOMS)
|
||||
@@ -22,7 +22,6 @@
|
||||
LINEDESCRIPTOR!))
|
||||
(MACROS HCSCALE HCUNSCALE SCALEUP SCALEDOWN)
|
||||
(GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS)
|
||||
(ALISTS (CHARACTERNAMES SOFT-HYPHEN NONBREAKING-HYPHEN NONBREAKING-SPACE))
|
||||
(MACROS DIACRITICP)
|
||||
(MACROS \TEDIT.LINE.TALLP)
|
||||
(COMS (* ; "Formatting slots held by THISLINE")
|
||||
@@ -36,6 +35,7 @@
|
||||
(* ;; "incharslots can be used only if THISLINE is properly bound in the environment, to provide upperbound checking. Operand can be THISLINE (= FIRSTCHARSLOT) or a within-range slot pointer. The latter case is not current checked for validity (some \HILOC \LOLOC address calculations?). backcharslots runs backwards.")
|
||||
|
||||
(I.S.OPRS incharslots backcharslots]
|
||||
(ALISTS (CHARACTERNAMES SOFT-HYPHEN NONBREAKING-HYPHEN NONBREAKING-SPACE))
|
||||
(FNS \TEDIT.LINEDESCRIPTOR.DEFPRINT)
|
||||
(INITRECORDS THISLINE LINEDESCRIPTOR LINECACHE)
|
||||
(DECLARE%: EVAL@COMPILE DONTCOPY (* ; "Not exported")
|
||||
@@ -298,10 +298,6 @@
|
||||
|
||||
(GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS)
|
||||
)
|
||||
|
||||
(ADDTOVAR CHARACTERNAMES (SOFT-HYPHEN "357,043")
|
||||
(NONBREAKING-HYPHEN "357,042")
|
||||
(NONBREAKING-SPACE "357,041"))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS DIACRITICP MACRO (OPENLAMBDA (CHAR)
|
||||
@@ -460,6 +456,10 @@
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
|
||||
)
|
||||
|
||||
(ADDTOVAR CHARACTERNAMES (SOFT-HYPHEN "357,043")
|
||||
(NONBREAKING-HYPHEN "357,042")
|
||||
(NONBREAKING-SPACE "357,041"))
|
||||
(DEFINEQ
|
||||
|
||||
(\TEDIT.LINEDESCRIPTOR.DEFPRINT
|
||||
@@ -654,17 +654,16 @@
|
||||
|
||||
(\TEDIT.FORMATLINE
|
||||
[LAMBDA (TSTREAM CH#1 LINE REGION IMAGESTREAM FORMATTINGSTATE)
|
||||
(* ; "Edited 21-Nov-2025 16:36 by rmk")
|
||||
(* ; "Edited 7-Aug-2025 12:49 by rmk")
|
||||
(* ; "Edited 27-Apr-2025 11:24 by rmk")
|
||||
(* ; "Edited 21-Apr-2025 19:03 by rmk")
|
||||
(* ; "Edited 11-Apr-2025 20:18 by rmk")
|
||||
(* ; "Edited 29-Mar-2025 11:39 by rmk")
|
||||
(* ; "Edited 6-Mar-2025 11:42 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:36 by rmk")
|
||||
(* ; "Edited 24-Dec-2024 22:15 by rmk")
|
||||
(* ; "Edited 23-Nov-2024 00:03 by rmk")
|
||||
(* ; "Edited 31-Oct-2024 15:32 by rmk")
|
||||
(* ; "Edited 26-Oct-2024 10:51 by rmk")
|
||||
(* ; "Edited 2-Sep-2024 16:06 by rmk")
|
||||
(* ; "Edited 4-Aug-2024 18:07 by rmk")
|
||||
(* ; "Edited 21-May-2024 14:45 by rmk")
|
||||
@@ -704,9 +703,11 @@
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(CL:UNLESS LINE
|
||||
(SETQ LINE (create LINEDESCRIPTOR)))
|
||||
(CL:UNLESS IMAGESTREAM
|
||||
(SETQ IMAGESTREAM (WINDOWPROP (\TEDIT.PRIMARYPANE TSTREAM)
|
||||
'DSP))) (* ; "For lower image objects?")
|
||||
'DSP)))
|
||||
(PROG ((TEXTOBJ (FTEXTOBJ TSTREAM))
|
||||
(OFFSET 0)
|
||||
(TRUEASCENT -1)
|
||||
@@ -718,17 +719,11 @@
|
||||
(OVERHANG 0)
|
||||
(SPACELEFT 0)
|
||||
(TX 0)
|
||||
(BOXSTREAM IMAGESTREAM)
|
||||
CHARLOOKS THISLINE LINETYPE WIDTH WMARGIN SCALE PARALOOKS RIGHTMARGIN HASKERN PC CHARSLOT
|
||||
PREVSP 1STLN CHNOB FORCED-END CHNO LX1 TX TXB FONT CHARSLOTB TABPENDING PREVHYPH PREVDHYPH
|
||||
START-OF-PIECE UNBREAKABLE OLDPIECE OLDPCCHARSLEFT OLDCARETLOOKS FIRSTSEPR)
|
||||
(DECLARE (SPECVARS TEXTOBJ LINETYPE CHARLOOKS CHNO OFFSET ASCENTC DESCENTC FONT
|
||||
START-OF-PIECE HASKERN UNBREAKABLE))
|
||||
(CL:UNLESS LINE
|
||||
|
||||
(* ;; "Not needed until the end, but then we might not get the starting values for WRIGHT and WBOTTOM, if those change from piece to piece--check this.")
|
||||
|
||||
(SETQ LINE (create LINEDESCRIPTOR)))
|
||||
(SETQ THISLINE (FGETTOBJ TEXTOBJ THISLINE))
|
||||
|
||||
(* ;;
|
||||
@@ -899,9 +894,9 @@
|
||||
(* ;; "If this isn't TRUEHARDCOPY, we want to do the imageobject in the displaystream with displaystream coordinates, because we don't know what internal size computations the imageobject might make based on its displaystream and fonts. But we do have to down-scale WIDTH (right margin) back to the units of the display stream.")
|
||||
|
||||
(SETQ BOX (APPLY* (IMAGEOBJPROP CH 'IMAGEBOXFN)
|
||||
CH BOXSTREAM TX (CL:IF (EQ LINETYPE 'HARDCOPYDISPLAY)
|
||||
(SCALEDOWN SCALE WIDTH)
|
||||
WIDTH)
|
||||
CH IMAGESTREAM TX (CL:IF (EQ LINETYPE 'HARDCOPYDISPLAY)
|
||||
(SCALEDOWN SCALE WIDTH)
|
||||
WIDTH)
|
||||
TSTREAM))
|
||||
(IMAGEOBJPROP CH 'BOUNDBOX BOX)
|
||||
(SETQ TRUEASCENT (IMAX TRUEASCENT (IPLUS (IDIFFERENCE (fetch (IMAGEBOX YSIZE)
|
||||
@@ -1229,7 +1224,8 @@
|
||||
(RETURN LINE])
|
||||
|
||||
(\TEDIT.FORMATLINE.SETUP.PARA
|
||||
[LAMBDA (TEXTOBJ PC LINE IMAGESTREAM LINETYPE) (* ; "Edited 19-Feb-2025 13:37 by rmk")
|
||||
[LAMBDA (TEXTOBJ PC LINE IMAGESTREAM LINETYPE) (* ; "Edited 7-Dec-2025 16:26 by rmk")
|
||||
(* ; "Edited 19-Feb-2025 13:37 by rmk")
|
||||
(* ; "Edited 8-Feb-2025 23:36 by rmk")
|
||||
(* ; "Edited 7-Feb-2025 08:09 by rmk")
|
||||
(* ; "Edited 22-Nov-2024 11:14 by rmk")
|
||||
@@ -1264,9 +1260,8 @@
|
||||
(* ;; "Coerce the image stream and PARALOOKS for HARDCOPYDISPLAY.")
|
||||
|
||||
[SETQ IMAGESTREAM (OR (FGETTOBJ TEXTOBJ DISPLAYHCPYDS)
|
||||
(FSETTOBJ TEXTOBJ DISPLAYHCPYDS (OPENIMAGESTREAM
|
||||
'{NODIRCORE}
|
||||
'POSTSCRIPT]
|
||||
(FSETTOBJ TEXTOBJ DISPLAYHCPYDS (OPENIMAGESTREAM NIL
|
||||
DEFAULTPRINTERTYPE]
|
||||
(SETQ SCALE (DSPSCALE NIL IMAGESTREAM))
|
||||
[SETQ PLOOKS (create PARALOOKS using PLOOKS FMTHARDCOPYSCALE _ SCALE RIGHTMAR _
|
||||
(SCALEUP SCALE (FGETPLOOKS PLOOKS RIGHTMAR))
|
||||
@@ -2295,7 +2290,9 @@
|
||||
1)])
|
||||
|
||||
(\TEDIT.UPDATE.LINES
|
||||
[LAMBDA (TSTREAM REASON FIRSTCHANGEDCHNO NCHARSCHANGED) (* ; "Edited 26-Apr-2025 19:19 by rmk")
|
||||
[LAMBDA (TSTREAM REASON FIRSTCHANGEDCHNO NCHARSCHANGED) (* ; "Edited 26-Oct-2025 17:10 by rmk")
|
||||
(* ; "Edited 24-Oct-2025 12:57 by rmk")
|
||||
(* ; "Edited 26-Apr-2025 19:19 by rmk")
|
||||
(* ; "Edited 21-Apr-2025 20:30 by rmk")
|
||||
(* ; "Edited 9-Apr-2025 12:59 by rmk")
|
||||
(* ; "Edited 6-Apr-2025 14:23 by rmk")
|
||||
@@ -2325,7 +2322,7 @@
|
||||
(LET ((TEXTOBJ (FTEXTOBJ TSTREAM)))
|
||||
(CL:UNLESS (FGETTOBJ TEXTOBJ TXTDON'TUPDATE)
|
||||
(\TEDIT.NOSEL TSTREAM)
|
||||
(for PANE LASTVALID NEXTVALID LASTGAPLINE BITMAPLINES (LASTCHANGEDCHNO
|
||||
[for PANE LASTVALID NEXTVALID LASTGAPLINE BITMAPLINES (LASTCHANGEDCHNO
|
||||
_
|
||||
(SUB1 (IPLUS FIRSTCHANGEDCHNO
|
||||
NCHARSCHANGED)))
|
||||
@@ -2335,38 +2332,41 @@
|
||||
((CHANGED LOOKS)
|
||||
0)
|
||||
(\TEDIT.THELP "BAD REASONS FOR VALID LINES"))) inpanes TEXTOBJ
|
||||
when (SETQ LASTVALID (\TEDIT.LASTVALIDLINE FIRSTCHANGEDCHNO LASTCHANGEDCHNO PANE
|
||||
TSTREAM))
|
||||
do
|
||||
(* ;;
|
||||
"Create/format/position/display new lines between LASTVALID and NEXTVALID exclusive")
|
||||
|
||||
(SETQ NEXTVALID (\TEDIT.NEXTVALIDLINE LASTCHANGEDCHNO PANE TSTREAM))
|
||||
(CL:UNLESS (ZEROP DELTA) (* ;
|
||||
(SETQ LASTVALID (\TEDIT.LASTVALIDLINE FIRSTCHANGEDCHNO LASTCHANGEDCHNO PANE
|
||||
TSTREAM))
|
||||
(if LASTVALID
|
||||
then (SETQ NEXTVALID (\TEDIT.NEXTVALIDLINE LASTCHANGEDCHNO PANE TSTREAM))
|
||||
(CL:UNLESS (ZEROP DELTA) (* ;
|
||||
"Adjust the character numbers of the lower valid lines")
|
||||
(for L inlines NEXTVALID do (add (FGETLD L LCHAR1)
|
||||
DELTA)
|
||||
(add (FGETLD L LCHARLAST)
|
||||
DELTA)))
|
||||
(for L inlines NEXTVALID do (add (FGETLD L LCHAR1)
|
||||
DELTA)
|
||||
(add (FGETLD L LCHARLAST)
|
||||
DELTA)))
|
||||
|
||||
(* ;; "MEASURED.LINES creates, measures, and links the lines from LASTVALID to the last pre-NEXTVALID character, without displaying. They may be in the bitmap.")
|
||||
(* ;; "MEASURED.LINES creates, measures, and links the lines from LASTVALID to the last pre-NEXTVALID character, without displaying. They may be in the bitmap.")
|
||||
|
||||
[SETQ LASTGAPLINE (\TEDIT.MEASURED.LINES LASTVALID PANE TSTREAM
|
||||
(CL:IF NEXTVALID
|
||||
(SUB1 (FGETLD NEXTVALID LCHAR1))
|
||||
(TEXTLEN TEXTOBJ))]
|
||||
[SETQ LASTGAPLINE (\TEDIT.MEASURED.LINES LASTVALID PANE TSTREAM
|
||||
(CL:IF NEXTVALID
|
||||
(SUB1 (FGETLD NEXTVALID LCHAR1))
|
||||
(TEXTLEN TEXTOBJ))]
|
||||
|
||||
(* ;;
|
||||
(* ;;
|
||||
"The chain that ended at LASTVALID now continues thru LASTGAPLINE to NEXVALID and below.")
|
||||
|
||||
(LINKLD LASTGAPLINE NEXTVALID)
|
||||
(if NEXTVALID
|
||||
then (SETQ BITMAPLINES (\TEDIT.BITMAPLINES PANE NEXTVALID))
|
||||
else (\TEDIT.SUFFIXLINE.CREATE PANE TSTREAM LASTGAPLINE))
|
||||
(LINKLD LASTGAPLINE NEXTVALID)
|
||||
(if NEXTVALID
|
||||
then (SETQ BITMAPLINES (\TEDIT.BITMAPLINES PANE NEXTVALID))
|
||||
else (\TEDIT.SUFFIXLINE.CREATE PANE TSTREAM LASTGAPLINE))
|
||||
|
||||
(* ;; "If LASTVALID is not visible (above the pane), make sure that its NEXT is linked to the PANE's prefix")
|
||||
(* ;; "If LASTVALID is not visible (above the pane), make sure that its NEXT is linked to the PANE's prefix")
|
||||
|
||||
(\TEDIT.SHIFTLINES LASTVALID PANE TSTREAM BITMAPLINES)))])
|
||||
(\TEDIT.SHIFTLINES LASTVALID PANE TSTREAM BITMAPLINES)
|
||||
else (* ; "No lines left in this pane")
|
||||
(\TEDIT.SCROLLCH.TOP TSTREAM PANE (SUB1 FIRSTCHANGEDCHNO])])
|
||||
|
||||
(\TEDIT.PANE.CREATELINES
|
||||
[LAMBDA (TSTREAM PANE LCHARLAST YBOT) (* ; "Edited 28-Jul-2025 23:23 by rmk")
|
||||
@@ -2863,21 +2863,21 @@
|
||||
(\TEDIT.LINE.TALLP LINE PHEIGHT))))])
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (26225 28441 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 26235 . 28439)) (35895 119880 (
|
||||
\TEDIT.FORMATLINE 35905 . 71392) (\TEDIT.FORMATLINE.SETUP.PARA 71394 . 76560) (
|
||||
\TEDIT.FORMATLINE.HORIZONTAL 76562 . 81379) (\TEDIT.FORMATLINE.VERTICAL 81381 . 83832) (
|
||||
\TEDIT.FORMATLINE.JUSTIFY 83834 . 89855) (\TEDIT.FORMATLINE.TABS 89857 . 97885) (\TEDIT.SCALE.TABS
|
||||
97887 . 98678) (\TEDIT.FORMATLINE.PURGE.SPACES 98680 . 100107) (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN
|
||||
100109 . 101186) (\TEDIT.FORMATLINE.EMPTY 101188 . 106008) (\TEDIT.FORMATLINE.UPDATELOOKS 106010 .
|
||||
112191) (\TEDIT.FORMATLINE.LASTLEGAL 112193 . 115643) (\TEDIT.LINES.ABOVE 115645 . 119256) (
|
||||
\TEDIT.CHNO.TO.YTOP 119258 . 119878)) (120157 140737 (\TEDIT.DISPLAYLINE 120167 . 132677) (
|
||||
\TEDIT.DISPLAYLINE.TABS 132679 . 135483) (\TEDIT.LINECACHE 135485 . 136213) (\TEDIT.CREATE.LINECACHE
|
||||
136215 . 137051) (\TEDIT.BLTCHAR 137053 . 139680) (\TEDIT.DIACRITIC.SHIFT 139682 . 140735)) (141352
|
||||
186422 (\TEDIT.BACKFORMAT 141362 . 143916) (\TEDIT.PREVIOUS.LINEBREAK 143918 . 146721) (
|
||||
\TEDIT.UPDATE.LINES 146723 . 152438) (\TEDIT.PANE.CREATELINES 152440 . 154730) (
|
||||
\TEDIT.SUFFIXLINE.CREATE 154732 . 156347) (\TEDIT.LINES.BELOW 156349 . 160959) (\TEDIT.MEASURED.LINES
|
||||
160961 . 162970) (\TEDIT.VALID.LASTCHNOS 162972 . 166748) (\TEDIT.VALID.NEXTCHNOS 166750 . 170224) (
|
||||
\TEDIT.LASTVALIDLINE 170226 . 174897) (\TEDIT.NEXTVALIDLINE 174899 . 177869) (
|
||||
\TEDIT.CLEARPANE.BELOW.LINE 177871 . 179977) (\TEDIT.INSERTLINE 179979 . 181365) (\TEDIT.LINE.BOTTOM
|
||||
181367 . 184597) (\TEDIT.SHOW.AT.BOTTOMP 184599 . 185709) (\TEDIT.SHOW.AT.TOPP 185711 . 186420)))))
|
||||
(FILEMAP (NIL (26200 28416 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 26210 . 28414)) (35870 119502 (
|
||||
\TEDIT.FORMATLINE 35880 . 70986) (\TEDIT.FORMATLINE.SETUP.PARA 70988 . 76182) (
|
||||
\TEDIT.FORMATLINE.HORIZONTAL 76184 . 81001) (\TEDIT.FORMATLINE.VERTICAL 81003 . 83454) (
|
||||
\TEDIT.FORMATLINE.JUSTIFY 83456 . 89477) (\TEDIT.FORMATLINE.TABS 89479 . 97507) (\TEDIT.SCALE.TABS
|
||||
97509 . 98300) (\TEDIT.FORMATLINE.PURGE.SPACES 98302 . 99729) (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN
|
||||
99731 . 100808) (\TEDIT.FORMATLINE.EMPTY 100810 . 105630) (\TEDIT.FORMATLINE.UPDATELOOKS 105632 .
|
||||
111813) (\TEDIT.FORMATLINE.LASTLEGAL 111815 . 115265) (\TEDIT.LINES.ABOVE 115267 . 118878) (
|
||||
\TEDIT.CHNO.TO.YTOP 118880 . 119500)) (119779 140359 (\TEDIT.DISPLAYLINE 119789 . 132299) (
|
||||
\TEDIT.DISPLAYLINE.TABS 132301 . 135105) (\TEDIT.LINECACHE 135107 . 135835) (\TEDIT.CREATE.LINECACHE
|
||||
135837 . 136673) (\TEDIT.BLTCHAR 136675 . 139302) (\TEDIT.DIACRITIC.SHIFT 139304 . 140357)) (140974
|
||||
186635 (\TEDIT.BACKFORMAT 140984 . 143538) (\TEDIT.PREVIOUS.LINEBREAK 143540 . 146343) (
|
||||
\TEDIT.UPDATE.LINES 146345 . 152651) (\TEDIT.PANE.CREATELINES 152653 . 154943) (
|
||||
\TEDIT.SUFFIXLINE.CREATE 154945 . 156560) (\TEDIT.LINES.BELOW 156562 . 161172) (\TEDIT.MEASURED.LINES
|
||||
161174 . 163183) (\TEDIT.VALID.LASTCHNOS 163185 . 166961) (\TEDIT.VALID.NEXTCHNOS 166963 . 170437) (
|
||||
\TEDIT.LASTVALIDLINE 170439 . 175110) (\TEDIT.NEXTVALIDLINE 175112 . 178082) (
|
||||
\TEDIT.CLEARPANE.BELOW.LINE 178084 . 180190) (\TEDIT.INSERTLINE 180192 . 181578) (\TEDIT.LINE.BOTTOM
|
||||
181580 . 184810) (\TEDIT.SHOW.AT.BOTTOMP 184812 . 185922) (\TEDIT.SHOW.AT.TOPP 185924 . 186633)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
BIN
library/tedit/docs/00 Preface.pdf
Normal file
BIN
library/tedit/docs/00 Preface.pdf
Normal file
Binary file not shown.
BIN
library/tedit/docs/00 Tedit TOC.pdf
Normal file
BIN
library/tedit/docs/00 Tedit TOC.pdf
Normal file
Binary file not shown.
BIN
library/tedit/docs/01 Introduction.pdf
Normal file
BIN
library/tedit/docs/01 Introduction.pdf
Normal file
Binary file not shown.
BIN
library/tedit/docs/02 Getting Started.pdf
Normal file
BIN
library/tedit/docs/02 Getting Started.pdf
Normal file
Binary file not shown.
BIN
library/tedit/docs/03 Editing Text.pdf
Normal file
BIN
library/tedit/docs/03 Editing Text.pdf
Normal file
Binary file not shown.
BIN
library/tedit/docs/04 Tedit Menu.pdf
Normal file
BIN
library/tedit/docs/04 Tedit Menu.pdf
Normal file
Binary file not shown.
BIN
library/tedit/docs/05 Changing Character Looks.pdf
Normal file
BIN
library/tedit/docs/05 Changing Character Looks.pdf
Normal file
Binary file not shown.
BIN
library/tedit/docs/06 Changing Paragraph Looks.pdf
Normal file
BIN
library/tedit/docs/06 Changing Paragraph Looks.pdf
Normal file
Binary file not shown.
BIN
library/tedit/docs/07 Page Layout Menu.pdf
Normal file
BIN
library/tedit/docs/07 Page Layout Menu.pdf
Normal file
Binary file not shown.
BIN
library/tedit/docs/08 Programmer_s interface.pdf
Normal file
BIN
library/tedit/docs/08 Programmer_s interface.pdf
Normal file
Binary file not shown.
BIN
library/tedit/docs/09 Appendix A-Example.pdf
Normal file
BIN
library/tedit/docs/09 Appendix A-Example.pdf
Normal file
Binary file not shown.
BIN
library/tedit/docs/10 Glossary.pdf
Normal file
BIN
library/tedit/docs/10 Glossary.pdf
Normal file
Binary file not shown.
BIN
library/tedit/docs/11 Index.pdf
Normal file
BIN
library/tedit/docs/11 Index.pdf
Normal file
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 5-Dec-2025 11:09:30" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;6 12333
|
||||
(FILECREATED "26-Dec-2025 16:37:05" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;4 14367
|
||||
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (FNS FontSample FontTable)
|
||||
:CHANGES-TO (FNS FontSample)
|
||||
|
||||
:PREVIOUS-DATE " 4-Dec-2025 23:56:07" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;5
|
||||
:PREVIOUS-DATE " 9-Dec-2025 14:00:20" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;3
|
||||
)
|
||||
|
||||
|
||||
@@ -20,7 +20,9 @@
|
||||
(DEFINEQ
|
||||
|
||||
(FontSample
|
||||
[LAMBDA (Fonts CharacterSets Printer StreamType Hexadecimal)
|
||||
[LAMBDA (Fonts CharacterSets Printer StreamType Hexadecimal ColumnMajor NoSlugOnlyCS)
|
||||
(* ; "Edited 26-Dec-2025 16:25 by mth")
|
||||
(* ; "Edited 9-Dec-2025 13:48 by mth")
|
||||
(* ; "Edited 5-Dec-2025 11:06 by mth")
|
||||
(* ; "Edited 5-Feb-2025 17:02 by mth")
|
||||
(* ; "Edited 29-Apr-87 22:03")
|
||||
@@ -30,12 +32,10 @@
|
||||
[Stream (OPENIMAGESTREAM Printer StreamType (LIST 'FONTS (CONS TitleFont FontList]
|
||||
(InchesToPrinterUnits (FTIMES 72.0 (DSPSCALE NIL Stream)))
|
||||
(LastFont (CAR (LAST FontList)))
|
||||
[CharacterSets (if (LISTP CharacterSets)
|
||||
then CharacterSets
|
||||
elseif (MEMB CharacterSets '(T :INCORE :ALL :INTERESTING))
|
||||
then CharacterSets
|
||||
else (LIST (OR CharacterSets 0]
|
||||
(AllCharacterSets (CONSTANT (for CS from 0 to 255 collect CS]
|
||||
(CL:UNLESS [OR (LISTP CharacterSets)
|
||||
(MEMB CharacterSets '(T :INCORE :ALL :INTERESTING]
|
||||
(SETQ CharacterSets (LIST (OR CharacterSets 0))))
|
||||
(DSPRIGHTMARGIN (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL Stream))
|
||||
Stream)
|
||||
(for Font in FontList do
|
||||
@@ -60,23 +60,37 @@
|
||||
CharacterSets))
|
||||
|
||||
(* ;;
|
||||
"Exclude any CharacterSet known to reference the SlugCharsetInfo")
|
||||
"If requested to do so, exclude any CharacterSet known to reference the SlugCharsetInfo")
|
||||
|
||||
(SETQ FontCharacterSets (for CS in FontCharacterSets
|
||||
unless (EQ SlugCharsetInfo
|
||||
(\GETCHARSETINFO Font
|
||||
CS))
|
||||
collect CS))
|
||||
(CL:WHEN (AND NoSlugOnlyCS SlugCharsetInfo)
|
||||
|
||||
(* ;;
|
||||
"Only if SlugCharsetInfo is non-NIL, else it won't load a requested charset")
|
||||
|
||||
(SETQ FontCharacterSets
|
||||
(for CS in FontCharacterSets
|
||||
unless (EQ SlugCharsetInfo (\GETCHARSETINFO Font CS))
|
||||
collect CS)))
|
||||
|
||||
(* ;;
|
||||
"Probably ought to report charsets eliminated by the above.")
|
||||
|
||||
(* ;; " At least report if NO charsets remain for this font.")
|
||||
|
||||
(CL:UNLESS FontCharacterSets (printout T
|
||||
"All requested character sets are empty for this font: "
|
||||
Font T))
|
||||
(for CharacterSet in FontCharacterSets
|
||||
bind (LastCharacterSet _ (CAR (LAST FontCharacterSets)))
|
||||
do (FontTable Font CharacterSet Stream
|
||||
(OR (NEQ Font LastFont)
|
||||
(NEQ CharacterSet LastCharacterSet))
|
||||
TitleFont InchesToPrinterUnits Hexadecimal)))
|
||||
finally (CLOSEF Stream])
|
||||
TitleFont InchesToPrinterUnits Hexadecimal
|
||||
ColumnMajor))) finally (CLOSEF Stream])
|
||||
|
||||
(FontSampleFaked
|
||||
[LAMBDA (FontAsList Printer StreamType) (* N.H.Briggs "27-Apr-87 18:12")
|
||||
[LAMBDA (FontAsList Printer StreamType ColumnMajor) (* ; "Edited 8-Dec-2025 21:19 by mth")
|
||||
(* ; "Edited 27-Apr-87 18:12 by N.H.Briggs ")
|
||||
(LET* [[TitleFont (FONTCREATE NIL 12 'MRR 0 (OR StreamType (PRINTERTYPE Printer]
|
||||
(Font)
|
||||
[Stream (OPENIMAGESTREAM Printer StreamType (LIST 'FONTS (LIST TitleFont]
|
||||
@@ -86,11 +100,12 @@
|
||||
(replace FONTSIZE of Font with (CADR FontAsList))
|
||||
(replace FONTFACE of Font with (\FONTFACE (CADDR FontAsList)))
|
||||
(FontTable Font '(0)
|
||||
Stream NIL TitleFont InchesToPrinterUnits)
|
||||
Stream NIL TitleFont InchesToPrinterUnits NIL ColumnMajor)
|
||||
(CLOSEF Stream])
|
||||
|
||||
(FontTable
|
||||
[LAMBDA (Font CharacterSet Stream FormFeed TitleFont InchesToPrinterUnits Hexadecimal)
|
||||
[LAMBDA (Font CharacterSet Stream FormFeed TitleFont InchesToPrinterUnits Hexadecimal ColumnMajor)
|
||||
(* ; "Edited 9-Dec-2025 13:23 by mth")
|
||||
(* ; "Edited 5-Dec-2025 11:09 by mth")
|
||||
(* ; "Edited 5-Feb-2025 17:03 by mth")
|
||||
(* ; "Edited 3-Feb-2025 20:07 by mth")
|
||||
@@ -103,14 +118,15 @@
|
||||
" "
|
||||
(L-CASE Face T)
|
||||
" Character set "))
|
||||
(StreamType (IMAGESTREAMTYPE Stream))
|
||||
[UseDisplayFontBitmaps (AND (EQ (FONTPROP Font 'DEVICE)
|
||||
'DISPLAY)
|
||||
(NOT (EQ (IMAGESTREAMTYPE Stream)
|
||||
'DISPLAY]
|
||||
(NOT (EQ StreamType 'DISPLAY]
|
||||
[RelativeDescent (FQUOTIENT (FONTPROP Font 'DESCENT)
|
||||
(FONTPROP Font 'HEIGHT]
|
||||
(XCellSpacing (TIMES 0.45 InchesToPrinterUnits))
|
||||
(YCellSpacing (TIMES 0.5 InchesToPrinterUnits)))
|
||||
(YCellSpacing (TIMES 0.5 InchesToPrinterUnits))
|
||||
ColLabelStep RowLabelStep)
|
||||
(printout T Title .I0.8 CharacterSet "Q" T)
|
||||
(RESETLST
|
||||
(RESETSAVE (RADIX (if Hexadecimal
|
||||
@@ -129,15 +145,31 @@
|
||||
(printout Stream (if Hexadecimal
|
||||
then "16"
|
||||
else "8"))
|
||||
(if ColumnMajor
|
||||
then (SETQ ColLabelStep 16)
|
||||
(SETQ RowLabelStep 1)
|
||||
else (SETQ ColLabelStep 1)
|
||||
(SETQ RowLabelStep 16))
|
||||
(for XPosition from (TIMES 0.75 InchesToPrinterUnits) by XCellSpacing as Counter
|
||||
from 0 to 15 bind (YPosition _ (TIMES 9.5 InchesToPrinterUnits))
|
||||
do (MOVETO XPosition YPosition Stream)
|
||||
(PRIN1 Counter Stream))
|
||||
(for YPosition from (TIMES 9 InchesToPrinterUnits) by (MINUS YCellSpacing) as Counter
|
||||
from 0 to 240 by 16 bind (XPosition _ (TIMES 0.25 InchesToPrinterUnits))
|
||||
from 0 to (ITIMES ColLabelStep 15) by ColLabelStep bind (YPosition _ (TIMES 9.5
|
||||
InchesToPrinterUnits
|
||||
))
|
||||
do (MOVETO XPosition YPosition Stream)
|
||||
(PRINTNUM (if Hexadecimal
|
||||
then '(FIX 2 16 T)
|
||||
elseif ColumnMajor
|
||||
then '(FIX 1 8 NIL T)
|
||||
else '(FIX 2 8))
|
||||
Counter Stream))
|
||||
(for YPosition from (TIMES 9 InchesToPrinterUnits) by (MINUS YCellSpacing) as Counter
|
||||
from 0 to (ITIMES RowLabelStep 15) by RowLabelStep bind (XPosition _ (TIMES 0.25
|
||||
InchesToPrinterUnits
|
||||
))
|
||||
do (MOVETO XPosition YPosition Stream)
|
||||
(PRINTNUM (if Hexadecimal
|
||||
then '(FIX 2 16 T)
|
||||
elseif ColumnMajor
|
||||
then '(FIX 2 8)
|
||||
else '(FIX 3 8))
|
||||
Counter Stream)))
|
||||
(DRAWLINE (TIMES 0.25 InchesToPrinterUnits)
|
||||
@@ -154,33 +186,32 @@
|
||||
'PAINT Stream)
|
||||
(CL:UNLESS UseDisplayFontBitmaps (DSPFONT Font Stream))
|
||||
(for XPosition from (TIMES 0.75 InchesToPrinterUnits) by XCellSpacing as XCounter from 0
|
||||
to 15 bind (CharacterCode _ 0)
|
||||
[RangedCodesStreamType _ (MEMB (IMAGESTREAMTYPE Stream)
|
||||
'(DISPLAY INTERPRESS]
|
||||
to 15 bind [RangedCodesStreamType _ (MEMB StreamType '(DISPLAY INTERPRESS]
|
||||
do
|
||||
(for YPosition from (TIMES 9 InchesToPrinterUnits) by (MINUS YCellSpacing) as YCounter
|
||||
[for YPosition from (TIMES 9 InchesToPrinterUnits) by (MINUS YCellSpacing) as YCounter
|
||||
from 0 to 15
|
||||
do [LET ((CCode (IPLUS (ITIMES CharacterSet 256)
|
||||
CharacterCode)))
|
||||
(MOVETO XPosition YPosition Stream)
|
||||
(if UseDisplayFontBitmaps
|
||||
then (LET* ((Glyph (GETCHARBITMAP CCode Font))
|
||||
(ImSize (BITMAPIMAGESIZE Glyph NIL Stream))
|
||||
(ImWidth (CAR ImSize))
|
||||
(ImHeight (CDR ImSize)))
|
||||
(BITBLT Glyph 0 0 Stream XPosition (FDIFFERENCE YPosition
|
||||
(FTIMES ImHeight
|
||||
RelativeDescent))
|
||||
ImWidth ImHeight 'INPUT 'REPLACE))
|
||||
else (if (AND (NEQ CharacterCode (CHARCODE FF))
|
||||
(if RangedCodesStreamType
|
||||
then (OR (AND (IGREATERP CharacterCode 31)
|
||||
(ILESSP CharacterCode 127))
|
||||
(AND (IGREATERP CharacterCode 160)
|
||||
(ILESSP CharacterCode 255)))
|
||||
else T))
|
||||
then (PRINTCCODE CCode Stream]
|
||||
(SETQ CharacterCode (ADD1 CharacterCode)))
|
||||
do (LET* ((CharacterCode (IPLUS (ITIMES YCounter RowLabelStep)
|
||||
(ITIMES XCounter ColLabelStep)))
|
||||
(CCode (IPLUS (ITIMES CharacterSet 256)
|
||||
CharacterCode)))
|
||||
(MOVETO XPosition YPosition Stream)
|
||||
(if UseDisplayFontBitmaps
|
||||
then (LET* ((Glyph (GETCHARBITMAP CCode Font))
|
||||
(ImSize (BITMAPIMAGESIZE Glyph NIL Stream))
|
||||
(ImWidth (CAR ImSize))
|
||||
(ImHeight (CDR ImSize)))
|
||||
(BITBLT Glyph 0 0 Stream XPosition (FDIFFERENCE YPosition
|
||||
(FTIMES ImHeight
|
||||
RelativeDescent))
|
||||
ImWidth ImHeight 'INPUT 'REPLACE))
|
||||
else (if (AND (NEQ CharacterCode (CHARCODE FF))
|
||||
(if RangedCodesStreamType
|
||||
then (OR (AND (IGREATERP CharacterCode 31)
|
||||
(ILESSP CharacterCode 127))
|
||||
(AND (IGREATERP CharacterCode 160)
|
||||
(ILESSP CharacterCode 255)))
|
||||
else T))
|
||||
then (PRINTCCODE CCode Stream]
|
||||
(printout T "."))
|
||||
(MOVETO (FTIMES 0.75 InchesToPrinterUnits)
|
||||
(FTIMES 0.75 InchesToPrinterUnits)
|
||||
@@ -220,6 +251,6 @@
|
||||
FONT)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (655 12170 (FontSample 665 . 4700) (FontSampleFaked 4702 . 5524) (FontTable 5526 . 12168
|
||||
(FILEMAP (NIL (645 14204 (FontSample 655 . 5488) (FontSampleFaked 5490 . 6448) (FontTable 6450 . 14202
|
||||
)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "21-May-2024 18:45:54" {LU}MANAGER.;4 102968
|
||||
(FILECREATED " 5-Jan-2026 12:41:54" {DSK}<home>matt>Interlisp>medley>lispusers>MANAGER.;5 106149
|
||||
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (FNS Manager.DO.COMMAND)
|
||||
:CHANGES-TO (ADVICE ADDTOFILES? ADDTOCOMS LOAD LOADFNS MAKEFILE MARKASCHANGED UNMARKASCHANGED
|
||||
DELFROMCOMS UPDATEFILES \ADDTOFILEBLOCK/ADDNEWCOM ADDFILE)
|
||||
|
||||
:PREVIOUS-DATE "20-May-2024 11:16:10" {LU}MANAGER.;3)
|
||||
:PREVIOUS-DATE " 5-Jan-2026 12:35:04" {DSK}<home>matt>Interlisp>medley>lispusers>MANAGER.;4)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT MANAGERCOMS)
|
||||
@@ -1545,66 +1546,105 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
|
||||
(RPLACA LST (CDAR LST)))])
|
||||
)
|
||||
|
||||
[XCL:REINSTALL-ADVICE 'ADDFILE :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL))
|
||||
*)
|
||||
(AND Manager.ACTIVEFLG (Manager.CHECKFILE FILE)))
|
||||
]
|
||||
[XCL:REINSTALL-ADVICE 'ADDFILE :AROUND '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
|
||||
(Manager.ACTIVEFLG NIL))
|
||||
(DECLARE (SPECVARS Manager.ACTIVEFLG))
|
||||
(PROG1 *
|
||||
(AND (SETQ Manager.ACTIVEFLG
|
||||
Orig.Manager.ACTIVELFG)
|
||||
(Manager.CHECKFILE FILE)))]
|
||||
|
||||
[XCL:REINSTALL-ADVICE 'ADDTOFILES? :AROUND '((:LAST (PROG1 (LET ((MANAGER-ADDTOFILES? T))
|
||||
*)
|
||||
(AND Manager.ACTIVEFLG (Manager.ADDTOFILES?)))
|
||||
]
|
||||
[XCL:REINSTALL-ADVICE 'ADDTOFILES? :AROUND '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
|
||||
(Manager.ACTIVEFLG NIL))
|
||||
(DECLARE (SPECVARS Manager.ACTIVEFLG))
|
||||
(PROG1 *
|
||||
(AND (SETQ Manager.ACTIVEFLG
|
||||
Orig.Manager.ACTIVELFG)
|
||||
(Manager.ADDTOFILES?)))]
|
||||
|
||||
[XCL:REINSTALL-ADVICE 'MAKEFILE :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL))
|
||||
*)
|
||||
(AND Manager.ACTIVEFLG (Manager.MAKEFILE.ADV
|
||||
FILE OPTIONS)))]
|
||||
[XCL:REINSTALL-ADVICE 'MAKEFILE :AROUND '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
|
||||
(Manager.ACTIVEFLG NIL))
|
||||
(DECLARE (SPECVARS Manager.ACTIVEFLG))
|
||||
(PROG1 *
|
||||
(AND (SETQ Manager.ACTIVEFLG
|
||||
Orig.Manager.ACTIVELFG)
|
||||
(Manager.MAKEFILE.ADV FILE OPTIONS)))
|
||||
]
|
||||
|
||||
[XCL:REINSTALL-ADVICE 'MARKASCHANGED :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL))
|
||||
*)
|
||||
(AND Manager.ACTIVEFLG
|
||||
(Manager.ALTERMARKING NAME TYPE
|
||||
(OR REASON T))))]
|
||||
[XCL:REINSTALL-ADVICE 'MARKASCHANGED :AROUND
|
||||
'((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
|
||||
(Manager.ACTIVEFLG NIL))
|
||||
(DECLARE (SPECVARS Manager.ACTIVEFLG))
|
||||
(PROG1 *
|
||||
(AND (SETQ Manager.ACTIVEFLG Orig.Manager.ACTIVELFG)
|
||||
(Manager.ALTERMARKING NAME TYPE (OR REASON T))))]
|
||||
|
||||
[XCL:REINSTALL-ADVICE 'UNMARKASCHANGED :AROUND
|
||||
'((:LAST (LET (!VALUE)
|
||||
(PROG1 (LET ((Manager.ACTIVEFLG NIL))
|
||||
(SETQ !VALUE *))
|
||||
(AND Manager.ACTIVEFLG !VALUE (Manager.ALTERMARKING NAME TYPE NIL)))]
|
||||
'((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
|
||||
(Manager.ACTIVEFLG NIL)
|
||||
!VALUE)
|
||||
(DECLARE (SPECVARS Manager.ACTIVEFLG))
|
||||
(PROG1 (SETQ !VALUE *)
|
||||
(AND (SETQ Manager.ACTIVEFLG Orig.Manager.ACTIVELFG)
|
||||
!VALUE
|
||||
(Manager.ALTERMARKING NAME TYPE NIL)))]
|
||||
|
||||
[XCL:REINSTALL-ADVICE 'UPDATEFILES :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL))
|
||||
*)
|
||||
(AND Manager.ACTIVEFLG (Manager.MAINUPDATE
|
||||
T)))]
|
||||
[XCL:REINSTALL-ADVICE 'UPDATEFILES :AROUND '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
|
||||
(Manager.ACTIVEFLG NIL))
|
||||
(DECLARE (SPECVARS Manager.ACTIVEFLG))
|
||||
(PROG1 *
|
||||
(AND (SETQ Manager.ACTIVEFLG
|
||||
Orig.Manager.ACTIVELFG)
|
||||
(Manager.MAINUPDATE T)))]
|
||||
|
||||
[XCL:REINSTALL-ADVICE 'ADDTOCOMS :AROUND
|
||||
'((:LAST (LET (!VALUE)
|
||||
(PROG1 (LET ((Manager.ACTIVEFLG NIL))
|
||||
(SETQ !VALUE *))
|
||||
(AND Manager.ACTIVEFLG (Manager.ADDADV !VALUE COMS NAME TYPE)))]
|
||||
'((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
|
||||
(Manager.ACTIVEFLG NIL)
|
||||
!VALUE)
|
||||
(DECLARE (SPECVARS Manager.ACTIVEFLG))
|
||||
(PROG1 (SETQ !VALUE *)
|
||||
(AND (SETQ Manager.ACTIVEFLG Orig.Manager.ACTIVELFG)
|
||||
(Manager.ADDADV !VALUE COMS NAME TYPE)))]
|
||||
|
||||
[XCL:REINSTALL-ADVICE 'DELFROMCOMS :AROUND
|
||||
'((:LAST (LET (!VALUE)
|
||||
(PROG1 (LET ((Manager.ACTIVEFLG NIL))
|
||||
(SETQ !VALUE *))
|
||||
(AND Manager.ACTIVEFLG (Manager.ADDADV !VALUE COMS NAME TYPE)))]
|
||||
'((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
|
||||
(Manager.ACTIVEFLG NIL)
|
||||
!VALUE)
|
||||
(DECLARE (SPECVARS Manager.ACTIVEFLG))
|
||||
(PROG1 (SETQ !VALUE *)
|
||||
(AND (SETQ Manager.ACTIVEFLG Orig.Manager.ACTIVELFG)
|
||||
(Manager.ADDADV !VALUE COMS NAME TYPE)))]
|
||||
|
||||
[XCL:REINSTALL-ADVICE '\ADDTOFILEBLOCK/ADDNEWCOM :AROUND
|
||||
'((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL))
|
||||
*)
|
||||
(AND Manager.ACTIVEFLG (Manager.RESETSUBITEMS FILE TYPE)))]
|
||||
'((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
|
||||
(Manager.ACTIVEFLG NIL))
|
||||
(DECLARE (SPECVARS Manager.ACTIVEFLG))
|
||||
(PROG1 *
|
||||
(AND (SETQ Manager.ACTIVEFLG Orig.Manager.ACTIVELFG)
|
||||
(Manager.RESETSUBITEMS FILE TYPE)))]
|
||||
|
||||
[XCL:REINSTALL-ADVICE 'LOAD :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL))
|
||||
*)
|
||||
(if Manager.ACTIVEFLG
|
||||
then (Manager.REMOVE.DUPLICATE.ADVICE FILE)
|
||||
(Manager.CHECKFILE FILE)))]
|
||||
[XCL:REINSTALL-ADVICE 'LOAD :AROUND '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
|
||||
(Manager.ACTIVEFLG NIL))
|
||||
(DECLARE (SPECVARS Manager.ACTIVEFLG))
|
||||
(PROG1 *
|
||||
(AND (SETQ Manager.ACTIVEFLG
|
||||
Orig.Manager.ACTIVELFG)
|
||||
(if Manager.ACTIVEFLG
|
||||
then (Manager.REMOVE.DUPLICATE.ADVICE
|
||||
FILE)
|
||||
(Manager.CHECKFILE FILE))))]
|
||||
|
||||
[XCL:REINSTALL-ADVICE 'LOADFNS :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL))
|
||||
*)
|
||||
(if Manager.ACTIVEFLG
|
||||
then (Manager.REMOVE.DUPLICATE.ADVICE FILE)
|
||||
(Manager.CHECKFILE FILE)))]
|
||||
[XCL:REINSTALL-ADVICE 'LOADFNS :AROUND '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
|
||||
(Manager.ACTIVEFLG NIL))
|
||||
(DECLARE (SPECVARS Manager.ACTIVEFLG))
|
||||
(PROG1 *
|
||||
(AND (SETQ Manager.ACTIVEFLG
|
||||
Orig.Manager.ACTIVELFG)
|
||||
(if Manager.ACTIVEFLG
|
||||
then (
|
||||
Manager.REMOVE.DUPLICATE.ADVICE
|
||||
FILE)
|
||||
(Manager.CHECKFILE FILE))))]
|
||||
|
||||
[XCL:REINSTALL-ADVICE '(MARKASCHANGED :IN DEFAULT.EDITDEFA0001)
|
||||
:AROUND
|
||||
@@ -1710,20 +1750,20 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
|
||||
)
|
||||
(PUTPROPS MANAGER COPYRIGHT (NONE))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (25632 93132 (MANAGER 25642 . 26441) (MANAGER.RESET 26443 . 27957) (Manager.ADDADV 27959
|
||||
. 29312) (Manager.ADDTOFILES? 29314 . 29592) (Manager.ALTERMARKING 29594 . 31204) (
|
||||
Manager.ANCHORED-SET-POSITION 31206 . 32309) (Manager.DO.COMMAND 32311 . 33918) (
|
||||
Manager.DO.COMMAND.PROCFN 33920 . 53275) (Manager.HIGHLIGHT 53277 . 53574) (Manager.PROMPT 53576 .
|
||||
53889) (Manager.WINDOW 53891 . 54524) (Manager.insurefilehighlights 54526 . 55597) (Manager.CHANGED?
|
||||
55599 . 56148) (Manager.CHECKFILE 56150 . 57249) (Manager.COLLECTCOMS 57251 . 58689) (Manager.COMS.WSF
|
||||
58691 . 61361) (Manager.COMSOPEN 61363 . 66101) (Manager.COMSUPDATE 66103 . 67195) (
|
||||
Manager.HIGHLIGHTED 67197 . 67503) (Manager.INSUREHIGHLIGHTS 67505 . 68063) (Manager.FILECHANGES 68065
|
||||
. 68364) (Manager.FILELSTCHANGED? 68366 . 68694) (Manager.FILESUBTYPES 68696 . 69334) (
|
||||
Manager.GET.ENVIRONMENT 69336 . 71874) (Manager.GETFILE 71876 . 74190) (Manager.INTITLE? 74192 . 74870
|
||||
) (Manager.MAIN.WSF 74872 . 77516) (Manager.MAINCLOSE 77518 . 78628) (Manager.MAINMENUITEMS 78630 .
|
||||
79707) (Manager.MAINOPEN 79709 . 85102) (Manager.MAINUPDATE 85104 . 85740) (Manager.MAKEFILE.ADV 85742
|
||||
. 86778) (Manager.MENUCOLUMNS 86780 . 87584) (Manager.MENUHASITEM 87586 . 87943) (Manager.MENUITEMS
|
||||
87945 . 88190) (Manager.REMOVE.DUPLICATE.ADVICE 88192 . 89798) (Manager.RESETSUBITEMS 89800 . 91037) (
|
||||
Manager.SET-ANCHOR 91039 . 91358) (Manager.SORT.COMS 91360 . 91892) (Manager.SORTBYCOLUMN 91894 .
|
||||
93130)))))
|
||||
(FILEMAP (NIL (25852 93352 (MANAGER 25862 . 26661) (MANAGER.RESET 26663 . 28177) (Manager.ADDADV 28179
|
||||
. 29532) (Manager.ADDTOFILES? 29534 . 29812) (Manager.ALTERMARKING 29814 . 31424) (
|
||||
Manager.ANCHORED-SET-POSITION 31426 . 32529) (Manager.DO.COMMAND 32531 . 34138) (
|
||||
Manager.DO.COMMAND.PROCFN 34140 . 53495) (Manager.HIGHLIGHT 53497 . 53794) (Manager.PROMPT 53796 .
|
||||
54109) (Manager.WINDOW 54111 . 54744) (Manager.insurefilehighlights 54746 . 55817) (Manager.CHANGED?
|
||||
55819 . 56368) (Manager.CHECKFILE 56370 . 57469) (Manager.COLLECTCOMS 57471 . 58909) (Manager.COMS.WSF
|
||||
58911 . 61581) (Manager.COMSOPEN 61583 . 66321) (Manager.COMSUPDATE 66323 . 67415) (
|
||||
Manager.HIGHLIGHTED 67417 . 67723) (Manager.INSUREHIGHLIGHTS 67725 . 68283) (Manager.FILECHANGES 68285
|
||||
. 68584) (Manager.FILELSTCHANGED? 68586 . 68914) (Manager.FILESUBTYPES 68916 . 69554) (
|
||||
Manager.GET.ENVIRONMENT 69556 . 72094) (Manager.GETFILE 72096 . 74410) (Manager.INTITLE? 74412 . 75090
|
||||
) (Manager.MAIN.WSF 75092 . 77736) (Manager.MAINCLOSE 77738 . 78848) (Manager.MAINMENUITEMS 78850 .
|
||||
79927) (Manager.MAINOPEN 79929 . 85322) (Manager.MAINUPDATE 85324 . 85960) (Manager.MAKEFILE.ADV 85962
|
||||
. 86998) (Manager.MENUCOLUMNS 87000 . 87804) (Manager.MENUHASITEM 87806 . 88163) (Manager.MENUITEMS
|
||||
88165 . 88410) (Manager.REMOVE.DUPLICATE.ADVICE 88412 . 90018) (Manager.RESETSUBITEMS 90020 . 91257) (
|
||||
Manager.SET-ANCHOR 91259 . 91578) (Manager.SORT.COMS 91580 . 92112) (Manager.SORTBYCOLUMN 92114 .
|
||||
93350)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
1071
lispusers/READ-BDF
1071
lispusers/READ-BDF
File diff suppressed because it is too large
Load Diff
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
@@ -1,16 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "29-Mar-2022 10:53:16" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>DIRECTORY.;15 28665
|
||||
(FILECREATED " 6-Nov-2025 00:13:55" {WMEDLEY}<sources>DIRECTORY.;17 28439
|
||||
|
||||
:CHANGES-TO (FNS DIRECTORY)
|
||||
:EDIT-BY rmk
|
||||
|
||||
:PREVIOUS-DATE "29-Mar-2022 08:29:33"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>DIRECTORY.;14)
|
||||
:CHANGES-TO (VARS DIRCOMMANDS)
|
||||
|
||||
:PREVIOUS-DATE "22-Oct-2025 22:07:27" {WMEDLEY}<sources>DIRECTORY.;16)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1986-1988, 1990, 1992 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT DIRECTORYCOMS)
|
||||
|
||||
@@ -419,7 +416,7 @@ Copyright (c) 1986-1988, 1990, 1992 by Venue & Xerox Corporation.
|
||||
DELETE
|
||||
(DELETE? PROMPT " delete? " DELETE)
|
||||
DELETED
|
||||
(LE LENGTH "(" BYTESIZE ")")
|
||||
(LE . LENGTH)
|
||||
NEWERTHAN OLDVERSIONS (OLD OLDERTHAN 90)
|
||||
OLDERTHAN
|
||||
(OU . OUT)
|
||||
@@ -463,12 +460,11 @@ Copyright (c) 1986-1988, 1990, 1992 by Venue & Xerox Corporation.
|
||||
(GLOBALVARS DIRCOMMANDS ASKUSERTTBL FILEINFOTYPES)
|
||||
)
|
||||
)
|
||||
(PUTPROPS DIRECTORY COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1992))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1325 27144 (DODIR 1335 . 1882) (FILDIR 1884 . 2164) (DIRECTORY 2166 . 12883) (
|
||||
DIRECTORY.PARSE 12885 . 14179) (DIRECTORY.FILL.PATTERN 14181 . 14711) (DIRCONJ 14713 . 14933) (
|
||||
DIRECTORY.NEXTFILE 14935 . 15528) (DMATCH 15530 . 15905) (DIRECTORY.MATCH.SETUP 15907 . 16441) (
|
||||
DIRECTORY.MATCH 16443 . 16860) (DIRECTORY.MATCH1 16862 . 18975) (DODIRCOMMANDS 18977 . 24447) (
|
||||
DIRPRINTNAME 24449 . 25865) (DPRIN1 25867 . 25952) (DIRFILENAME 25954 . 26675) (DIRGETFILEINFO 26677
|
||||
. 26829) (DREAD 26831 . 27142)))))
|
||||
(FILEMAP (NIL (1200 27019 (DODIR 1210 . 1757) (FILDIR 1759 . 2039) (DIRECTORY 2041 . 12758) (
|
||||
DIRECTORY.PARSE 12760 . 14054) (DIRECTORY.FILL.PATTERN 14056 . 14586) (DIRCONJ 14588 . 14808) (
|
||||
DIRECTORY.NEXTFILE 14810 . 15403) (DMATCH 15405 . 15780) (DIRECTORY.MATCH.SETUP 15782 . 16316) (
|
||||
DIRECTORY.MATCH 16318 . 16735) (DIRECTORY.MATCH1 16737 . 18850) (DODIRCOMMANDS 18852 . 24322) (
|
||||
DIRPRINTNAME 24324 . 25740) (DPRIN1 25742 . 25827) (DIRFILENAME 25829 . 26550) (DIRGETFILEINFO 26552
|
||||
. 26704) (DREAD 26706 . 27017)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "29-Aug-2025 11:38:16" {WMEDLEY}<sources>HLDISPLAY.;3 205136
|
||||
(FILECREATED "24-Dec-2025 21:06:38" {WMEDLEY}<sources>HLDISPLAY.;4 205147
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS EDITBM)
|
||||
:CHANGES-TO (VARS HLDISPLAYCOMS)
|
||||
|
||||
:PREVIOUS-DATE " 2-Aug-2025 10:16:35" {WMEDLEY}<sources>HLDISPLAY.;2)
|
||||
:PREVIOUS-DATE "29-Aug-2025 11:38:16" {WMEDLEY}<sources>HLDISPLAY.;3)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT HLDISPLAYCOMS)
|
||||
@@ -3508,38 +3508,38 @@
|
||||
DEST-WORD-WIDTH)))
|
||||
DESTINATION))
|
||||
|
||||
(PUTPROPS HLDISPLAY FILETYPE CL:COMPILE-FILE)
|
||||
(PUTPROPS HLDISPLAY FILETYPE :FAKE-COMPILE-FILE)
|
||||
|
||||
(READVARS-FROM-STRINGS '(\4BITEXPANSIONTABLE)
|
||||
"({Y16 SMALLPOSP 0 0 15 240 255 3840 3855 4080 4095 61440 61455 61680 61695 65280 65295 65520 65535 })
|
||||
")
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4649 11812 (GRID 4659 . 8930) (GRIDXCOORD 8932 . 9437) (GRIDYCOORD 9439 . 9948) (
|
||||
LEFTOFGRIDCOORD 9950 . 10387) (BOTTOMOFGRIDCOORD 10389 . 10650) (SHADEGRIDBOX 10652 . 11810)) (11868
|
||||
12276 (INSIDE? 11878 . 12274)) (12314 16710 (MOUSESTATE-EXPR 12324 . 15979) (MOUSESTATE-NAME 15981 .
|
||||
16708)) (20200 21185 (DECODEBUTTONS 20210 . 21183)) (21186 22198 (PTDIFFERENCE 21196 . 21705) (PTPLUS
|
||||
21707 . 22196)) (22249 50152 (GETPOSITION 22259 . 22567) (GETBOXPOSITION 22569 . 23252) (
|
||||
DSPYSCREENTOWINDOW 23254 . 23738) (DSPXSCREENTOWINDOW 23740 . 24224) (GETREGION 24226 . 24775) (
|
||||
\GETREGION.PACKPTS 24777 . 25345) (\GETREGION.CHECKBASEPT 25347 . 27290) (\GETREGION.CHECKOPPT 27292
|
||||
. 30102) (\GETREGIONTRACKWITHBOX 30104 . 36635) (\UPDATEXYANDBOX 36637 . 39016) (GETBOXREGION 39018
|
||||
. 39492) (\TRACKWITHBOX 39494 . 44632) (MOVEBOX 44634 . 45264) (DRAWGRAYBOX 45266 . 45788) (BLTHLINE
|
||||
45790 . 46040) (BLTVLINE 46042 . 46281) (SETCORNER 46283 . 47549) (GETSCREENPOSITION 47551 . 48164) (
|
||||
GETBOXSCREENPOSITION 48166 . 48777) (GETSCREENREGION 48779 . 49435) (GETBOXSCREENREGION 49437 . 50150)
|
||||
) (50238 67054 (\MEDW.GETSCREENPOSITION 50248 . 52041) (\MEDW.GETBOXSCREENPOSITION 52043 . 55597) (
|
||||
\MEDW.GETSCREENREGION 55599 . 67052)) (67055 74793 (GETGRIDBOXREGION 67065 . 74719) (\RANGELIMIT 74721
|
||||
. 74791)) (74794 77844 (MOUSECONFIRM 74804 . 77842)) (77985 79354 (NEAREST/PT/ON/GRID 77995 . 78590)
|
||||
(PTON10GRID 78592 . 78917) (NEAREST/MULTIPLE 78919 . 79352)) (81398 85300 (\SW2BM 81408 . 84106) (
|
||||
COMPOSEREGS 84108 . 84662) (TRANSLATEREG 84664 . 85298)) (85342 176197 (EDITBM 85352 . 95681) (
|
||||
EDITBMSCROLLFN 95683 . 110836) (EDITBMCLOSEFN 110838 . 111455) (TILEAREA 111457 . 111848) (
|
||||
EDITBMBUTTONFN 111850 . 136677) (\EDITBM/PUTUP/DISPLAY 136679 . 137581) (\EDITBMHOWMUCH 137583 .
|
||||
138569) (EDITBMRESHAPEFN 138571 . 147257) (EDITBMREPAINTFN 147259 . 148578) (UPDATE/SHADE/DISPLAY
|
||||
148580 . 149027) (UPDATE/BM/DISPLAY/SELECTED/REGION 149029 . 150143) (SHOWBUTTON 150145 . 150703) (
|
||||
RESETGRID.NEW 150705 . 154054) (RESETGRID 154056 . 154880) (\READBMDIMENSIONS 154882 . 155919) (
|
||||
EDITSHADE 155921 . 164647) (\BITMAPFROMTEXTURE 164649 . 165347) (EDITSHADEREPAINTFN 165349 . 167123) (
|
||||
GRAYBOXAREA 167125 . 167808) (\SHADEBITS 167810 . 170775) (READHOTSPOT 170777 . 174642) (WBOX 174644
|
||||
. 175368) (\CLEARBM 175370 . 175569) (EDITBMTEXTURE 175571 . 176195)) (177542 185249 (SCALEBM 177552
|
||||
. 179618) (BLTPATTERN 179620 . 182138) (BLTPATTERN.REPLACEDISPLAY 182140 . 184229) (
|
||||
BLTPATTERN.GENERIC 184231 . 185247)) (185250 197069 (EXPANDBITMAP 185260 . 187784) (EXPANDBM 187786 .
|
||||
194341) (SHRINKBITMAP 194343 . 195687) (\FAST4BIT 195689 . 197067)) (197071 201060 (ROTATE-BITMAP
|
||||
197071 . 201060)) (201062 204898 (ROTATE-BITMAP-LEFT 201062 . 204898)))))
|
||||
(FILEMAP (NIL (4657 11820 (GRID 4667 . 8938) (GRIDXCOORD 8940 . 9445) (GRIDYCOORD 9447 . 9956) (
|
||||
LEFTOFGRIDCOORD 9958 . 10395) (BOTTOMOFGRIDCOORD 10397 . 10658) (SHADEGRIDBOX 10660 . 11818)) (11876
|
||||
12284 (INSIDE? 11886 . 12282)) (12322 16718 (MOUSESTATE-EXPR 12332 . 15987) (MOUSESTATE-NAME 15989 .
|
||||
16716)) (20208 21193 (DECODEBUTTONS 20218 . 21191)) (21194 22206 (PTDIFFERENCE 21204 . 21713) (PTPLUS
|
||||
21715 . 22204)) (22257 50160 (GETPOSITION 22267 . 22575) (GETBOXPOSITION 22577 . 23260) (
|
||||
DSPYSCREENTOWINDOW 23262 . 23746) (DSPXSCREENTOWINDOW 23748 . 24232) (GETREGION 24234 . 24783) (
|
||||
\GETREGION.PACKPTS 24785 . 25353) (\GETREGION.CHECKBASEPT 25355 . 27298) (\GETREGION.CHECKOPPT 27300
|
||||
. 30110) (\GETREGIONTRACKWITHBOX 30112 . 36643) (\UPDATEXYANDBOX 36645 . 39024) (GETBOXREGION 39026
|
||||
. 39500) (\TRACKWITHBOX 39502 . 44640) (MOVEBOX 44642 . 45272) (DRAWGRAYBOX 45274 . 45796) (BLTHLINE
|
||||
45798 . 46048) (BLTVLINE 46050 . 46289) (SETCORNER 46291 . 47557) (GETSCREENPOSITION 47559 . 48172) (
|
||||
GETBOXSCREENPOSITION 48174 . 48785) (GETSCREENREGION 48787 . 49443) (GETBOXSCREENREGION 49445 . 50158)
|
||||
) (50246 67062 (\MEDW.GETSCREENPOSITION 50256 . 52049) (\MEDW.GETBOXSCREENPOSITION 52051 . 55605) (
|
||||
\MEDW.GETSCREENREGION 55607 . 67060)) (67063 74801 (GETGRIDBOXREGION 67073 . 74727) (\RANGELIMIT 74729
|
||||
. 74799)) (74802 77852 (MOUSECONFIRM 74812 . 77850)) (77993 79362 (NEAREST/PT/ON/GRID 78003 . 78598)
|
||||
(PTON10GRID 78600 . 78925) (NEAREST/MULTIPLE 78927 . 79360)) (81406 85308 (\SW2BM 81416 . 84114) (
|
||||
COMPOSEREGS 84116 . 84670) (TRANSLATEREG 84672 . 85306)) (85350 176205 (EDITBM 85360 . 95689) (
|
||||
EDITBMSCROLLFN 95691 . 110844) (EDITBMCLOSEFN 110846 . 111463) (TILEAREA 111465 . 111856) (
|
||||
EDITBMBUTTONFN 111858 . 136685) (\EDITBM/PUTUP/DISPLAY 136687 . 137589) (\EDITBMHOWMUCH 137591 .
|
||||
138577) (EDITBMRESHAPEFN 138579 . 147265) (EDITBMREPAINTFN 147267 . 148586) (UPDATE/SHADE/DISPLAY
|
||||
148588 . 149035) (UPDATE/BM/DISPLAY/SELECTED/REGION 149037 . 150151) (SHOWBUTTON 150153 . 150711) (
|
||||
RESETGRID.NEW 150713 . 154062) (RESETGRID 154064 . 154888) (\READBMDIMENSIONS 154890 . 155927) (
|
||||
EDITSHADE 155929 . 164655) (\BITMAPFROMTEXTURE 164657 . 165355) (EDITSHADEREPAINTFN 165357 . 167131) (
|
||||
GRAYBOXAREA 167133 . 167816) (\SHADEBITS 167818 . 170783) (READHOTSPOT 170785 . 174650) (WBOX 174652
|
||||
. 175376) (\CLEARBM 175378 . 175577) (EDITBMTEXTURE 175579 . 176203)) (177550 185257 (SCALEBM 177560
|
||||
. 179626) (BLTPATTERN 179628 . 182146) (BLTPATTERN.REPLACEDISPLAY 182148 . 184237) (
|
||||
BLTPATTERN.GENERIC 184239 . 185255)) (185258 197077 (EXPANDBITMAP 185268 . 187792) (EXPANDBM 187794 .
|
||||
194349) (SHRINKBITMAP 194351 . 195695) (\FAST4BIT 195697 . 197075)) (197079 201068 (ROTATE-BITMAP
|
||||
197079 . 201068)) (201070 204906 (ROTATE-BITMAP-LEFT 201070 . 204906)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,14 @@
|
||||
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "XCL")
|
||||
(IL:FILECREATED "18-May-90 01:15:40" IL:|{DSK}<usr>local>lde>lispcore>sources>XCL-EXTRAS.;2| 15315
|
||||
(DEFINE-FILE-INFO PACKAGE "XEROX-COMMON-LISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
IL:|changes| IL:|to:| (IL:VARS IL:XCL-EXTRASCOMS)
|
||||
(IL:FILECREATED "11-Dec-2025 22:27:58" IL:|{DSK}<home>matt>Interlisp>medley>sources>XCL-EXTRAS.;2| 15547
|
||||
|
||||
IL:|previous| IL:|date:| "11-Jan-88 16:59:17"
|
||||
IL:|{DSK}<usr>local>lde>lispcore>sources>XCL-EXTRAS.;1|)
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (IL:FUNCTIONS DEFINE-RECORD)
|
||||
|
||||
:PREVIOUS-DATE "18-May-90 01:15:40" IL:|{DSK}<home>matt>Interlisp>medley>sources>XCL-EXTRAS.;1|
|
||||
)
|
||||
|
||||
; Copyright (c) 1987, 1988, 1990 by Venue & Xerox Corporation. All rights reserved.
|
||||
|
||||
(IL:PRETTYCOMPRINT IL:XCL-EXTRASCOMS)
|
||||
|
||||
@@ -145,8 +146,7 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>XCL-EXTRAS.;1|)
|
||||
IL:*INTERLISP-PACKAGE*))
|
||||
(COLLECT KEYWORD-SYMBOL)
|
||||
(IF (NOT (MEMBER KEYWORD-SYMBOL '(IL:USING IL:COPYING
|
||||
IL:REUSING IL:SMASHING
|
||||
)
|
||||
IL:REUSING IL:SMASHING)
|
||||
:TEST
|
||||
#'EQ))
|
||||
(COLLECT 'IL:_))
|
||||
@@ -162,12 +162,12 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>XCL-EXTRAS.;1|)
|
||||
|
||||
|
||||
(DEFDEFINER DEFINE-RECORD IL:STRUCTURES (RECORD-NAME INTERLISP-RECORD-NAME &KEY (CONC-NAME NIL
|
||||
CONC-NAME-P
|
||||
)
|
||||
(CONSTRUCTOR NIL CONSTRUCTOR-P)
|
||||
(PREDICATE NIL PREDICATE-P)
|
||||
(FAST-ACCESSORS NIL)
|
||||
(PACKAGE *PACKAGE*))
|
||||
CONC-NAME-P)
|
||||
(CONSTRUCTOR NIL CONSTRUCTOR-P)
|
||||
(PREDICATE NIL PREDICATE-P)
|
||||
(FAST-ACCESSORS NIL)
|
||||
(PACKAGE *PACKAGE*))
|
||||
(IL:* IL:\; "Edited 11-Dec-2025 21:43 by mth")
|
||||
(IF (NOT (PACKAGEP PACKAGE))
|
||||
(SETQ PACKAGE (FIND-PACKAGE PACKAGE)))
|
||||
(SETQ CONC-NAME (IF CONC-NAME-P
|
||||
@@ -195,7 +195,8 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>XCL-EXTRAS.;1|)
|
||||
'SETF-RECORD-ACCESS-MACRO)
|
||||
(SETF (GET ',NEW-NAME :SLOT-INFO)
|
||||
',`((,INTERLISP-RECORD-NAME ,FIELD-NAME)
|
||||
,FAST-ACCESSORS))))))
|
||||
,FAST-ACCESSORS))
|
||||
(IL:CLSMARTEN '((,NEW-NAME IL:OBJECT)))))))
|
||||
FIELD-NAMES)
|
||||
,@(LET ((NEW-NAME (IF PREDICATE-P
|
||||
PREDICATE
|
||||
@@ -214,7 +215,8 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>XCL-EXTRAS.;1|)
|
||||
`((SETF (MACRO-FUNCTION ',NEW-NAME)
|
||||
'RECORD-PREDICATE-MACRO)
|
||||
(SETF (GET ',NEW-NAME :TYPE-INFO)
|
||||
',INTERLISP-RECORD-NAME))))
|
||||
',INTERLISP-RECORD-NAME)
|
||||
(IL:CLSMARTEN '((,NEW-NAME IL:OBJECT))))))
|
||||
,@(LET ((NEW-NAME (IF CONSTRUCTOR-P
|
||||
CONSTRUCTOR
|
||||
(INTERN (CONCATENATE 'STRING "MAKE-" (STRING RECORD-NAME))
|
||||
@@ -234,7 +236,8 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>XCL-EXTRAS.;1|)
|
||||
`((SETF (MACRO-FUNCTION ',NEW-NAME)
|
||||
'RECORD-CONSTRUCTOR-MACRO)
|
||||
(SETF (GET ',NEW-NAME :FIELD-INFO)
|
||||
'(,INTERLISP-RECORD-NAME ,FIELD-NAMES))))))))
|
||||
'(,INTERLISP-RECORD-NAME ,FIELD-NAMES))
|
||||
(IL:CLSMARTEN '((,NEW-NAME &KEY ,@FIELD-NAMES)))))))))
|
||||
|
||||
(DEFUN RECORD-ACCESS-MACRO (FORM &OPTIONAL ENV)
|
||||
(DECLARE (IGNORE ENV))
|
||||
@@ -257,8 +260,8 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>XCL-EXTRAS.;1|)
|
||||
(DEFUN RECORD-PREDICATE-MACRO (FORM &OPTIONAL ENV)
|
||||
(DECLARE (IGNORE ENV))
|
||||
`(IL:|type?| ,(OR (GET (CAR FORM)
|
||||
:TYPE-INFO)
|
||||
(ERROR "No type information cached."))
|
||||
:TYPE-INFO)
|
||||
(ERROR "No type information cached."))
|
||||
,(SECOND FORM)))
|
||||
|
||||
(DEFUN RECORD-CONSTRUCTOR-MACRO (FORM &OPTIONAL ENV)
|
||||
@@ -267,32 +270,35 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>XCL-EXTRAS.;1|)
|
||||
(OR (GET (CAR FORM)
|
||||
:FIELD-INFO)
|
||||
(ERROR "No field information cached."))
|
||||
`(IL:|create| ,TYPE
|
||||
,@(WITH-COLLECTION (DO* ((KEYWORD (CDR FORM)
|
||||
(CDDR KEYWORD))
|
||||
(KEYWORD-SYMBOL (CAR KEYWORD)
|
||||
(CAR KEYWORD))
|
||||
(VALUE (CADR KEYWORD)
|
||||
(CADR KEYWORD))
|
||||
RESERVED-WORD)
|
||||
((NULL KEYWORD))
|
||||
(SETQ RESERVED-WORD
|
||||
(CAR (MEMBER KEYWORD-SYMBOL
|
||||
'(IL:USING IL:COPYING IL:REUSING
|
||||
IL:SMASHING)
|
||||
:TEST
|
||||
'STRING=)))
|
||||
(COLLECT (OR RESERVED-WORD (CAR (MEMBER KEYWORD-SYMBOL
|
||||
FIELD-NAMES :TEST
|
||||
'STRING=))))
|
||||
(IF (NOT RESERVED-WORD)
|
||||
(COLLECT 'IL:_))
|
||||
(COLLECT VALUE))))))
|
||||
`(IL:|create| ,TYPE ,@(WITH-COLLECTION (DO* ((KEYWORD (CDR FORM)
|
||||
(CDDR KEYWORD))
|
||||
(KEYWORD-SYMBOL (CAR KEYWORD)
|
||||
(CAR KEYWORD))
|
||||
(VALUE (CADR KEYWORD)
|
||||
(CADR KEYWORD))
|
||||
RESERVED-WORD)
|
||||
((NULL KEYWORD))
|
||||
(SETQ RESERVED-WORD
|
||||
(CAR (MEMBER KEYWORD-SYMBOL
|
||||
'(IL:USING IL:COPYING
|
||||
IL:REUSING IL:SMASHING)
|
||||
:TEST
|
||||
'STRING=)))
|
||||
(COLLECT (OR RESERVED-WORD
|
||||
(CAR (MEMBER KEYWORD-SYMBOL
|
||||
FIELD-NAMES :TEST
|
||||
'STRING=))))
|
||||
(IF (NOT RESERVED-WORD)
|
||||
(COLLECT 'IL:_))
|
||||
(COLLECT VALUE))))))
|
||||
|
||||
(IL:PUTPROPS IL:XCL-EXTRAS IL:FILETYPE :COMPILE-FILE)
|
||||
|
||||
(IL:PUTPROPS IL:XCL-EXTRAS IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE "XCL"))
|
||||
(IL:PUTPROPS IL:XCL-EXTRAS IL:COPYRIGHT ("Venue & Xerox Corporation" 1987 1988 1990))
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
(IL:FILEMAP (NIL)))
|
||||
(IL:FILEMAP (NIL (2264 4771 (ONCE-ONLY 2264 . 4771)) (4828 5137 (RECORD-FETCH 4828 . 5137)) (5139 5483
|
||||
(SETF-FETCH 5139 . 5483)) (5485 5796 (RECORD-FFETCH 5485 . 5796)) (5798 6144 (SETF-FFETCH 5798 . 6144
|
||||
)) (6146 7341 (RECORD-CREATE 6146 . 7341)) (12279 12699 (RECORD-ACCESS-MACRO 12279 . 12699)) (13146
|
||||
13397 (RECORD-PREDICATE-MACRO 13146 . 13397)) (13399 15360 (RECORD-CONSTRUCTOR-MACRO 13399 . 15360))))
|
||||
)
|
||||
IL:STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user