Compare commits
9 Commits
fgh_wget
...
medley-251
| Author | SHA1 | Date | |
|---|---|---|---|
|
696d34cb9d | ||
|
0fdcbe0590 | ||
|
|
9d2809028d | ||
|
defd68a892 | ||
|
|
428aac56ea | ||
|
e4641d8515 | ||
|
|
72251e34a6 | ||
|
|
eb14868208 | ||
|
|
2d91426dc1 |
@@ -1,12 +1,13 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||||
|
|
||||||
(FILECREATED "16-Oct-2025 16:55:27" |{WMEDLEY}<internal>loadups>LOADUP-LISP.;22| 7104
|
(FILECREATED " 5-Nov-2025 09:04:36" |{DSK}<Users>larry>il>MEDLEY>INTERNAL>loadups>LOADUP-LISP.;2| 7333
|
||||||
|
|
||||||
:EDIT-BY |rmk|
|
:EDIT-BY "lmm"
|
||||||
|
|
||||||
:CHANGES-TO (FNS LOADUP-LISP)
|
:CHANGES-TO (FNS LOADUP-LISP)
|
||||||
|
|
||||||
:PREVIOUS-DATE "18-Aug-2025 12:09:49" |{WMEDLEY}<internal>loadups>LOADUP-LISP.;21|)
|
:PREVIOUS-DATE "16-Oct-2025 16:55:27"
|
||||||
|
|{DSK}<Users>larry>il>MEDLEY>INTERNAL>loadups>LOADUP-LISP.;1|)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT LOADUP-LISPCOMS)
|
(PRETTYCOMPRINT LOADUP-LISPCOMS)
|
||||||
@@ -19,7 +20,8 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(LOADUP-LISP
|
(LOADUP-LISP
|
||||||
(LAMBDA (DRIBBLEFILE) (* \; "Edited 16-Oct-2025 16:55 by rmk")
|
(LAMBDA (DRIBBLEFILE) (* \; "Edited 5-Nov-2025 09:01 by lmm")
|
||||||
|
(* \; "Edited 16-Oct-2025 16:55 by rmk")
|
||||||
(* \; "Edited 18-Aug-2025 12:08 by rmk")
|
(* \; "Edited 18-Aug-2025 12:08 by rmk")
|
||||||
(* \; "Edited 15-Jun-2025 14:39 by rmk")
|
(* \; "Edited 15-Jun-2025 14:39 by rmk")
|
||||||
(* \; "Edited 24-May-2025 10:20 by rmk")
|
(* \; "Edited 24-May-2025 10:20 by rmk")
|
||||||
@@ -126,7 +128,10 @@
|
|||||||
|
|
||||||
(* |;;| " Added late, LOAD late to avoid any dependencies")
|
(* |;;| " Added late, LOAD late to avoid any dependencies")
|
||||||
|
|
||||||
|
(* |;;| "prevent medley from pinning CPU")
|
||||||
|
|
||||||
(LOADUP '(XCL-LOOP XCL-HASH-LOOP))
|
(LOADUP '(XCL-LOOP XCL-HASH-LOOP))
|
||||||
|
(LOADUP '(BACKGROUND-YIELD))
|
||||||
|
|
||||||
(* |;;| " networking code -- should make it optional but too many cross dependencies")
|
(* |;;| " networking code -- should make it optional but too many cross dependencies")
|
||||||
|
|
||||||
@@ -144,5 +149,5 @@
|
|||||||
(GLOBALVARS MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST)
|
(GLOBALVARS MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST)
|
||||||
)
|
)
|
||||||
(DECLARE\: DONTCOPY
|
(DECLARE\: DONTCOPY
|
||||||
(FILEMAP (NIL (640 6898 (LOADUP-LISP 650 . 6896)))))
|
(FILEMAP (NIL (675 7127 (LOADUP-LISP 685 . 7125)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||||
|
|
||||||
(FILECREATED "22-Oct-2025 13:05:51" {WMEDLEY}<library>UNIXUTILS.;33 17919
|
(FILECREATED " 4-Nov-2025 10:11:10" {WMEDLEY}<library>UNIXUTILS.;34 18037
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS SLASHIT)
|
:CHANGES-TO (FNS SLASHIT)
|
||||||
|
|
||||||
:PREVIOUS-DATE "27-Sep-2025 16:25:07" {WMEDLEY}<library>UNIXUTILS.;32)
|
:PREVIOUS-DATE "22-Oct-2025 13:05:51" {WMEDLEY}<library>UNIXUTILS.;33)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT UNIXUTILSCOMS)
|
(PRETTYCOMPRINT UNIXUTILSCOMS)
|
||||||
@@ -240,7 +240,8 @@
|
|||||||
0))) DO (BLOCK) FINALLY (RETURN CODE])
|
0))) DO (BLOCK) FINALLY (RETURN CODE])
|
||||||
|
|
||||||
(SLASHIT
|
(SLASHIT
|
||||||
[LAMBDA (X LCASEDIRS NOHOST) (* ; "Edited 22-Oct-2025 13:05 by rmk")
|
[LAMBDA (X LCASEDIRS NOHOST) (* ; "Edited 4-Nov-2025 10:10 by rmk")
|
||||||
|
(* ; "Edited 22-Oct-2025 13:05 by rmk")
|
||||||
(* ; "Edited 25-Sep-2025 09:57 by rmk")
|
(* ; "Edited 25-Sep-2025 09:57 by rmk")
|
||||||
(* ; "Edited 23-Sep-2023 15:27 by rmk")
|
(* ; "Edited 23-Sep-2023 15:27 by rmk")
|
||||||
|
|
||||||
@@ -259,7 +260,7 @@
|
|||||||
(CONS (CHARCODE /)))
|
(CONS (CHARCODE /)))
|
||||||
(/ (SETQ LASTDIRPOS I)
|
(/ (SETQ LASTDIRPOS I)
|
||||||
(CONS C))
|
(CONS C))
|
||||||
(SPACE (CHARCODE (\ SPACE)))
|
(SPACE (APPEND (CHARCODE (\ SPACE))))
|
||||||
(CONS C]
|
(CONS C]
|
||||||
(CL:WHEN (AND LCASEDIRS LASTDIRPOS)
|
(CL:WHEN (AND LCASEDIRS LASTDIRPOS)
|
||||||
(SETQ LASTDIRPOS (ADD1 (IDIFFERENCE LASTDIRPOS DIRPOS)))
|
(SETQ LASTDIRPOS (ADD1 (IDIFFERENCE LASTDIRPOS DIRPOS)))
|
||||||
@@ -326,7 +327,7 @@
|
|||||||
|
|
||||||
(PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE)
|
(PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (1110 1483 (ShellCommand 1110 . 1483)) (1485 1882 (ShellWhich 1485 . 1882)) (1972 17841
|
(FILEMAP (NIL (1110 1483 (ShellCommand 1110 . 1483)) (1485 1882 (ShellWhich 1485 . 1882)) (1972 17959
|
||||||
(ShellBrowser 1982 . 3754) (ShellBrowse 3756 . 4441) (ShellOpener 4443 . 6131) (ShellOpen 6133 . 11612
|
(ShellBrowser 1982 . 3754) (ShellBrowse 3756 . 4441) (ShellOpener 4443 . 6131) (ShellOpen 6133 . 11612
|
||||||
) (PROCESS-COMMAND 11614 . 12227) (SLASHIT 12229 . 14566) (UNIX-FILE-NAME 14568 . 17839)))))
|
) (PROCESS-COMMAND 11614 . 12227) (SLASHIT 12229 . 14684) (UNIX-FILE-NAME 14686 . 17957)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||||
|
|
||||||
(FILECREATED " 8-Sep-2025 22:10:20" {WMEDLEY}<library>TEDIT>TEDIT.;838 145349
|
(FILECREATED "13-Nov-2025 21:00:34" {WMEDLEY}<library>TEDIT>TEDIT.;844 144838
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS TEDIT.NTHCHARCODE)
|
:CHANGES-TO (FNS TEDIT.INSERT \TEDIT.INSERT)
|
||||||
|
|
||||||
:PREVIOUS-DATE " 6-Sep-2025 09:54:48" {WMEDLEY}<library>TEDIT>TEDIT.;837)
|
:PREVIOUS-DATE "28-Oct-2025 00:29:56" {WMEDLEY}<library>TEDIT>TEDIT.;843)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDITCOMS)
|
(PRETTYCOMPRINT TEDITCOMS)
|
||||||
@@ -75,9 +75,9 @@
|
|||||||
(FNS TEDITSYSTEMDATE)
|
(FNS TEDITSYSTEMDATE)
|
||||||
(VARS (TEDITSYSTEMDATE (TEDITSYSTEMDATE]
|
(VARS (TEDITSYSTEMDATE (TEDITSYSTEMDATE]
|
||||||
(COMS (* ;
|
(COMS (* ;
|
||||||
"LISTFILES Interface, so the system can decide if a file is a TEdit file.")
|
"IMAGETYPE Interface, so the system can decide if a file is a TEdit file.")
|
||||||
(ADDVARS (PRINTFILETYPES (TEDIT (TEST \TEDIT.GET.TRAILER)
|
(ADDVARS (PRINTFILETYPES (TEDIT (TEST TEDIT.FORMATTEDFILEP)
|
||||||
(EXTENSION (TEDIT])
|
(EXTENSION (TEDIT TED])
|
||||||
|
|
||||||
(FILESLOAD (SYSLOAD)
|
(FILESLOAD (SYSLOAD)
|
||||||
POSTSCRIPTSTREAM PDFSTREAM WHEELSCROLL)
|
POSTSCRIPTSTREAM PDFSTREAM WHEELSCROLL)
|
||||||
@@ -441,6 +441,8 @@
|
|||||||
(TEDIT-SEE
|
(TEDIT-SEE
|
||||||
[LAMBDA (FILE WINDOW FORMAT TITLE)
|
[LAMBDA (FILE WINDOW FORMAT TITLE)
|
||||||
|
|
||||||
|
(* ;; "Edited 27-Oct-2025 21:25 by rmk")
|
||||||
|
|
||||||
(* ;;
|
(* ;;
|
||||||
"Edited 13-Sep-2023 09:04 by rmk: Old code replaced to take advantage of new standard interfaces.")
|
"Edited 13-Sep-2023 09:04 by rmk: Old code replaced to take advantage of new standard interfaces.")
|
||||||
|
|
||||||
@@ -452,7 +454,8 @@
|
|||||||
|
|
||||||
(* ;; "Edited 1-Feb-88 19:00 by bvm:")
|
(* ;; "Edited 1-Feb-88 19:00 by bvm:")
|
||||||
|
|
||||||
(TEXTSTREAM (TEDIT FILE WINDOW NIL `(READONLY T LEAVETTY T FONT ,DEFAULTFONT])
|
(TEXTSTREAM (TEDIT FILE WINDOW NIL `(READONLY T LEAVETTY T FONT ,DEFAULTFONT TITLE ,TITLE FORMAT
|
||||||
|
,FORMAT])
|
||||||
|
|
||||||
(TEDIT.COPY
|
(TEDIT.COPY
|
||||||
[LAMBDA (FROM TO) (* ; "Edited 2-Dec-2024 09:02 by rmk")
|
[LAMBDA (FROM TO) (* ; "Edited 2-Dec-2024 09:02 by rmk")
|
||||||
@@ -506,7 +509,8 @@
|
|||||||
(\TEDIT.DELETE TSTREAM SEL])
|
(\TEDIT.DELETE TSTREAM SEL])
|
||||||
|
|
||||||
(TEDIT.INSERT
|
(TEDIT.INSERT
|
||||||
[LAMBDA (TSTREAM TEXT CH#ORSEL LOOKS DONTSCROLL) (* ; "Edited 4-Apr-2025 11:22 by rmk")
|
[LAMBDA (TSTREAM TEXT CH#ORSEL LOOKS DONTSCROLL) (* ; "Edited 13-Nov-2025 20:58 by rmk")
|
||||||
|
(* ; "Edited 4-Apr-2025 11:22 by rmk")
|
||||||
(* ; "Edited 2-Aug-2024 22:17 by rmk")
|
(* ; "Edited 2-Aug-2024 22:17 by rmk")
|
||||||
(* ; "Edited 31-Jul-2024 12:13 by rmk")
|
(* ; "Edited 31-Jul-2024 12:13 by rmk")
|
||||||
(* ; "Edited 23-Jul-2024 16:35 by rmk")
|
(* ; "Edited 23-Jul-2024 16:35 by rmk")
|
||||||
@@ -531,7 +535,7 @@
|
|||||||
|
|
||||||
(* ;; "Nothing to do for an empty string")
|
(* ;; "Nothing to do for an empty string")
|
||||||
|
|
||||||
(LET ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)))
|
(LET ((TEXTOBJ (FTEXTOBJ TSTREAM)))
|
||||||
(if (FIXP CH#ORSEL)
|
(if (FIXP CH#ORSEL)
|
||||||
then (TEDIT.SETSEL TEXTOBJ CH#ORSEL 1 'LEFT)
|
then (TEDIT.SETSEL TEXTOBJ CH#ORSEL 1 'LEFT)
|
||||||
(* ; "He gave us a ch# to insert before")
|
(* ; "He gave us a ch# to insert before")
|
||||||
@@ -540,14 +544,8 @@
|
|||||||
then (SETQ CH#ORSEL (TEXTSEL TEXTOBJ)))
|
then (SETQ CH#ORSEL (TEXTSEL TEXTOBJ)))
|
||||||
(SELECTION! CH#ORSEL)
|
(SELECTION! CH#ORSEL)
|
||||||
(if (FGETSEL CH#ORSEL SET)
|
(if (FGETSEL CH#ORSEL SET)
|
||||||
then (\TEDIT.INSERT TEXT CH#ORSEL TSTREAM DONTSCROLL)
|
then (CL:WHEN LOOKS (TEDIT.CARETLOOKS TSTREAM LOOKS))
|
||||||
(CL:WHEN LOOKS
|
(\TEDIT.INSERT TEXT CH#ORSEL TSTREAM DONTSCROLL)
|
||||||
|
|
||||||
(* ;; "TEXTSEL now selects the insertion, apply the looks, but don't keep the looks-change as a separate event. We want it to behave as if the looks had been applied to the TEXT before the insertion (e.g. converting first to SELPIECES).")
|
|
||||||
|
|
||||||
(LET ((HISTORY (FGETTOBJ TEXTOBJ TXTHISTORY)))
|
|
||||||
(\TEDIT.CHANGE.CHARLOOKS TSTREAM LOOKS)
|
|
||||||
(FSETTOBJ TEXTOBJ TXTHISTORY HISTORY)))
|
|
||||||
else (TEDIT.PROMPTPRINT TEXTOBJ "Please select a place for the insertion." T))))
|
else (TEDIT.PROMPTPRINT TEXTOBJ "Please select a place for the insertion." T))))
|
||||||
])
|
])
|
||||||
|
|
||||||
@@ -1240,7 +1238,8 @@
|
|||||||
(T TSTREAM)))])
|
(T TSTREAM)))])
|
||||||
|
|
||||||
(\TEDIT.INSERT
|
(\TEDIT.INSERT
|
||||||
[LAMBDA (INSERT SEL TSTREAM DONTSCROLL TYPEIN) (* ; "Edited 7-May-2025 00:11 by rmk")
|
[LAMBDA (INSERT SEL TSTREAM DONTSCROLL TYPEIN) (* ; "Edited 13-Nov-2025 20:57 by rmk")
|
||||||
|
(* ; "Edited 7-May-2025 00:11 by rmk")
|
||||||
(* ; "Edited 21-Apr-2025 20:16 by rmk")
|
(* ; "Edited 21-Apr-2025 20:16 by rmk")
|
||||||
(* ; "Edited 20-Apr-2025 13:26 by rmk")
|
(* ; "Edited 20-Apr-2025 13:26 by rmk")
|
||||||
(* ; "Edited 6-Apr-2025 14:12 by rmk")
|
(* ; "Edited 6-Apr-2025 14:12 by rmk")
|
||||||
@@ -1311,14 +1310,10 @@
|
|||||||
|
|
||||||
(* ;; "Set the caret so that the next insertion should also come in front of that (now displaced) character, and then update the screen.")
|
(* ;; "Set the caret so that the next insertion should also come in front of that (now displaced) character, and then update the screen.")
|
||||||
|
|
||||||
(* ;; "If typein, the new selection is a point selection, if from a function e.g. TEDIT.INSERT, the insertion is selected/underlined. TEDIT.INSERT can then apply the looks, if specified.")
|
(\TEDIT.UPDATE.SEL SEL (SUB1 (IPLUS CARETCHNO NCHARSADDED))
|
||||||
|
0
|
||||||
(if TYPEIN
|
'RIGHT
|
||||||
then (\TEDIT.UPDATE.SEL SEL (SUB1 (IPLUS CARETCHNO NCHARSADDED))
|
'NORMAL)
|
||||||
0
|
|
||||||
'RIGHT
|
|
||||||
'NORMAL)
|
|
||||||
else (\TEDIT.UPDATE.SEL SEL CARETCHNO NCHARSADDED 'RIGHT 'NORMAL))
|
|
||||||
(CL:UNLESS DONTSCROLL
|
(CL:UNLESS DONTSCROLL
|
||||||
|
|
||||||
(* ;; "All the panes must be updated. SELPANE mayalso need to be scrolled to make the caret visible for the next input.")
|
(* ;; "All the panes must be updated. SELPANE mayalso need to be scrolled to make the caret visible for the next input.")
|
||||||
@@ -2320,32 +2315,32 @@
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* ; "LISTFILES Interface, so the system can decide if a file is a TEdit file.")
|
(* ; "IMAGETYPE Interface, so the system can decide if a file is a TEdit file.")
|
||||||
|
|
||||||
|
|
||||||
(ADDTOVAR PRINTFILETYPES (TEDIT (TEST \TEDIT.GET.TRAILER)
|
(ADDTOVAR PRINTFILETYPES (TEDIT (TEST TEDIT.FORMATTEDFILEP)
|
||||||
(EXTENSION (TEDIT))))
|
(EXTENSION (TEDIT TED))))
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (4823 7217 (MAKE-TEDIT-EXPORTS.ALL 4833 . 5379) (UPDATE-TEDIT 5381 . 6310) (EDIT-TEDIT
|
(FILEMAP (NIL (4838 7232 (MAKE-TEDIT-EXPORTS.ALL 4848 . 5394) (UPDATE-TEDIT 5396 . 6325) (EDIT-TEDIT
|
||||||
6312 . 7215)) (8647 36705 (TEDIT 8657 . 11271) (TEXTSTREAM 11273 . 13162) (TEXTSTREAMP 13164 . 13548)
|
6327 . 7230)) (8662 36440 (TEDIT 8672 . 11286) (TEXTSTREAM 11288 . 13177) (TEXTSTREAMP 13179 . 13563)
|
||||||
(COERCETEXTSTREAM 13550 . 17761) (TEDIT.CONCAT 17763 . 21065) (TEDITSTRING 21067 . 21981) (TEDIT-SEE
|
(COERCETEXTSTREAM 13565 . 17776) (TEDIT.CONCAT 17778 . 21080) (TEDITSTRING 21082 . 21996) (TEDIT-SEE
|
||||||
21983 . 22542) (TEDIT.COPY 22544 . 24689) (TEDIT.DELETE 24691 . 26052) (TEDIT.INSERT 26054 . 29428) (
|
21998 . 22682) (TEDIT.COPY 22684 . 24829) (TEDIT.DELETE 24831 . 26192) (TEDIT.INSERT 26194 . 29163) (
|
||||||
TEDIT.TERPRI 29430 . 30544) (TEDIT.KILL 30546 . 31528) (TEDIT.QUIT 31530 . 32896) (TEDIT.MOVE 32898 .
|
TEDIT.TERPRI 29165 . 30279) (TEDIT.KILL 30281 . 31263) (TEDIT.QUIT 31265 . 32631) (TEDIT.MOVE 32633 .
|
||||||
33786) (TEDIT.STRINGWIDTH 33788 . 34459) (TEDIT.CHARWIDTH 34461 . 36703)) (36706 38647 (TEXTOBJ 36716
|
33521) (TEDIT.STRINGWIDTH 33523 . 34194) (TEDIT.CHARWIDTH 34196 . 36438)) (36441 38382 (TEXTOBJ 36451
|
||||||
. 37181) (COERCETEXTOBJ 37183 . 38645)) (40047 41697 (TDRIBBLE 40057 . 41695)) (41738 53634 (
|
. 36916) (COERCETEXTOBJ 36918 . 38380)) (39782 41432 (TDRIBBLE 39792 . 41430)) (41473 53369 (
|
||||||
TEDIT.INSERT.OBJECT 41748 . 45455) (TEDIT.EDIT.OBJECT 45457 . 48397) (TEDIT.OBJECT.CHANGED 48399 .
|
TEDIT.INSERT.OBJECT 41483 . 45190) (TEDIT.EDIT.OBJECT 45192 . 48132) (TEDIT.OBJECT.CHANGED 48134 .
|
||||||
51589) (TEDIT.MAP.OBJECTS 51591 . 53162) (\TEDIT.FIRST.OBJPIECE 53164 . 53397) (\TEDIT.NEXT.OBJPIECE
|
51324) (TEDIT.MAP.OBJECTS 51326 . 52897) (\TEDIT.FIRST.OBJPIECE 52899 . 53132) (\TEDIT.NEXT.OBJPIECE
|
||||||
53399 . 53632)) (53657 61100 (\TEDIT.CONCAT.PAGEFRAMES 53667 . 58734) (\TEDIT.GET.PAGE.HEADINGS 58736
|
53134 . 53367)) (53392 60835 (\TEDIT.CONCAT.PAGEFRAMES 53402 . 58469) (\TEDIT.GET.PAGE.HEADINGS 58471
|
||||||
. 59765) (\TEDIT.CONCAT.INSTALL.HEADINGS 59767 . 61098)) (61101 64708 (\TEDIT.MOVE.MSG 61111 . 63192)
|
. 59500) (\TEDIT.CONCAT.INSTALL.HEADINGS 59502 . 60833)) (60836 64443 (\TEDIT.MOVE.MSG 60846 . 62927)
|
||||||
(\TEDIT.READONLY 63194 . 64706)) (64709 70600 (TEDIT.NCHARS 64719 . 65092) (TEDIT.RPLCHARCODE 65094
|
(\TEDIT.READONLY 62929 . 64441)) (64444 70335 (TEDIT.NCHARS 64454 . 64827) (TEDIT.RPLCHARCODE 64829
|
||||||
. 68084) (TEDIT.NTHCHARCODE 68086 . 70129) (TEDIT.NTHCHAR 70131 . 70598)) (70646 127675 (\TEDIT1
|
. 67819) (TEDIT.NTHCHARCODE 67821 . 69864) (TEDIT.NTHCHAR 69866 . 70333)) (70381 127158 (\TEDIT1
|
||||||
70656 . 72733) (\TEDIT.INSERT 72735 . 79100) (\TEDIT.MOVE 79102 . 87008) (\TEDIT.COPY 87010 . 91541) (
|
70391 . 72468) (\TEDIT.INSERT 72470 . 78583) (\TEDIT.MOVE 78585 . 86491) (\TEDIT.COPY 86493 . 91024) (
|
||||||
\TEDIT.REPLACE.SELPIECES 91543 . 96079) (\TEDIT.INSERT.SELPIECES 96081 . 99078) (\TEDIT.RESTARTFN
|
\TEDIT.REPLACE.SELPIECES 91026 . 95562) (\TEDIT.INSERT.SELPIECES 95564 . 98561) (\TEDIT.RESTARTFN
|
||||||
99080 . 101585) (\TEDIT.CHARDELETE 101587 . 104516) (\TEDIT.COPYPIECE 104518 . 109680) (
|
98563 . 101068) (\TEDIT.CHARDELETE 101070 . 103999) (\TEDIT.COPYPIECE 104001 . 109163) (
|
||||||
\TEDIT.APPLY.OBJFN 109682 . 112768) (\TEDIT.DELETE 112770 . 117138) (\TEDIT.DIFFUSE.PARALOOKS 117140
|
\TEDIT.APPLY.OBJFN 109165 . 112251) (\TEDIT.DELETE 112253 . 116621) (\TEDIT.DIFFUSE.PARALOOKS 116623
|
||||||
. 119411) (\TEDIT.WORDDELETE 119413 . 121028) (\TEDIT.WORDDELETE.FORWARD 121030 . 122819) (
|
. 118894) (\TEDIT.WORDDELETE 118896 . 120511) (\TEDIT.WORDDELETE.FORWARD 120513 . 122302) (
|
||||||
\TEDIT.FINISHEDIT? 122821 . 127673)) (127676 128335 (\TEDIT.THELP 127686 . 128333)) (128369 137500 (
|
\TEDIT.FINISHEDIT? 122304 . 127156)) (127159 127818 (\TEDIT.THELP 127169 . 127816)) (127852 136983 (
|
||||||
\TEDIT.PARAPIECES 128379 . 130353) (\TEDIT.PARACHNOS 130355 . 131247) (\TEDIT.PARA.FIRST 131249 .
|
\TEDIT.PARAPIECES 127862 . 129836) (\TEDIT.PARACHNOS 129838 . 130730) (\TEDIT.PARA.FIRST 130732 .
|
||||||
134350) (\TEDIT.PARA.LAST 134352 . 137498)) (137501 144596 (\TEDIT.WORD.FIRST 137511 . 141515) (
|
133833) (\TEDIT.PARA.LAST 133835 . 136981)) (136984 144079 (\TEDIT.WORD.FIRST 136994 . 140998) (
|
||||||
\TEDIT.WORD.LAST 141517 . 144594)) (144797 145074 (TEDITSYSTEMDATE 144807 . 145072)))))
|
\TEDIT.WORD.LAST 141000 . 144077)) (144280 144557 (TEDITSYSTEMDATE 144290 . 144555)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
@@ -1,12 +1,12 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||||
|
|
||||||
(FILECREATED "25-Oct-2025 10:33:08" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;878 230780
|
(FILECREATED "15-Nov-2025 01:27:38" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;881 231034
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS \TEDIT.WINDOW.GETREGION)
|
:CHANGES-TO (FNS \TEDIT.WINDOW.CREATE)
|
||||||
|
|
||||||
:PREVIOUS-DATE "24-Oct-2025 09:11:52" {WMEDLEY}<library>tedit>TEDIT-WINDOW.;874)
|
:PREVIOUS-DATE "25-Oct-2025 10:33:08" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;878)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT TEDIT-WINDOWCOMS)
|
(PRETTYCOMPRINT TEDIT-WINDOWCOMS)
|
||||||
@@ -354,7 +354,8 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(\TEDIT.WINDOW.CREATE
|
(\TEDIT.WINDOW.CREATE
|
||||||
[LAMBDA (WINDOW TSTREAM PROPS) (* ; "Edited 23-Oct-2025 18:22 by rmk")
|
[LAMBDA (WINDOW TSTREAM PROPS) (* ; "Edited 15-Nov-2025 01:27 by rmk")
|
||||||
|
(* ; "Edited 23-Oct-2025 18:22 by rmk")
|
||||||
(* ; "Edited 21-Jul-2025 11:55 by rmk")
|
(* ; "Edited 21-Jul-2025 11:55 by rmk")
|
||||||
(* ; "Edited 9-May-2025 12:11 by rmk")
|
(* ; "Edited 9-May-2025 12:11 by rmk")
|
||||||
(* ; "Edited 25-Apr-2025 21:24 by rmk")
|
(* ; "Edited 25-Apr-2025 21:24 by rmk")
|
||||||
@@ -377,24 +378,26 @@
|
|||||||
|
|
||||||
(LET ((TEXTOBJ (FTEXTOBJ TSTREAM))
|
(LET ((TEXTOBJ (FTEXTOBJ TSTREAM))
|
||||||
(PHEIGHT 0)
|
(PHEIGHT 0)
|
||||||
TITLE REGIONTYPE PROMPTPROP REGION FILE PWINDOW PREPROMPT WTEXTOBJ)
|
REGIONTYPE PROMPTPROP REGION FILE PWINDOW PREPROMPT)
|
||||||
|
(SETQ FILE (GETTOBJ TEXTOBJ TXTFILE))
|
||||||
(CL:WHEN (WINDOWP WINDOW)
|
(CL:WHEN (WINDOWP WINDOW)
|
||||||
(CL:WHEN (GETTSTR (fetch (TEXTWINDOW WTEXTSTREAM) of WINDOW)
|
(CL:WHEN (GETTSTR (fetch (TEXTWINDOW WTEXTSTREAM) of WINDOW)
|
||||||
TEXTOBJ)
|
TEXTOBJ)
|
||||||
|
|
||||||
(* ;; " %"Reusing an existing Tedit window, kill the old process, undo its splits and restore its shape.%" ")
|
(* ;; " %"Reusing an existing Tedit window, kill the old process, undo its splits and restore its shape. Make sure it has a title%" ")
|
||||||
|
|
||||||
(TEDIT.KILL WINDOW)
|
(TEDIT.KILL WINDOW)
|
||||||
(\TEDIT.CLOSESPLITS (fetch (TEXTWINDOW WTEXTSTREAM) of WINDOW)
|
(\TEDIT.CLOSESPLITS (fetch (TEXTWINDOW WTEXTSTREAM) of WINDOW)
|
||||||
T))
|
T))
|
||||||
[SETQ TITLE (OR (LISTGET PROPS 'TITLE)
|
|
||||||
(WINDOWPROP WINDOW 'TITLE])
|
(* ;; "Every tedit window has a title bar, maybe one that it had already?")
|
||||||
|
|
||||||
|
(WINDOWPROP WINDOW 'TITLE (OR (LISTGET PROPS 'TITLE)
|
||||||
|
(WINDOWPROP WINDOW 'TITLE)
|
||||||
|
(\TEDIT.DEFAULT.TITLE FILE PROPS))))
|
||||||
(SETQ REGIONTYPE (OR (GETTEXTPROP TEXTOBJ 'REGION-TYPE)
|
(SETQ REGIONTYPE (OR (GETTEXTPROP TEXTOBJ 'REGION-TYPE)
|
||||||
(AND (LITATOM WINDOW)
|
(AND (LITATOM WINDOW)
|
||||||
WINDOW)))
|
WINDOW)))
|
||||||
(SETQ FILE (GETTOBJ TEXTOBJ TXTFILE))
|
|
||||||
(CL:UNLESS TITLE
|
|
||||||
(SETQ TITLE (\TEDIT.DEFAULT.TITLE FILE PROPS)))
|
|
||||||
(SETQ PROMPTPROP (GETTEXTPROP TEXTOBJ 'PROMPTWINDOW))
|
(SETQ PROMPTPROP (GETTEXTPROP TEXTOBJ 'PROMPTWINDOW))
|
||||||
|
|
||||||
(* ;; "All this prompt-height calculation would be unnecessary if the attachment in GETPROMPTWINDOW does the proper shrinking of the main window.")
|
(* ;; "All this prompt-height calculation would be unnecessary if the attachment in GETPROMPTWINDOW does the proper shrinking of the main window.")
|
||||||
@@ -421,7 +424,8 @@
|
|||||||
REGION))
|
REGION))
|
||||||
(add (fetch (REGION HEIGHT) of REGION)
|
(add (fetch (REGION HEIGHT) of REGION)
|
||||||
(IMINUS PHEIGHT))
|
(IMINUS PHEIGHT))
|
||||||
(SETQ WINDOW (CREATEW REGION TITLE NIL NIL PROPS))
|
(SETQ WINDOW (CREATEW REGION (\TEDIT.DEFAULT.TITLE FILE PROPS)
|
||||||
|
NIL NIL PROPS))
|
||||||
|
|
||||||
(* ;; "If we grabbed a typed-region, (maybe just a Tedit region by default. We stash it back onto the window so it will be remembered for next time.")
|
(* ;; "If we grabbed a typed-region, (maybe just a Tedit region by default. We stash it back onto the window so it will be remembered for next time.")
|
||||||
|
|
||||||
@@ -451,7 +455,6 @@
|
|||||||
|
|
||||||
(FSETTOBJ TEXTOBJ PRIMARYPANE (\TEDIT.MINIMAL.WINDOW.SETUP WINDOW TSTREAM PROPS))
|
(FSETTOBJ TEXTOBJ PRIMARYPANE (\TEDIT.MINIMAL.WINDOW.SETUP WINDOW TSTREAM PROPS))
|
||||||
(* ; "This should be PANE")
|
(* ; "This should be PANE")
|
||||||
(WINDOWPROP WINDOW 'TITLE TITLE)
|
|
||||||
WINDOW])
|
WINDOW])
|
||||||
|
|
||||||
(\TEDIT.WINDOW.GETREGION
|
(\TEDIT.WINDOW.GETREGION
|
||||||
@@ -3659,36 +3662,36 @@
|
|||||||
(RPAQ? TEDIT.TITLED.ICON.TEMPLATE (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _
|
(RPAQ? TEDIT.TITLED.ICON.TEMPLATE (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _
|
||||||
TEDIT.ICON.TITLE.REGION))
|
TEDIT.ICON.TITLE.REGION))
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (17103 17999 (TEDIT.DEFER.UPDATES 17113 . 17997)) (18000 44835 (\TEDIT.WINDOW.CREATE
|
(FILEMAP (NIL (17100 17996 (TEDIT.DEFER.UPDATES 17110 . 17994)) (17997 45089 (\TEDIT.WINDOW.CREATE
|
||||||
18010 . 24616) (\TEDIT.WINDOW.GETREGION 24618 . 29322) (\TEDIT.WINDOW.SETUP 29324 . 33654) (
|
18007 . 24870) (\TEDIT.WINDOW.GETREGION 24872 . 29576) (\TEDIT.WINDOW.SETUP 29578 . 33908) (
|
||||||
\TEDIT.MINIMAL.WINDOW.SETUP 33656 . 41467) (\TEDIT.CLEARPANE 41469 . 42186) (\TEDIT.FILL.PANES 42188
|
\TEDIT.MINIMAL.WINDOW.SETUP 33910 . 41721) (\TEDIT.CLEARPANE 41723 . 42440) (\TEDIT.FILL.PANES 42442
|
||||||
. 44833)) (44836 68537 (\TEDIT.CURSORMOVEDFN 44846 . 50456) (\TEDIT.CURSOROUTFN 50458 . 51146) (
|
. 45087)) (45090 68791 (\TEDIT.CURSORMOVEDFN 45100 . 50710) (\TEDIT.CURSOROUTFN 50712 . 51400) (
|
||||||
\TEDIT.ACTIVE.WINDOWP 51148 . 52218) (\TEDIT.EXPANDFN 52220 . 52783) (\TEDIT.MAINW 52785 . 54065) (
|
\TEDIT.ACTIVE.WINDOWP 51402 . 52472) (\TEDIT.EXPANDFN 52474 . 53037) (\TEDIT.MAINW 53039 . 54319) (
|
||||||
\TEDIT.MAINSTREAM 54067 . 54401) (\TEDIT.PRIMARYPANE 54403 . 55173) (\TEDIT.PANELIST 55175 . 55671) (
|
\TEDIT.MAINSTREAM 54321 . 54655) (\TEDIT.PRIMARYPANE 54657 . 55427) (\TEDIT.PANELIST 55429 . 55925) (
|
||||||
\TEDIT.NEWREGIONFN 55673 . 58189) (\TEDIT.SET.WINDOW.EXTENT 58191 . 63173) (\TEDIT.SHRINK.ICONCREATE
|
\TEDIT.NEWREGIONFN 55927 . 58443) (\TEDIT.SET.WINDOW.EXTENT 58445 . 63427) (\TEDIT.SHRINK.ICONCREATE
|
||||||
63175 . 65908) (\TEDIT.SHRINKFN 65910 . 66319) (\TEDIT.PANEREGION 66321 . 68535)) (68569 101615 (
|
63429 . 66162) (\TEDIT.SHRINKFN 66164 . 66573) (\TEDIT.PANEREGION 66575 . 68789)) (68823 101869 (
|
||||||
\TEDIT.BUTTONEVENTFN 68579 . 81552) (\TEDIT.BUTTONEVENTFN.DOOPERATION 81554 . 88817) (
|
\TEDIT.BUTTONEVENTFN 68833 . 81806) (\TEDIT.BUTTONEVENTFN.DOOPERATION 81808 . 89071) (
|
||||||
\TEDIT.BUTTONEVENTFN.GETOPERATION 88819 . 90661) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 90663 . 94333) (
|
\TEDIT.BUTTONEVENTFN.GETOPERATION 89073 . 90915) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 90917 . 94587) (
|
||||||
\TEDIT.BUTTONEVENTFN.INACTIVE 94335 . 96765) (\TEDIT.BUTTONEVENTFN.INTITLE 96767 . 98602) (
|
\TEDIT.BUTTONEVENTFN.INACTIVE 94589 . 97019) (\TEDIT.BUTTONEVENTFN.INTITLE 97021 . 98856) (
|
||||||
\TEDIT.COPYINSERTFN 98604 . 99736) (\TEDIT.FOREIGN.COPY 99738 . 101613)) (101616 119179 (
|
\TEDIT.COPYINSERTFN 98858 . 99990) (\TEDIT.FOREIGN.COPY 99992 . 101867)) (101870 119433 (
|
||||||
\TEDIT.PANE.SPLIT 101626 . 105574) (\TEDIT.SPLITW 105576 . 113635) (\TEDIT.UNSPLITW 113637 . 117836) (
|
\TEDIT.PANE.SPLIT 101880 . 105828) (\TEDIT.SPLITW 105830 . 113889) (\TEDIT.UNSPLITW 113891 . 118090) (
|
||||||
\TEDIT.LINKPANES 117838 . 118601) (\TEDIT.UNLINKPANE 118603 . 119177)) (120613 121504 (TEDITWINDOWP
|
\TEDIT.LINKPANES 118092 . 118855) (\TEDIT.UNLINKPANE 118857 . 119431)) (120867 121758 (TEDITWINDOWP
|
||||||
120623 . 121502)) (121541 124644 (TEDIT.GETINPUT 121551 . 123994) (\TEDIT.MAKEFILENAME 123996 . 124642
|
120877 . 121756)) (121795 124898 (TEDIT.GETINPUT 121805 . 124248) (\TEDIT.MAKEFILENAME 124250 . 124896
|
||||||
)) (124693 132343 (TEDIT.PROMPTWINDOW 124703 . 125017) (TEDIT.PROMPTPRINT 125019 . 127646) (
|
)) (124947 132597 (TEDIT.PROMPTWINDOW 124957 . 125271) (TEDIT.PROMPTPRINT 125273 . 127900) (
|
||||||
TEDIT.PROMPTCLEAR 127648 . 129390) (TEDIT.PROMPTFLASH 129392 . 130650) (\TEDIT.PROMPT.PAGEFULLFN
|
TEDIT.PROMPTCLEAR 127902 . 129644) (TEDIT.PROMPTFLASH 129646 . 130904) (\TEDIT.PROMPT.PAGEFULLFN
|
||||||
130652 . 132341)) (132581 143159 (\TEDIT.FILENAME 132591 . 133363) (\TEDIT.DEFAULT.TITLE 133365 .
|
130906 . 132595)) (132835 143413 (\TEDIT.FILENAME 132845 . 133617) (\TEDIT.DEFAULT.TITLE 133619 .
|
||||||
135744) (\TEDIT.WINDOW.TITLE 135746 . 137915) (\TEDIT.LIKELY.FILENAME 137917 . 140641) (
|
135998) (\TEDIT.WINDOW.TITLE 136000 . 138169) (\TEDIT.LIKELY.FILENAME 138171 . 140895) (
|
||||||
\TEDIT.UPDATE.TITLE 140643 . 143157)) (143202 155686 (TEDIT.DEACTIVATE.WINDOW 143212 . 148785) (
|
\TEDIT.UPDATE.TITLE 140897 . 143411)) (143456 155940 (TEDIT.DEACTIVATE.WINDOW 143466 . 149039) (
|
||||||
\TEDIT.RESHAPEFN 148787 . 150872) (\TEDIT.REPAINTFN 150874 . 151098) (\TEDIT.CLOSESPLITS 151100 .
|
\TEDIT.RESHAPEFN 149041 . 151126) (\TEDIT.REPAINTFN 151128 . 151352) (\TEDIT.CLOSESPLITS 151354 .
|
||||||
153545) (\TEDIT.CLOSEPANE 153547 . 155684)) (155687 198486 (\TEDIT.SCROLLFN 155697 . 157928) (
|
153799) (\TEDIT.CLOSEPANE 153801 . 155938)) (155941 198740 (\TEDIT.SCROLLFN 155951 . 158182) (
|
||||||
\TEDIT.SCROLLCH.TOP 157930 . 160041) (\TEDIT.SCROLLCH.BOTTOM 160043 . 164373) (\TEDIT.SCROLLUP 164375
|
\TEDIT.SCROLLCH.TOP 158184 . 160295) (\TEDIT.SCROLLCH.BOTTOM 160297 . 164627) (\TEDIT.SCROLLUP 164629
|
||||||
. 170101) (\TEDIT.TOPLINE.YTOP 170103 . 171772) (\TEDIT.SCROLLDOWN 171774 . 178813) (
|
. 170355) (\TEDIT.TOPLINE.YTOP 170357 . 172026) (\TEDIT.SCROLLDOWN 172028 . 179067) (
|
||||||
\TEDIT.SCROLL.CARET 178815 . 181653) (\TEDIT.VISIBLECARETP 181655 . 183949) (\TEDIT.VISIBLECHARP
|
\TEDIT.SCROLL.CARET 179069 . 181907) (\TEDIT.VISIBLECARETP 181909 . 184203) (\TEDIT.VISIBLECHARP
|
||||||
183951 . 185042) (\TEDIT.BITMAPLINES 185044 . 188964) (\TEDIT.SETPANE.TOPLINE 188966 . 189578) (
|
184205 . 185296) (\TEDIT.BITMAPLINES 185298 . 189218) (\TEDIT.SETPANE.TOPLINE 189220 . 189832) (
|
||||||
\TEDIT.SHIFTLINES 189580 . 198484)) (198487 209356 (\TEDIT.ONSCREEN? 198497 . 203048) (
|
\TEDIT.SHIFTLINES 189834 . 198738)) (198741 209610 (\TEDIT.ONSCREEN? 198751 . 203302) (
|
||||||
\TEDIT.ONSCREEN.REGION 203050 . 206701) (\TEDIT.AFTERMOVEFN 206703 . 207600) (OFFSCREENP 207602 .
|
\TEDIT.ONSCREEN.REGION 203304 . 206955) (\TEDIT.AFTERMOVEFN 206957 . 207854) (OFFSCREENP 207856 .
|
||||||
209354)) (209398 212212 (\TEDIT.PROCIDLEFN 209408 . 211068) (\TEDIT.PROCENTRYFN 211070 . 211515) (
|
209608)) (209652 212466 (\TEDIT.PROCIDLEFN 209662 . 211322) (\TEDIT.PROCENTRYFN 211324 . 211769) (
|
||||||
\TEDIT.PROCEXITFN 211517 . 212210)) (212291 225516 (\TEDIT.DOWNCARET 212301 . 213094) (
|
\TEDIT.PROCEXITFN 211771 . 212464)) (212545 225770 (\TEDIT.DOWNCARET 212555 . 213348) (
|
||||||
\TEDIT.FLASHCARET 213096 . 215207) (\TEDIT.UPCARET 215209 . 216313) (TEDIT.NORMALIZECARET 216315 .
|
\TEDIT.FLASHCARET 213350 . 215461) (\TEDIT.UPCARET 215463 . 216567) (TEDIT.NORMALIZECARET 216569 .
|
||||||
219533) (\TEDIT.SETCARET 219535 . 224886) (\TEDIT.CARET 224888 . 225514)))))
|
219787) (\TEDIT.SETCARET 219789 . 225140) (\TEDIT.CARET 225142 . 225768)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
Binary file not shown.
@@ -1,12 +1,12 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||||
|
|
||||||
(FILECREATED "28-Jul-2023 09:49:24" {DSK}<home>larry>il>medley>lispusers>BACKGROUND-YIELD.;2 1770
|
(FILECREATED " 9-Nov-2025 11:52:07" {DSK}<Users>larry>il>MEDLEY>LISPUSERS>BACKGROUND-YIELD.;2 1882
|
||||||
|
|
||||||
:EDIT-BY "lmm"
|
:EDIT-BY "lmm"
|
||||||
|
|
||||||
:CHANGES-TO (FNS BACKGROUND-YIELD)
|
:CHANGES-TO (FNS BACKGROUND-YIELD)
|
||||||
|
|
||||||
:PREVIOUS-DATE "14-Nov-2021 22:05:58" {DSK}<home>larry>il>medley>lispusers>BACKGROUND-YIELD.;1
|
:PREVIOUS-DATE "28-Jul-2023 09:49:24" {DSK}<Users>larry>il>MEDLEY>LISPUSERS>BACKGROUND-YIELD.;1
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
@@ -26,13 +26,14 @@
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(BACKGROUND-YIELD
|
(BACKGROUND-YIELD
|
||||||
[LAMBDA NIL (* ; "Edited 28-Jul-2023 09:11 by lmm")
|
[LAMBDA NIL (* ; "Edited 9-Nov-2025 11:50 by lmm")
|
||||||
|
(* ; "Edited 28-Jul-2023 09:11 by lmm")
|
||||||
(* ; "Edited 20-Sep-2021 11:37 by larry")
|
(* ; "Edited 20-Sep-2021 11:37 by larry")
|
||||||
(LET ((\BACKGROUND T))
|
(LET ((\BACKGROUND T))
|
||||||
(DECLARE (SPECVARS \BACKGROUND))
|
(DECLARE (SPECVARS \BACKGROUND)
|
||||||
|
(GLOBALVARS BACKGROUND-YIELD))
|
||||||
(IF (FIXP BACKGROUND-YIELD)
|
(IF (FIXP BACKGROUND-YIELD)
|
||||||
THEN (SUBRCALL YIELD BACKGROUND-YIELD)
|
THEN (SUBRCALL YIELD BACKGROUND-YIELD])
|
||||||
(SUBRCALL CAUSE-INTERRUPT])
|
|
||||||
|
|
||||||
(INIT-YIELD
|
(INIT-YIELD
|
||||||
[LAMBDA (ONP) (* ; "Edited 19-Sep-2021 13:32 by larry")
|
[LAMBDA (ONP) (* ; "Edited 19-Sep-2021 13:32 by larry")
|
||||||
@@ -51,5 +52,5 @@
|
|||||||
|
|
||||||
(RPAQQ BACKGROUND-YIELD 833333)
|
(RPAQQ BACKGROUND-YIELD 833333)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (806 1655 (BACKGROUND-YIELD 816 . 1271) (INIT-YIELD 1273 . 1653)))))
|
(FILEMAP (NIL (808 1767 (BACKGROUND-YIELD 818 . 1383) (INIT-YIELD 1385 . 1765)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||||
|
|
||||||
(FILECREATED "25-Oct-2025 23:59:24" {MEDLEY}<lispusers>COMPAREDIRECTORIES.;2 135376
|
(FILECREATED " 8-Nov-2025 13:07:39" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;285 138536
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS CDBROWSER-COPY)
|
:CHANGES-TO (FNS CD-MENUFN CDBROWSER-COPY)
|
||||||
|
|
||||||
:PREVIOUS-DATE "22-Oct-2025 08:32:01" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;272)
|
:PREVIOUS-DATE "28-Oct-2025 14:52:05" {WMEDLEY}<lispusers>COMPAREDIRECTORIES.;280)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT COMPAREDIRECTORIESCOMS)
|
(PRETTYCOMPRINT COMPAREDIRECTORIESCOMS)
|
||||||
@@ -1707,6 +1707,8 @@
|
|||||||
(CDBROWSER
|
(CDBROWSER
|
||||||
[LAMBDA (CDVALUE TITLE COLHEADINGS BROWSERPROPS SEPARATEDIRECTIONS MENUITEMS)
|
[LAMBDA (CDVALUE TITLE COLHEADINGS BROWSERPROPS SEPARATEDIRECTIONS MENUITEMS)
|
||||||
|
|
||||||
|
(* ;; "Edited 28-Oct-2025 14:49 by rmk")
|
||||||
|
|
||||||
(* ;; "Edited 28-Jan-2022 17:01 by rmk: a table browser for the differences in CDVALUE.")
|
(* ;; "Edited 28-Jan-2022 17:01 by rmk: a table browser for the differences in CDVALUE.")
|
||||||
|
|
||||||
(* ;; "Creates a table browser for the differences in CDVALUE.")
|
(* ;; "Creates a table browser for the differences in CDVALUE.")
|
||||||
@@ -1752,7 +1754,7 @@
|
|||||||
[SETQ BROWSER (TB.MAKE.BROWSER (FOR PAIR IN STRINGS COLLECT (CD.TABLEITEM PAIR))
|
[SETQ BROWSER (TB.MAKE.BROWSER (FOR PAIR IN STRINGS COLLECT (CD.TABLEITEM PAIR))
|
||||||
WINDOW
|
WINDOW
|
||||||
`(PRINTFN CD.TABLEITEM.PRINTFN COPYFN CD.TABLEITEM.COPYFN USERDATA
|
`(PRINTFN CD.TABLEITEM.PRINTFN COPYFN CD.TABLEITEM.COPYFN USERDATA
|
||||||
,(APPEND BROWSERPROPS (LIST 'CDVALUE CDVALUE]
|
(,@BROWSERPROPS (CDVALUE ,@CDVALUE]
|
||||||
(ATTACHMENU (CREATE MENU
|
(ATTACHMENU (CREATE MENU
|
||||||
TITLE _ " CD commands "
|
TITLE _ " CD commands "
|
||||||
MENUFONT _ DEFAULTFONT
|
MENUFONT _ DEFAULTFONT
|
||||||
@@ -1893,7 +1895,8 @@
|
|||||||
'DON'T])
|
'DON'T])
|
||||||
|
|
||||||
(CD.COMMANDSELECTEDFN
|
(CD.COMMANDSELECTEDFN
|
||||||
[LAMBDA (MENUITEM MENU KEY) (* ; "Edited 6-Mar-2022 19:52 by rmk")
|
[LAMBDA (MENUITEM MENU KEY) (* ; "Edited 28-Oct-2025 14:34 by rmk")
|
||||||
|
(* ; "Edited 6-Mar-2022 19:52 by rmk")
|
||||||
(* ; "Edited 24-Feb-2022 19:52 by rmk")
|
(* ; "Edited 24-Feb-2022 19:52 by rmk")
|
||||||
(* ; "Edited 5-Feb-2022 17:23 by rmk")
|
(* ; "Edited 5-Feb-2022 17:23 by rmk")
|
||||||
(* ; "Edited 27-Jan-2022 17:46 by rmk")
|
(* ; "Edited 27-Jan-2022 17:46 by rmk")
|
||||||
@@ -1944,7 +1947,8 @@
|
|||||||
(LABEL1 (OR (CAR LABELS)
|
(LABEL1 (OR (CAR LABELS)
|
||||||
FILE1))
|
FILE1))
|
||||||
(LABEL2 (OR (CADR LABELS)
|
(LABEL2 (OR (CADR LABELS)
|
||||||
FILE2)))
|
FILE2))
|
||||||
|
TEMP)
|
||||||
(DECLARE (SPECVARS . T))
|
(DECLARE (SPECVARS . T))
|
||||||
|
|
||||||
(* ;;
|
(* ;;
|
||||||
@@ -1958,6 +1962,16 @@
|
|||||||
OF (FETCH (CDENTRY INFO2)
|
OF (FETCH (CDENTRY INFO2)
|
||||||
OF CDENTRY)))
|
OF CDENTRY)))
|
||||||
(SETQ FILE2 NIL))
|
(SETQ FILE2 NIL))
|
||||||
|
(CL:WHEN (SETQ TEMP (SGETMULTI (fetch (TABLEBROWSER
|
||||||
|
TBUSERDATA)
|
||||||
|
of CDBROWSER)
|
||||||
|
'ORIGINALFILES FILE1))
|
||||||
|
(SETQ FILE1 TEMP))
|
||||||
|
(CL:WHEN (SETQ TEMP (SGETMULTI (fetch (TABLEBROWSER
|
||||||
|
TBUSERDATA)
|
||||||
|
of CDBROWSER)
|
||||||
|
'ORIGINALFILES FILE2))
|
||||||
|
(SETQ FILE2 TEMP))
|
||||||
|
|
||||||
(* ;; "If USERDATA contains a LABELFN, then it is applied to the files and the rest of the USERDATA to produce abbreviated labels for titles and headers.")
|
(* ;; "If USERDATA contains a LABELFN, then it is applied to the files and the rest of the USERDATA to produce abbreviated labels for titles and headers.")
|
||||||
|
|
||||||
@@ -1969,6 +1983,10 @@
|
|||||||
(CD-MENUFN
|
(CD-MENUFN
|
||||||
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY)
|
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY)
|
||||||
|
|
||||||
|
(* ;; "Edited 8-Nov-2025 13:06 by rmk")
|
||||||
|
|
||||||
|
(* ;; "Edited 28-Oct-2025 17:35 by rmk")
|
||||||
|
|
||||||
(* ;; "Edited 26-Mar-2025 09:39 by rmk")
|
(* ;; "Edited 26-Mar-2025 09:39 by rmk")
|
||||||
|
|
||||||
(* ;; "Edited 18-Feb-2025 23:36 by rmk")
|
(* ;; "Edited 18-Feb-2025 23:36 by rmk")
|
||||||
@@ -1996,7 +2014,8 @@
|
|||||||
(Compare (IF (AND FILE1 FILE2)
|
(Compare (IF (AND FILE1 FILE2)
|
||||||
THEN (CD-COMPARE-FILES FILE1 FILE2 LABEL1 LABEL2 TYPE (WINDOWPROP
|
THEN (CD-COMPARE-FILES FILE1 FILE2 LABEL1 LABEL2 TYPE (WINDOWPROP
|
||||||
WINDOW
|
WINDOW
|
||||||
'REGION))
|
'REGION)
|
||||||
|
CDBROWSER)
|
||||||
ELSE (FLASHWINDOW T)
|
ELSE (FLASHWINDOW T)
|
||||||
(PRIN3 "Only one file" T)))
|
(PRIN3 "Only one file" T)))
|
||||||
(See% left (IF FILE1
|
(See% left (IF FILE1
|
||||||
@@ -2060,18 +2079,20 @@
|
|||||||
NIL))))
|
NIL))))
|
||||||
(Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT))
|
(Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT))
|
||||||
(Copy% <- (CDBROWSER-COPY CDBROWSER TBITEM 'RIGHT))
|
(Copy% <- (CDBROWSER-COPY CDBROWSER TBITEM 'RIGHT))
|
||||||
(Delete% <- (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT T))
|
(Delete% <- (CDBROWSER-DELETE-FILE CDBROWSER TBITEM KEY 'LEFT T))
|
||||||
(|Delete ALL <-|
|
(|Delete ALL <-|
|
||||||
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'LEFT NIL))
|
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM KEY 'LEFT NIL))
|
||||||
(Delete% -> (CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT T))
|
(Delete% -> (CDBROWSER-DELETE-FILE CDBROWSER TBITEM KEY 'RIGHT T))
|
||||||
(|Delete ALL ->|
|
(|Delete ALL ->|
|
||||||
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM 'RIGHT NIL))
|
(CDBROWSER-DELETE-FILE CDBROWSER TBITEM KEY 'RIGHT NIL))
|
||||||
(SHOULDNT)))
|
(SHOULDNT)))
|
||||||
(CLOSEWITH CHILDREN WINDOW)
|
(CLOSEWITH CHILDREN WINDOW)
|
||||||
(MOVEWITH CHILDREN WINDOW])
|
(MOVEWITH CHILDREN WINDOW])
|
||||||
|
|
||||||
(CD-COMPARE-FILES
|
(CD-COMPARE-FILES
|
||||||
[LAMBDA (FILE1 FILE2 LABEL1 LABEL2 TYPE PARENTREGION) (* ; "Edited 22-May-2022 14:41 by rmk")
|
[LAMBDA (FILE1 FILE2 LABEL1 LABEL2 TYPE PARENTREGION CDBROWSER)
|
||||||
|
(* ; "Edited 28-Oct-2025 10:42 by rmk")
|
||||||
|
(* ; "Edited 22-May-2022 14:41 by rmk")
|
||||||
(PROG NIL
|
(PROG NIL
|
||||||
(SETQ FILE1 (OR (STREAMP FILE1)
|
(SETQ FILE1 (OR (STREAMP FILE1)
|
||||||
(INFILEP FILE1)))
|
(INFILEP FILE1)))
|
||||||
@@ -2094,7 +2115,7 @@
|
|||||||
`(,PARENTREGION 0.125)
|
`(,PARENTREGION 0.125)
|
||||||
(IPLUS (FETCH (REGION BOTTOM) OF PARENTREGION
|
(IPLUS (FETCH (REGION BOTTOM) OF PARENTREGION
|
||||||
)
|
)
|
||||||
20)
|
70)
|
||||||
NIL))))
|
NIL))))
|
||||||
(COMPILED (FLASHWINDOW T)
|
(COMPILED (FLASHWINDOW T)
|
||||||
(PRIN3 "Cannot compare compiled files" T))
|
(PRIN3 "Cannot compare compiled files" T))
|
||||||
@@ -2123,7 +2144,8 @@
|
|||||||
NIL])
|
NIL])
|
||||||
|
|
||||||
(CDBROWSER-COPY
|
(CDBROWSER-COPY
|
||||||
[LAMBDA (CDBROWSER TBITEM SOURCE UNIXDEST) (* ; "Edited 25-Oct-2025 23:58 by rmk")
|
[LAMBDA (CDBROWSER TBITEM SOURCE UNIXDEST) (* ; "Edited 28-Oct-2025 17:39 by rmk")
|
||||||
|
(* ; "Edited 25-Oct-2025 23:58 by rmk")
|
||||||
(* ; "Edited 24-May-2022 15:49 by rmk")
|
(* ; "Edited 24-May-2022 15:49 by rmk")
|
||||||
(* ; "Edited 25-Apr-2022 09:24 by rmk")
|
(* ; "Edited 25-Apr-2022 09:24 by rmk")
|
||||||
(* ; "Edited 5-Feb-2022 17:27 by rmk")
|
(* ; "Edited 5-Feb-2022 17:27 by rmk")
|
||||||
@@ -2137,7 +2159,7 @@
|
|||||||
(* ;; "Returns NIL if the copy fails.")
|
(* ;; "Returns NIL if the copy fails.")
|
||||||
|
|
||||||
(CL:UNLESS (TB.ITEM.DELETED? CDBROWSER TBITEM)
|
(CL:UNLESS (TB.ITEM.DELETED? CDBROWSER TBITEM)
|
||||||
(PROG* ((CDVALUE (LISTGET (TB.USERDATA CDBROWSER)
|
(PROG* ((CDVALUE (GETMULTI (TB.USERDATA CDBROWSER)
|
||||||
'CDVALUE))
|
'CDVALUE))
|
||||||
(SOURCEDIR (FETCH (CDVALUE CDDIR1) OF CDVALUE))
|
(SOURCEDIR (FETCH (CDVALUE CDDIR1) OF CDVALUE))
|
||||||
(DESTDIR (FETCH (CDVALUE CDDIR2) OF CDVALUE))
|
(DESTDIR (FETCH (CDVALUE CDDIR2) OF CDVALUE))
|
||||||
@@ -2178,7 +2200,9 @@
|
|||||||
(CL:UNLESS DESTFILE
|
(CL:UNLESS DESTFILE
|
||||||
(SETQ DESTFILE (CD-SWAPDIRS SOURCEFILE SOURCEDIR DESTDIR)))
|
(SETQ DESTFILE (CD-SWAPDIRS SOURCEFILE SOURCEDIR DESTDIR)))
|
||||||
[SETQ RESULT (if UNIXDEST
|
[SETQ RESULT (if UNIXDEST
|
||||||
then [PSEUDOFILENAME (PACKFILENAME 'HOST 'DSK 'BODY
|
then (SPUTMULTI (fetch (TABLEBROWSER TBUSERDATA) of CDBROWSER)
|
||||||
|
'ORIGINALFILES DESTFILE (COPYFILE DESTFILE '{NODIRCORE))
|
||||||
|
[PSEUDOFILENAME (PACKFILENAME 'HOST 'DSK 'BODY
|
||||||
(COPYFILE SOURCEFILE (PACKFILENAME
|
(COPYFILE SOURCEFILE (PACKFILENAME
|
||||||
'HOST
|
'HOST
|
||||||
'UNIX
|
'UNIX
|
||||||
@@ -2197,7 +2221,8 @@
|
|||||||
(RETURN RESULT)))])
|
(RETURN RESULT)))])
|
||||||
|
|
||||||
(CDBROWSER-DELETE-FILE
|
(CDBROWSER-DELETE-FILE
|
||||||
[LAMBDA (CDBROWSER TBITEM SIDE ONLYONE SAVE) (* ; "Edited 25-Apr-2022 09:06 by rmk")
|
[LAMBDA (CDBROWSER TBITEM KEY SIDE ONLYONE SAVE DONTMARK) (* ; "Edited 28-Oct-2025 13:30 by rmk")
|
||||||
|
(* ; "Edited 25-Apr-2022 09:06 by rmk")
|
||||||
(* ; "Edited 5-Feb-2022 17:46 by rmk")
|
(* ; "Edited 5-Feb-2022 17:46 by rmk")
|
||||||
(* ; "Edited 18-Jan-2022 23:02 by rmk")
|
(* ; "Edited 18-Jan-2022 23:02 by rmk")
|
||||||
(* ; "Edited 19-Dec-2021 23:33 by rmk")
|
(* ; "Edited 19-Dec-2021 23:33 by rmk")
|
||||||
@@ -2210,38 +2235,58 @@
|
|||||||
|
|
||||||
(* ;; "If SAVE, then the files are renamed to a deleted directory, not actually expunged, so that they can be restored if needed. The deleted directory is defined by sticking deleted> on the front of FILE's directory.")
|
(* ;; "If SAVE, then the files are renamed to a deleted directory, not actually expunged, so that they can be restored if needed. The deleted directory is defined by sticking deleted> on the front of FILE's directory.")
|
||||||
|
|
||||||
|
(DECLARE (USEDFREE LABEL1 LABEL2 PWINDOW))
|
||||||
(CL:UNLESS (TB.ITEM.DELETED? CDBROWSER TBITEM)
|
(CL:UNLESS (TB.ITEM.DELETED? CDBROWSER TBITEM)
|
||||||
[LET ((CDENTRY (CADR (FETCH TIDATA OF TBITEM)))
|
[LET
|
||||||
FILE OTHERFILE)
|
((CDENTRY (CADR (fetch TIDATA of TBITEM)))
|
||||||
(SETQ FILE (FETCH (CDINFO FULLNAME) OF (FETCH (CDENTRY INFO1) OF CDENTRY)))
|
FILE OTHERFILE DELFILES)
|
||||||
(SETQ OTHERFILE (FETCH (CDINFO FULLNAME) OF (FETCH (CDENTRY INFO2) OF CDENTRY)))
|
(SETQ FILE (fetch (CDINFO FULLNAME) of (fetch (CDENTRY INFO1) of CDENTRY)))
|
||||||
(CL:WHEN (EQ SIDE 'RIGHT)
|
(SETQ OTHERFILE (fetch (CDINFO FULLNAME) of (fetch (CDENTRY INFO2) of CDENTRY)))
|
||||||
(SWAP FILE OTHERFILE))
|
(CL:WHEN (EQ SIDE 'RIGHT)
|
||||||
(CL:WHEN FILE
|
(SWAP FILE OTHERFILE)
|
||||||
(FOR F INSIDE (IF (FILENAMEFIELD.STRING FILE 'VERSION)
|
(SWAP LABEL1 LABEL2))
|
||||||
THEN [IF ONLYONE
|
(SETQ DELFILES (if (FILENAMEFIELD.STRING FILE 'VERSION)
|
||||||
THEN FILE
|
then [if ONLYONE
|
||||||
ELSE (DREVERSE (FILDIR (PACKFILENAME.STRING 'VERSION "*"
|
then (MKLIST FILE)
|
||||||
'BODY FILE]
|
else (DREVERSE (FILDIR (PACKFILENAME.STRING 'VERSION "*"
|
||||||
ELSE FILE)
|
'BODY FILE]
|
||||||
COLLECT
|
else FILE))
|
||||||
|
(CL:WHEN DELFILES
|
||||||
|
(GIVE.TTY.PROCESS PWINDOW)
|
||||||
|
(CLEARW T)
|
||||||
|
(FLASHWINDOW T)
|
||||||
|
(CL:WHEN [OR (EQ KEY 'MIDDLE)
|
||||||
|
(EQ 'Y (ASKUSER NIL 'N (CONCAT "Delete " (CL:IF (CDR DELFILES)
|
||||||
|
"ALL versions of "
|
||||||
|
"")
|
||||||
|
LABEL1 " ? "]
|
||||||
|
(for F in DELFILES
|
||||||
|
collect
|
||||||
|
|
||||||
(* ;; "Delete the earlier ones first, if it goes bad, you don't want them to persist. This preserves the original version numbers, maybe it should start fresh from 1 (or from whatever might have been deleted before).")
|
(* ;; "Delete the earlier ones first, if it goes bad, you don't want them to persist. This preserves the original version numbers, maybe it should start fresh from 1 (or from whatever might have been deleted before).")
|
||||||
|
|
||||||
(IF SAVE
|
(* ;; "Save copies locally in this browser, for potential Undelete. Undelete would have to match all of the versions")
|
||||||
THEN (CL:UNLESS (RENAMEFILE F (PACKFILENAME.STRING
|
|
||||||
'DIRECTORY
|
(CL:UNLESS (if SAVE
|
||||||
(CONCAT "deleted>" (FILENAMEFIELD.STRING
|
then (PUTMULTI (fetch (TABLEBROWSER TBUSERDATA) of CDBROWSER
|
||||||
F
|
)
|
||||||
'DIRECTORY))
|
'ORIGINALFILES
|
||||||
'BODY F))
|
(RENAMEFILE F (PACKFILENAME.STRING
|
||||||
(ERROR "Could not delete " F))
|
'DIRECTORY
|
||||||
ELSE (DELFILE FILE))
|
(CONCAT "deleted>"
|
||||||
F FINALLY
|
(FILENAMEFIELD.STRING
|
||||||
|
F
|
||||||
|
'DIRECTORY))
|
||||||
|
'BODY F)))
|
||||||
|
else (PUTMULTI (fetch (TABLEBROWSER TBUSERDATA) of CDBROWSER)
|
||||||
|
'ORIGINALFILES FILE (COPYFILE FILE '{NODIRCORE}))
|
||||||
|
(DELFILE FILE))
|
||||||
|
(ERROR "Could not delete " F))
|
||||||
|
F finally
|
||||||
|
|
||||||
(* ;; "Perhaps only mark it as deleted if both files are gone?")
|
(* ;; "Perhaps only mark it as deleted if both files are gone?")
|
||||||
|
|
||||||
(TB.DELETE.ITEM CDBROWSER TBITEM)))])])
|
(CL:UNLESS DONTMARK (TB.DELETE.ITEM CDBROWSER TBITEM)))))])])
|
||||||
|
|
||||||
(CD-SWAPDIRS
|
(CD-SWAPDIRS
|
||||||
[LAMBDA (FILE FROMDIR TODIR KEEPVERSION) (* ; "Edited 2-Feb-2022 19:10 by rmk")
|
[LAMBDA (FILE FROMDIR TODIR KEEPVERSION) (* ; "Edited 2-Feb-2022 19:10 by rmk")
|
||||||
@@ -2258,38 +2303,43 @@
|
|||||||
|
|
||||||
(RPAQ? CD-LINELENGTH NIL)
|
(RPAQ? CD-LINELENGTH NIL)
|
||||||
|
|
||||||
(RPAQQ CDTABLEBROWSER.MENUITEMS ((Compare CD-MENUFN)
|
(RPAQQ CDTABLEBROWSER.MENUITEMS
|
||||||
(Copy% -> CD-MENUFN)
|
((Compare CD-MENUFN)
|
||||||
(Copy% <- CD-MENUFN)
|
(Copy% -> CD-MENUFN)
|
||||||
(See% left CD-MENUFN)
|
(Copy% <- CD-MENUFN)
|
||||||
(See% right CD-MENUFN)
|
(See% left CD-MENUFN)
|
||||||
(See% both CD-MENUFN)
|
(See% right CD-MENUFN)
|
||||||
(See CD-MENUFN)))
|
(See% both CD-MENUFN)
|
||||||
|
(See CD-MENUFN)
|
||||||
|
(Delete% <- CD-MENUFN)
|
||||||
|
(|Delete ALL <-| CD-MENUFN)
|
||||||
|
(Delete% -> CD-MENUFN)
|
||||||
|
(|Delete ALL ->| CD-MENUFN)))
|
||||||
|
|
||||||
(FILESLOAD (SYSLOAD)
|
(FILESLOAD (SYSLOAD)
|
||||||
COMPARESOURCES COMPARETEXT)
|
COMPARESOURCES COMPARETEXT)
|
||||||
|
|
||||||
(MOVD? 'NILL 'TEDIT.FILEDATE)
|
(MOVD? 'NILL 'TEDIT.FILEDATE)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (2655 23634 (COMPAREDIRECTORIES 2665 . 8000) (COMPAREDIRECTORIES.INFOS 8002 . 11231) (
|
(FILEMAP (NIL (2668 23647 (COMPAREDIRECTORIES 2678 . 8013) (COMPAREDIRECTORIES.INFOS 8015 . 11244) (
|
||||||
COMPAREDIRECTORIES.CANDIDATES 11233 . 14618) (CDENTRIES.SELECT 14620 . 19522) (
|
COMPAREDIRECTORIES.CANDIDATES 11246 . 14631) (CDENTRIES.SELECT 14633 . 19535) (
|
||||||
COMPAREDIRECTORIES.INFOS.TYPE 19524 . 20868) (MATCHNAME 20870 . 21550) (CD.INSURECDVALUE 21552 . 23166
|
COMPAREDIRECTORIES.INFOS.TYPE 19537 . 20881) (MATCHNAME 20883 . 21563) (CD.INSURECDVALUE 21565 . 23179
|
||||||
) (CD.UPDATEWIDTHS 23168 . 23632)) (23635 34340 (CDFILES 23645 . 29742) (CDFILES.MATCH 29744 . 31369)
|
) (CD.UPDATEWIDTHS 23181 . 23645)) (23648 34353 (CDFILES 23658 . 29755) (CDFILES.MATCH 29757 . 31382)
|
||||||
(CDFILES.PATS 31371 . 34338)) (34341 52359 (CDPRINT 34351 . 36868) (CDPRINT.HEADER 36870 . 37767) (
|
(CDFILES.PATS 31384 . 34351)) (34354 52372 (CDPRINT 34364 . 36881) (CDPRINT.HEADER 36883 . 37780) (
|
||||||
CDPRINT.LINE 37769 . 41198) (CDPRINT.MAXWIDTHS 41200 . 45315) (CDPRINT.COLHEADERS 45317 . 46602) (
|
CDPRINT.LINE 37782 . 41211) (CDPRINT.MAXWIDTHS 41213 . 45328) (CDPRINT.COLHEADERS 45330 . 46615) (
|
||||||
CDPRINT.COLUMNS 46604 . 51724) (CDTEDIT 51726 . 52357)) (52360 61481 (CDMAP 52370 . 53802) (CDENTRY
|
CDPRINT.COLUMNS 46617 . 51737) (CDTEDIT 51739 . 52370)) (52373 61494 (CDMAP 52383 . 53815) (CDENTRY
|
||||||
53804 . 54113) (CDSUBSET 54115 . 55554) (CDMERGE 55556 . 59540) (CDMERGE.COMMON 59542 . 60857) (
|
53817 . 54126) (CDSUBSET 54128 . 55567) (CDMERGE 55569 . 59553) (CDMERGE.COMMON 59555 . 60870) (
|
||||||
CD.SORT 60859 . 61479)) (61482 69020 (BINCOMP 61492 . 65781) (EOLTYPE 65783 . 68345) (EOLTYPE.SHOW
|
CD.SORT 60872 . 61492)) (61495 69033 (BINCOMP 61505 . 65794) (EOLTYPE 65796 . 68358) (EOLTYPE.SHOW
|
||||||
68347 . 69018)) (69548 82075 (FIND-UNCOMPILED-FILES 69558 . 73201) (FIND-UNSOURCED-FILES 73203 . 75587
|
68360 . 69031)) (69561 82088 (FIND-UNCOMPILED-FILES 69571 . 73214) (FIND-UNSOURCED-FILES 73216 . 75600
|
||||||
) (FIND-SOURCE-FILES 75589 . 77327) (FIND-COMPILED-FILES 77329 . 79206) (FIND-UNLOADED-FILES 79208 .
|
) (FIND-SOURCE-FILES 75602 . 77340) (FIND-COMPILED-FILES 77342 . 79219) (FIND-UNLOADED-FILES 79221 .
|
||||||
80061) (FIND-LOADED-FILES 80063 . 80491) (FIND-MULTICOMPILED-FILES 80493 . 82073)) (82076 90507 (
|
80074) (FIND-LOADED-FILES 80076 . 80504) (FIND-MULTICOMPILED-FILES 80506 . 82086)) (82089 90520 (
|
||||||
CREATED-AS 82086 . 86883) (SOURCE-FOR-COMPILED-P 86885 . 89812) (COMPILE-SOURCE-DATE-DIFF 89814 .
|
CREATED-AS 82099 . 86896) (SOURCE-FOR-COMPILED-P 86898 . 89825) (COMPILE-SOURCE-DATE-DIFF 89827 .
|
||||||
90505)) (90508 101271 (FIX-DIRECTORY-DATES 90518 . 93968) (FIX-EQUIV-DATES 93970 . 95495) (
|
90518)) (90521 101284 (FIX-DIRECTORY-DATES 90531 . 93981) (FIX-EQUIV-DATES 93983 . 95508) (
|
||||||
COPY-COMPARED-FILES 95497 . 97318) (COPY-MISSING-FILES 97320 . 99477) (COMPILED-ON-SAME-SOURCE 99479
|
COPY-COMPARED-FILES 95510 . 97331) (COPY-MISSING-FILES 97333 . 99490) (COMPILED-ON-SAME-SOURCE 99492
|
||||||
. 101269)) (101465 109303 (CDBROWSER 101475 . 105402) (CDBROWSER.STRINGS 105404 . 109301)) (109465
|
. 101282)) (101478 109356 (CDBROWSER 101488 . 105455) (CDBROWSER.STRINGS 105457 . 109354)) (109518
|
||||||
111201 (CD.TABLEITEM 109475 . 109695) (CD.TABLEITEM.PRINTFN 109697 . 109896) (CD.TABLEITEM.COPYFN
|
111254 (CD.TABLEITEM 109528 . 109748) (CD.TABLEITEM.PRINTFN 109750 . 109949) (CD.TABLEITEM.COPYFN
|
||||||
109898 . 110956) (CDTABLEBROWSER.HEADING.REPAINTFN 110958 . 111199)) (111202 134851 (
|
109951 . 111009) (CDTABLEBROWSER.HEADING.REPAINTFN 111011 . 111252)) (111255 138020 (
|
||||||
CDTABLEBROWSER.WHENSELECTEDFN 111212 . 111680) (CD.COMMANDSELECTEDFN 111682 . 116783) (CD-MENUFN
|
CDTABLEBROWSER.WHENSELECTEDFN 111265 . 111733) (CD.COMMANDSELECTEDFN 111735 . 117908) (CD-MENUFN
|
||||||
116785 . 123011) (CD-COMPARE-FILES 123013 . 126365) (CDBROWSER-COPY 126367 . 131115) (
|
117910 . 124301) (CD-COMPARE-FILES 124303 . 127830) (CDBROWSER-COPY 127832 . 132894) (
|
||||||
CDBROWSER-DELETE-FILE 131117 . 134330) (CD-SWAPDIRS 134332 . 134849)))))
|
CDBROWSER-DELETE-FILE 132896 . 137499) (CD-SWAPDIRS 137501 . 138018)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||||
|
|
||||||
(FILECREATED "25-Oct-2025 10:24:30" {WMEDLEY}<lispusers>EXAMINEDEFS.;59 17123
|
(FILECREATED "28-Oct-2025 14:24:17" {WMEDLEY}<lispusers>EXAMINEDEFS.;60 17313
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS EXAMINEDEFS)
|
:CHANGES-TO (FNS EXAMINEFILES)
|
||||||
|
|
||||||
:PREVIOUS-DATE " 6-Apr-2025 23:54:50" {WMEDLEY}<lispusers>EXAMINEDEFS.;57)
|
:PREVIOUS-DATE "25-Oct-2025 10:24:30" {WMEDLEY}<lispusers>EXAMINEDEFS.;59)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT EXAMINEDEFSCOMS)
|
(PRETTYCOMPRINT EXAMINEDEFSCOMS)
|
||||||
@@ -173,7 +173,8 @@
|
|||||||
(EDITE DEF2])
|
(EDITE DEF2])
|
||||||
|
|
||||||
(EXAMINEFILES
|
(EXAMINEFILES
|
||||||
[LAMBDA (FILE1 FILE2 TITLE1 TITLE2 REGION) (* ; "Edited 19-Jul-2023 13:48 by rmk")
|
[LAMBDA (FILE1 FILE2 TITLE1 TITLE2 REGION) (* ; "Edited 28-Oct-2025 14:23 by rmk")
|
||||||
|
(* ; "Edited 19-Jul-2023 13:48 by rmk")
|
||||||
(* ; "Edited 1-Feb-2022 23:15 by rmk")
|
(* ; "Edited 1-Feb-2022 23:15 by rmk")
|
||||||
(* ; "Edited 25-Jan-2022 10:08 by rmk")
|
(* ; "Edited 25-Jan-2022 10:08 by rmk")
|
||||||
(* ; "Edited 2-Jan-2022 23:15 by rmk")
|
(* ; "Edited 2-Jan-2022 23:15 by rmk")
|
||||||
@@ -183,7 +184,8 @@
|
|||||||
|
|
||||||
(CL:UNLESS REGION
|
(CL:UNLESS REGION
|
||||||
(SETQ REGION (GETREGION)))
|
(SETQ REGION (GETREGION)))
|
||||||
(LIST (AND (INFILEP FILE1)
|
(LIST (AND (OR (STREAMP FILE1)
|
||||||
|
(INFILEP FILE1))
|
||||||
(TEDIT-SEE FILE1 (RELCREATEREGION `(,REGION 0.5 -1)
|
(TEDIT-SEE FILE1 (RELCREATEREGION `(,REGION 0.5 -1)
|
||||||
REGION
|
REGION
|
||||||
'RIGHT
|
'RIGHT
|
||||||
@@ -191,7 +193,8 @@
|
|||||||
`(,REGION 0.5)
|
`(,REGION 0.5)
|
||||||
(FETCH (REGION TOP) OF REGION))
|
(FETCH (REGION TOP) OF REGION))
|
||||||
NIL TITLE1))
|
NIL TITLE1))
|
||||||
(AND (INFILEP FILE2)
|
(AND (OR (STREAMP FILE2)
|
||||||
|
(INFILEP FILE2))
|
||||||
(TEDIT-SEE FILE2 (RELCREATEREGION `(,REGION 0.5 1)
|
(TEDIT-SEE FILE2 (RELCREATEREGION `(,REGION 0.5 1)
|
||||||
REGION
|
REGION
|
||||||
'LEFT
|
'LEFT
|
||||||
@@ -284,6 +287,6 @@
|
|||||||
(FILESLOAD (SYSLOAD)
|
(FILESLOAD (SYSLOAD)
|
||||||
COMPARETEXT VERSIONDEFS)
|
COMPARETEXT VERSIONDEFS)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (665 16892 (EXAMINEDEFS 675 . 11290) (EXAMINEFILES 11292 . 12774) (TEDITDEF 12776 .
|
(FILEMAP (NIL (666 17082 (EXAMINEDEFS 676 . 11291) (EXAMINEFILES 11293 . 12964) (TEDITDEF 12966 .
|
||||||
15098) (EXVV 15100 . 16890)))))
|
15288) (EXVV 15290 . 17080)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
156
lispusers/GITFNS
156
lispusers/GITFNS
@@ -1,12 +1,12 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||||
|
|
||||||
(FILECREATED "26-Oct-2025 00:01:44" {WMEDLEY}<lispusers>GITFNS.;565 135222
|
(FILECREATED "28-Oct-2025 14:10:06" {WMEDLEY}<lispusers>GITFNS.;569 131593
|
||||||
|
|
||||||
:EDIT-BY rmk
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:CHANGES-TO (FNS GIT-WORKING-COMPARE-DIRECTORIES GIT-CD-MENUFN GIT-MAKE-PROJECT GIT-CLONEP)
|
:CHANGES-TO (FNS GIT-WORKING-COMPARE-DIRECTORIES GIT-BRANCHES-COMPARE-DIRECTORIES)
|
||||||
|
|
||||||
:PREVIOUS-DATE "25-Oct-2025 10:37:40" {WMEDLEY}<lispusers>GITFNS.;562)
|
:PREVIOUS-DATE "28-Oct-2025 13:32:16" {WMEDLEY}<lispusers>GITFNS.;568)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT GITFNSCOMS)
|
(PRETTYCOMPRINT GITFNSCOMS)
|
||||||
@@ -59,7 +59,7 @@
|
|||||||
(* ;; "File correspondents")
|
(* ;; "File correspondents")
|
||||||
|
|
||||||
(FNS ALLSUBDIRS MEDLEYSUBDIRS GITSUBDIRS)
|
(FNS ALLSUBDIRS MEDLEYSUBDIRS GITSUBDIRS)
|
||||||
(FNS TOGIT FROMGIT GIT-DELETE-FILE MYMEDLEY-DELETE-FILES)
|
(FNS TOGIT FROMGIT)
|
||||||
(FNS MYMEDLEYSUBDIR GITSUBDIR STRIPDIR STRIPHOST STRIPNAME STRIPWHERE)
|
(FNS MYMEDLEYSUBDIR GITSUBDIR STRIPDIR STRIPHOST STRIPNAME STRIPWHERE)
|
||||||
(FNS GFILE4MFILE MFILE4GFILE GIT-REPO-FILENAME)
|
(FNS GFILE4MFILE MFILE4GFILE GIT-REPO-FILENAME)
|
||||||
|
|
||||||
@@ -720,46 +720,6 @@
|
|||||||
(CONCAT GF " cannot be copied"))
|
(CONCAT GF " cannot be copied"))
|
||||||
T)
|
T)
|
||||||
DEST])
|
DEST])
|
||||||
|
|
||||||
(GIT-DELETE-FILE
|
|
||||||
[LAMBDA (FILE PROJECT) (* ; "Edited 8-May-2022 09:27 by rmk")
|
|
||||||
(* ; "Edited 18-Jan-2022 23:07 by rmk")
|
|
||||||
(* ; "Edited 19-Dec-2021 16:11 by rmk")
|
|
||||||
(* ; "Edited 16-Dec-2021 13:00 by rmk")
|
|
||||||
|
|
||||||
(* ;; "This deletes a file in the local checkout git directory {UNIX}... FILE has to already be a full file name, for safety.")
|
|
||||||
|
|
||||||
(* ;; "Since git files are on UNIX, we don't have to worry about older version numbers. ")
|
|
||||||
|
|
||||||
(* ;; "We could make this undoable by copying it to deleted/, but git also can restore.")
|
|
||||||
|
|
||||||
(GIT-CLONEP FILE NIL T)
|
|
||||||
(DELFILE FILE])
|
|
||||||
|
|
||||||
(MYMEDLEY-DELETE-FILES
|
|
||||||
[LAMBDA (FILE PROJECT) (* ; "Edited 13-May-2022 10:40 by rmk")
|
|
||||||
(* ; "Edited 8-May-2022 23:31 by rmk")
|
|
||||||
|
|
||||||
(* ;; "FILE is presumably the latest version of a file in the MyMedley directory, and we are presumably removing all versions of that file. If we left older versions, we would really trash ourselves.")
|
|
||||||
|
|
||||||
(* ;; "But to guard against mistakes, %"deletion%" consists of moving all versions of the file from its current location to a deleted/ subdirectory of MEDLEYDIR, one that does not correspond to a git subdirectory.")
|
|
||||||
|
|
||||||
(SETQ FILE (CONTRACT.PH FILE (FETCH WHOST OF PROJECT)))
|
|
||||||
(CL:WHEN (EQ (FILENAMEFIELD (FETCH WHOST OF PROJECT)
|
|
||||||
'HOST)
|
|
||||||
(FILENAMEFIELD FILE 'HOST))
|
|
||||||
(FOR F IN (DREVERSE (FILDIR (PACKFILENAME 'VERSION '* 'BODY FILE)))
|
|
||||||
COLLECT
|
|
||||||
|
|
||||||
(* ;;
|
|
||||||
"Delete the earlier ones first, if it goes bad, you don't want them to persist")
|
|
||||||
|
|
||||||
(CL:UNLESS (RENAMEFILE F (PACKFILENAME 'DIRECTORY (CONCAT "deleted>"
|
|
||||||
(FILENAMEFIELD F
|
|
||||||
'DIRECTORY))
|
|
||||||
'BODY F))
|
|
||||||
(ERROR "Could not delete " F))
|
|
||||||
F))])
|
|
||||||
)
|
)
|
||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
@@ -1846,7 +1806,8 @@
|
|||||||
(LIST DIR1 DIR2 MAPPINGS))])
|
(LIST DIR1 DIR2 MAPPINGS))])
|
||||||
|
|
||||||
(GIT-BRANCHES-COMPARE-DIRECTORIES
|
(GIT-BRANCHES-COMPARE-DIRECTORIES
|
||||||
[LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 2-Oct-2025 23:12 by rmk")
|
[LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 28-Oct-2025 14:01 by rmk")
|
||||||
|
(* ; "Edited 2-Oct-2025 23:12 by rmk")
|
||||||
(* ; "Edited 12-Jun-2024 22:52 by mth")
|
(* ; "Edited 12-Jun-2024 22:52 by mth")
|
||||||
(* ; "Edited 10-Jun-2024 18:42 by mth")
|
(* ; "Edited 10-Jun-2024 18:42 by mth")
|
||||||
(* ; "Edited 1-May-2024 14:58 by rmk")
|
(* ; "Edited 1-May-2024 14:58 by rmk")
|
||||||
@@ -1938,8 +1899,10 @@
|
|||||||
(LENGTH (fetch (CDVALUE CDENTRIES) of CDVALUE))
|
(LENGTH (fetch (CDVALUE CDENTRIES) of CDVALUE))
|
||||||
" files")
|
" files")
|
||||||
(LIST SHORT1 SHORT2)
|
(LIST SHORT1 SHORT2)
|
||||||
`(LABELFN GIT-CD-LABELFN BRANCH1 ,BRANCH1 BRANCH2 ,BRANCH2 PROJECT
|
`((LABELFN . GIT-CD-LABELFN)
|
||||||
,PROJECT)
|
(BRANCH1 ,@BRANCH1)
|
||||||
|
(BRANCH2 ,@BRANCH2)
|
||||||
|
(PROJECT ,@PROJECT))
|
||||||
GIT-CDBROWSER-SEPARATE-DIRECTIONS
|
GIT-CDBROWSER-SEPARATE-DIRECTIONS
|
||||||
`(Compare See))
|
`(Compare See))
|
||||||
(SETQ NENTRIES (LENGTH (fetch (CDVALUE CDENTRIES) of CDVALUE)))
|
(SETQ NENTRIES (LENGTH (fetch (CDVALUE CDENTRIES) of CDVALUE)))
|
||||||
@@ -1952,6 +1915,8 @@
|
|||||||
(GIT-WORKING-COMPARE-DIRECTORIES
|
(GIT-WORKING-COMPARE-DIRECTORIES
|
||||||
[LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT)
|
[LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT)
|
||||||
|
|
||||||
|
(* ;; "Edited 28-Oct-2025 14:00 by rmk")
|
||||||
|
|
||||||
(* ;; "Edited 25-Oct-2025 23:32 by rmk")
|
(* ;; "Edited 25-Oct-2025 23:32 by rmk")
|
||||||
|
|
||||||
(* ;; "Edited 29-Apr-2025 15:14 by rmk")
|
(* ;; "Edited 29-Apr-2025 15:14 by rmk")
|
||||||
@@ -2031,9 +1996,12 @@
|
|||||||
do (SETQ TITLE (CONCAT WPROJ " vs. " BRANCH2 " " SUBDIR " "
|
do (SETQ TITLE (CONCAT WPROJ " vs. " BRANCH2 " " SUBDIR " "
|
||||||
(LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL))
|
(LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL))
|
||||||
" files"))
|
" files"))
|
||||||
[CDBROWSER CDVAL TITLE `(,WPROJ ,BRANCH2)
|
[CDBROWSER CDVAL TITLE `(,WPROJ ,@BRANCH2)
|
||||||
`(BRANCH1 ,WPROJ BRANCH2 ,BRANCH2 SUBDIR ,SUBDIR LABELFN
|
`((BRANCH1 ,@WPROJ)
|
||||||
GIT-CD-LABELFN PROJECT ,PROJECT)
|
(BRANCH2 ,@BRANCH2)
|
||||||
|
(SUBDIR ,@SUBDIR)
|
||||||
|
(LABELFN . GIT-CD-LABELFN)
|
||||||
|
(PROJECT ,@PROJECT))
|
||||||
GIT-CDBROWSER-SEPARATE-DIRECTIONS
|
GIT-CDBROWSER-SEPARATE-DIRECTIONS
|
||||||
`(Compare See "" Copy% <- (|Delete ALL <-| GIT-CD-MENUFN)
|
`(Compare See "" Copy% <- (|Delete ALL <-| GIT-CD-MENUFN)
|
||||||
,@(CL:UNLESS (GIT-MAINBRANCH? BRANCH2 PROJECT T)
|
,@(CL:UNLESS (GIT-MAINBRANCH? BRANCH2 PROJECT T)
|
||||||
@@ -2213,7 +2181,8 @@
|
|||||||
(OR LABEL2 FILE2])
|
(OR LABEL2 FILE2])
|
||||||
|
|
||||||
(GIT-CD-MENUFN
|
(GIT-CD-MENUFN
|
||||||
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 25-Oct-2025 23:44 by rmk")
|
[LAMBDA (TBITEM MENUITEM CDBROWSER KEY) (* ; "Edited 28-Oct-2025 11:50 by rmk")
|
||||||
|
(* ; "Edited 25-Oct-2025 23:44 by rmk")
|
||||||
(* ; "Edited 21-Sep-2022 21:34 by rmk")
|
(* ; "Edited 21-Sep-2022 21:34 by rmk")
|
||||||
(* ; "Edited 22-May-2022 19:13 by rmk")
|
(* ; "Edited 22-May-2022 19:13 by rmk")
|
||||||
(* ; "Edited 8-May-2022 09:26 by rmk")
|
(* ; "Edited 8-May-2022 09:26 by rmk")
|
||||||
@@ -2221,35 +2190,9 @@
|
|||||||
|
|
||||||
(* ;; "MENUITEM is of the form (display-atom <this function> . extrainfo). The selector for the selectq is either the CAR of the extrainfo or the display atom")
|
(* ;; "MENUITEM is of the form (display-atom <this function> . extrainfo). The selector for the selectq is either the CAR of the extrainfo or the display atom")
|
||||||
|
|
||||||
(DECLARE (USEDFREE FILE1 FILE2 LABEL2 TYPE CDENTRY))
|
(DECLARE (USEDFREE FILE1 FILE2 LABEL2 TYPE CDENTRY USERDATA PWINDOW))
|
||||||
(SELECTQ (OR (CADDR MENUITEM)
|
(SELECTQ (OR (CADDR MENUITEM)
|
||||||
(CAR MENUITEM))
|
(CAR MENUITEM))
|
||||||
(Delete% -> (FLASHWINDOW PWINDOW)
|
|
||||||
(GIVE.TTY.PROCESS PWINDOW)
|
|
||||||
(CL:WHEN [OR (EQ KEY 'MIDDLE)
|
|
||||||
(EQ 'Y (ASKUSER NIL 'N (CONCAT "Delete " LABEL2 " ? "]
|
|
||||||
(GIT-DELETE-FILE FILE2 (LISTGET USERDATA 'PROJECT))
|
|
||||||
(TB.DELETE.ITEM CDBROWSER TBITEM)))
|
|
||||||
(|Delete ALL <-|
|
|
||||||
(FLASHWINDOW PWINDOW)
|
|
||||||
(GIVE.TTY.PROCESS PWINDOW)
|
|
||||||
(if (NAMEFIELD LABEL1 T)
|
|
||||||
then (CL:WHEN [OR (EQ KEY 'MIDDLE)
|
|
||||||
(EQ 'Y (ASKUSER NIL 'N (CONCAT "Delete ALL versions of "
|
|
||||||
(NAMEFIELD LABEL1 T)
|
|
||||||
" ? "]
|
|
||||||
(MYMEDLEY-DELETE-FILES FILE1 (LISTGET USERDATA 'PROJECT))
|
|
||||||
(TB.DELETE.ITEM CDBROWSER TBITEM))
|
|
||||||
else (PRINTOUT T "Nothing to delete")))
|
|
||||||
(Delete% BOTH (FLASHWINDOW PWINDOW)
|
|
||||||
(GIVE.TTY.PROCESS PWINDOW)
|
|
||||||
(CL:WHEN (EQ 'Y (ASKUSER NIL 'N (CONCAT
|
|
||||||
"Delete all Medley and git versions of "
|
|
||||||
(NAMEFIELD LABEL1 T)
|
|
||||||
" ? ")))
|
|
||||||
(GIT-DELETE-FILE FILE2 (LISTGET USERDATA 'PROJECT))
|
|
||||||
(MYMEDLEY-DELETE-FILES FILE1 (LISTGET USERDATA 'PROJECT))
|
|
||||||
(TB.DELETE.ITEM CDBROWSER TBITEM)))
|
|
||||||
(Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT (CADDDR MENUITEM)))
|
(Copy% -> (CDBROWSER-COPY CDBROWSER TBITEM 'LEFT (CADDDR MENUITEM)))
|
||||||
(SHOULDNT])
|
(SHOULDNT])
|
||||||
|
|
||||||
@@ -2451,33 +2394,32 @@
|
|||||||
|
|
||||||
(PUTPROPS GITFNS FILETYPE :TCOMPL)
|
(PUTPROPS GITFNS FILETYPE :TCOMPL)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (4243 21049 (GIT-CLONEP 4253 . 5684) (GIT-INIT 5686 . 6316) (GIT-MAKE-PROJECT 6318 .
|
(FILEMAP (NIL (4196 21002 (GIT-CLONEP 4206 . 5637) (GIT-INIT 5639 . 6269) (GIT-MAKE-PROJECT 6271 .
|
||||||
14107) (GIT-GET-PROJECT 14109 . 16034) (GIT-PUT-PROJECT-FIELD 16036 . 17677) (GIT-PROJECT-PATH 17679
|
14060) (GIT-GET-PROJECT 14062 . 15987) (GIT-PUT-PROJECT-FIELD 15989 . 17630) (GIT-PROJECT-PATH 17632
|
||||||
. 18723) (FIND-ANCESTOR-DIRECTORY 18725 . 19074) (GIT-FIND-CLONE 19076 . 20157) (GIT-MAINBRANCH 20159
|
. 18676) (FIND-ANCESTOR-DIRECTORY 18678 . 19027) (GIT-FIND-CLONE 19029 . 20110) (GIT-MAINBRANCH 20112
|
||||||
. 20554) (GIT-MAINBRANCH? 20556 . 21047)) (26512 31441 (PRC-COMMAND 26522 . 31439)) (31497 34285 (
|
. 20507) (GIT-MAINBRANCH? 20509 . 21000)) (26465 31394 (PRC-COMMAND 26475 . 31392)) (31450 34238 (
|
||||||
ALLSUBDIRS 31507 . 32793) (MEDLEYSUBDIRS 32795 . 33488) (GITSUBDIRS 33490 . 34283)) (34286 39076 (
|
ALLSUBDIRS 31460 . 32746) (MEDLEYSUBDIRS 32748 . 33441) (GITSUBDIRS 33443 . 34236)) (34239 36640 (
|
||||||
TOGIT 34296 . 35702) (FROMGIT 35704 . 36685) (GIT-DELETE-FILE 36687 . 37533) (MYMEDLEY-DELETE-FILES
|
TOGIT 34249 . 35655) (FROMGIT 35657 . 36638)) (36641 39644 (MYMEDLEYSUBDIR 36651 . 37107) (GITSUBDIR
|
||||||
37535 . 39074)) (39077 42080 (MYMEDLEYSUBDIR 39087 . 39543) (GITSUBDIR 39545 . 39988) (STRIPDIR 39990
|
37109 . 37552) (STRIPDIR 37554 . 37925) (STRIPHOST 37927 . 38167) (STRIPNAME 38169 . 38922) (
|
||||||
. 40361) (STRIPHOST 40363 . 40603) (STRIPNAME 40605 . 41358) (STRIPWHERE 41360 . 42078)) (42081 44316
|
STRIPWHERE 38924 . 39642)) (39645 41880 (GFILE4MFILE 39655 . 40351) (MFILE4GFILE 40353 . 40922) (
|
||||||
(GFILE4MFILE 42091 . 42787) (MFILE4GFILE 42789 . 43358) (GIT-REPO-FILENAME 43360 . 44314)) (44365
|
GIT-REPO-FILENAME 40924 . 41878)) (41929 52184 (GIT-COMMIT 41939 . 42765) (GIT-PUSH 42767 . 43527) (
|
||||||
54620 (GIT-COMMIT 44375 . 45201) (GIT-PUSH 45203 . 45963) (GIT-PULL 45965 . 46717) (GIT-APPROVAL 46719
|
GIT-PULL 43529 . 44281) (GIT-APPROVAL 44283 . 44632) (GIT-GET-FILE 44634 . 46549) (GIT-FILE-EXISTS?
|
||||||
. 47068) (GIT-GET-FILE 47070 . 48985) (GIT-FILE-EXISTS? 48987 . 49261) (GIT-REMOTE-UPDATE 49263 .
|
46551 . 46825) (GIT-REMOTE-UPDATE 46827 . 47662) (GIT-REMOTE-ADD 47664 . 47971) (GIT-FILE-DATE 47973
|
||||||
50098) (GIT-REMOTE-ADD 50100 . 50407) (GIT-FILE-DATE 50409 . 51456) (GIT-FILE-HISTORY 51458 . 53392) (
|
. 49020) (GIT-FILE-HISTORY 49022 . 50956) (GIT-PRINT-FILE-HISTORY 50958 . 52008) (GIT-FETCH 52010 .
|
||||||
GIT-PRINT-FILE-HISTORY 53394 . 54444) (GIT-FETCH 54446 . 54618)) (54650 66130 (GIT-BRANCH-DIFF 54660
|
52182)) (52214 63694 (GIT-BRANCH-DIFF 52224 . 59113) (GIT-COMMIT-DIFFS 59115 . 60006) (
|
||||||
. 61549) (GIT-COMMIT-DIFFS 61551 . 62442) (GIT-BRANCH-RELATIONS 62444 . 66128)) (66175 84914 (
|
GIT-BRANCH-RELATIONS 60008 . 63692)) (63739 82478 (GIT-BRANCH-NUM 63749 . 64322) (GIT-CHECKOUT 64324
|
||||||
GIT-BRANCH-NUM 66185 . 66758) (GIT-CHECKOUT 66760 . 68046) (GIT-WHICH-BRANCH 68048 . 68455) (
|
. 65610) (GIT-WHICH-BRANCH 65612 . 66019) (GIT-MAKE-BRANCH 66021 . 68600) (GIT-BRANCHES 68602 . 71197
|
||||||
GIT-MAKE-BRANCH 68457 . 71036) (GIT-BRANCHES 71038 . 73633) (GIT-BRANCH-EXISTS? 73635 . 74506) (
|
) (GIT-BRANCH-EXISTS? 71199 . 72070) (GIT-PICK-BRANCH 72072 . 72562) (GIT-BRANCH-MENU 72564 . 73445) (
|
||||||
GIT-PICK-BRANCH 74508 . 74998) (GIT-BRANCH-MENU 75000 . 75881) (GIT-BRANCH-WHENSELECTEDFN 75883 .
|
GIT-BRANCH-WHENSELECTEDFN 73447 . 74986) (GIT-PULL-REQUESTS 74988 . 78859) (GIT-SHORT-BRANCH-NAME
|
||||||
77422) (GIT-PULL-REQUESTS 77424 . 81295) (GIT-SHORT-BRANCH-NAME 81297 . 81588) (GIT-LONG-NAME 81590 .
|
78861 . 79152) (GIT-LONG-NAME 79154 . 79471) (GIT-PRC-BRANCHES 79473 . 82476)) (82508 85956 (
|
||||||
81907) (GIT-PRC-BRANCHES 81909 . 84912)) (84944 88392 (GIT-MY-CURRENT-BRANCH 84954 . 85324) (
|
GIT-MY-CURRENT-BRANCH 82518 . 82888) (GIT-MY-BRANCHP 82890 . 83508) (GIT-MY-NEXT-BRANCH 83510 . 84004)
|
||||||
GIT-MY-BRANCHP 85326 . 85944) (GIT-MY-NEXT-BRANCH 85946 . 86440) (GIT-MY-BRANCHES 86442 . 88390)) (
|
(GIT-MY-BRANCHES 84006 . 85954)) (86002 90077 (GIT-ADD-WORKTREE 86012 . 87619) (GIT-REMOVE-WORKTREE
|
||||||
88438 92513 (GIT-ADD-WORKTREE 88448 . 90055) (GIT-REMOVE-WORKTREE 90057 . 90987) (GIT-LIST-WORKTREES
|
87621 . 88551) (GIT-LIST-WORKTREES 88553 . 89357) (WORKTREEDIR 89359 . 90075)) (90125 123133 (
|
||||||
90989 . 91793) (WORKTREEDIR 91795 . 92511)) (92561 126762 (GIT-GET-DIFFERENT-FILES 92571 . 99479) (
|
GIT-GET-DIFFERENT-FILES 90135 . 97043) (GIT-BRANCHES-COMPARE-DIRECTORIES 97045 . 104672) (
|
||||||
GIT-BRANCHES-COMPARE-DIRECTORIES 99481 . 106920) (GIT-WORKING-COMPARE-DIRECTORIES 106922 . 112559) (
|
GIT-WORKING-COMPARE-DIRECTORIES 104674 . 110470) (GIT-COMPARE-WORKTREE 110472 . 114450) (
|
||||||
GIT-COMPARE-WORKTREE 112561 . 116539) (GITCDOBJBUTTONFN 116541 . 121031) (GIT-CD-LABELFN 121033 .
|
GITCDOBJBUTTONFN 114452 . 118942) (GIT-CD-LABELFN 118944 . 120026) (GIT-CD-MENUFN 120028 . 121114) (
|
||||||
122115) (GIT-CD-MENUFN 122117 . 124743) (GIT-WORKING-COMPARE-FILES 124745 . 125365) (
|
GIT-WORKING-COMPARE-FILES 121116 . 121736) (GIT-BRANCHES-COMPARE-FILES 121738 . 122902) (
|
||||||
GIT-BRANCHES-COMPARE-FILES 125367 . 126531) (GIT-PR-COMPARE 126533 . 126760)) (126832 135155 (CDGITDIR
|
GIT-PR-COMPARE 122904 . 123131)) (123203 131526 (CDGITDIR 123213 . 123900) (GIT-COMMAND 123902 .
|
||||||
126842 . 127529) (GIT-COMMAND 127531 . 129089) (GITORIGIN 129091 . 129788) (GIT-INITIALS 129790 .
|
125460) (GITORIGIN 125462 . 126159) (GIT-INITIALS 126161 . 126465) (GIT-COMMAND-TO-FILE 126467 .
|
||||||
130094) (GIT-COMMAND-TO-FILE 130096 . 133581) (GIT-RESULT-TO-LINES 133583 . 134488) (STRIPLOCAL 134490
|
129952) (GIT-RESULT-TO-LINES 129954 . 130859) (STRIPLOCAL 130861 . 131524)))))
|
||||||
. 135153)))))
|
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
@@ -1,16 +1,14 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||||
|
|
||||||
(FILECREATED "23-Sep-2022 08:19:41" {DSK}<home>larry>medley>lispusers>KINETIC.;2 1928
|
(FILECREATED " 1-Nov-2025 20:26:43" {DSK}<home>frank>il>medley>lispusers>KINETIC.;5 2264
|
||||||
|
|
||||||
|
:EDIT-BY "FGH"
|
||||||
|
|
||||||
:CHANGES-TO (FNS KINETIC)
|
:CHANGES-TO (FNS KINETIC)
|
||||||
|
|
||||||
:PREVIOUS-DATE " 2-Apr-86 00:14:01" {DSK}<home>larry>medley>lispusers>KINETIC.;1)
|
:PREVIOUS-DATE "23-Sep-2022 08:19:41" {DSK}<home>frank>il>medley>lispusers>KINETIC.;1)
|
||||||
|
|
||||||
|
|
||||||
(* ; "
|
|
||||||
Copyright (c) 1982, 1985-1986, 2022 by Xerox Corporation.
|
|
||||||
")
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT KINETICCOMS)
|
(PRETTYCOMPRINT KINETICCOMS)
|
||||||
|
|
||||||
(RPAQQ KINETICCOMS ((FNS KINETIC)
|
(RPAQQ KINETICCOMS ((FNS KINETIC)
|
||||||
@@ -20,26 +18,31 @@ Copyright (c) 1982, 1985-1986, 2022 by Xerox Corporation.
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(KINETIC
|
(KINETIC
|
||||||
[LAMBDA (WINDOW) (* ; "Edited 22-Sep-2022 22:07 by lmm")
|
[LAMBDA (WINDOW) (* ; "Edited 1-Nov-2025 20:23 by FGH")
|
||||||
|
(* ; "Edited 22-Sep-2022 22:07 by lmm")
|
||||||
(* lmm " 3-Dec-85 14:16")
|
(* lmm " 3-Dec-85 14:16")
|
||||||
(* test example (KINETICDEMO)
|
|
||||||
(SETQ CHECKSHADE (EDITSHADE CHECKSHADE)))
|
|
||||||
[OR (WINDOWP WINDOW)
|
[OR (WINDOWP WINDOW)
|
||||||
(SETQ WINDOW (OR KINETICWINDOW (SETQ KINETICWINDOW (CREATEW NIL "Kinetic Window"]
|
(SETQ WINDOW (OR KINETICWINDOW (SETQ KINETICWINDOW (CREATEW NIL "Kinetic Window"]
|
||||||
|
[OR (WINDOWPROP WINDOW 'CLOSEFN)
|
||||||
|
(WINDOWPROP WINDOW 'CLOSEFN (FUNCTION (LAMBDA (W)
|
||||||
|
(WINDOWPROP W 'CLOSE T]
|
||||||
|
[WINDOWPROP WINDOW 'CLOSEFN (FUNCTION (LAMBDA (W)
|
||||||
|
(WINDOWPROP W 'CLOSE T]
|
||||||
(PROG ((WD (WINDOWPROP WINDOW 'WIDTH))
|
(PROG ((WD (WINDOWPROP WINDOW 'WIDTH))
|
||||||
(HT (WINDOWPROP WINDOW 'HEIGHT))
|
(HT (WINDOWPROP WINDOW 'HEIGHT))
|
||||||
X Y)
|
X Y)
|
||||||
(do (SETQ X (RAND 0 WD))
|
(while (NEQ (WINDOWPROP WINDOW 'CLOSE)
|
||||||
(SETQ Y (RAND 0 HT))
|
T) do (SETQ X (RAND 0 WD))
|
||||||
(BITBLT NIL NIL NIL WINDOW (RAND 0 (IDIFFERENCE WD X))
|
(SETQ Y (RAND 0 HT))
|
||||||
(RAND 0 (IDIFFERENCE HT Y))
|
(BITBLT NIL NIL NIL WINDOW (RAND 0 (IDIFFERENCE WD X))
|
||||||
X Y 'TEXTURE (SELECTQ (RAND 0 5)
|
(RAND 0 (IDIFFERENCE HT Y))
|
||||||
(0 'PAINT)
|
X Y 'TEXTURE (SELECTQ (RAND 0 5)
|
||||||
'INVERT)
|
(0 'PAINT)
|
||||||
(SELECTQ (AND CHECKSHADE (RAND 0 12))
|
'INVERT)
|
||||||
(0 CHECKSHADE)
|
(SELECTQ (AND CHECKSHADE (RAND 0 12))
|
||||||
BLACKSHADE))
|
(0 CHECKSHADE)
|
||||||
(BLOCK 100])
|
BLACKSHADE))
|
||||||
|
(BLOCK 100) finally (WINDOWPROP WINDOW 'CLOSE NIL])
|
||||||
)
|
)
|
||||||
|
|
||||||
(RPAQQ CHECKSHADE 63903)
|
(RPAQQ CHECKSHADE 63903)
|
||||||
@@ -47,7 +50,6 @@ Copyright (c) 1982, 1985-1986, 2022 by Xerox Corporation.
|
|||||||
(RPAQQ KINETICWINDOW NIL)
|
(RPAQQ KINETICWINDOW NIL)
|
||||||
|
|
||||||
(ADDTOVAR IDLE.FUNCTIONS (Kinetic 'KINETIC))
|
(ADDTOVAR IDLE.FUNCTIONS (Kinetic 'KINETIC))
|
||||||
(PUTPROPS KINETIC COPYRIGHT ("Xerox Corporation" 1982 1985 1986 2022))
|
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (573 1723 (KINETIC 583 . 1721)))))
|
(FILEMAP (NIL (534 2130 (KINETIC 544 . 2128)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
@@ -1,17 +1,19 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "BDF" ( USE "XCL" "LISP") ( EXPORT "READ-BDF"
|
(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "BDF" ( USE "XCL" "LISP") ( EXPORT "READ-BDF"
|
||||||
"WRITE-BDF-TO-DISPLAYFONT-FILES") ( IMPORT \AVGCHARWIDTH \FGETWIDTH \FONTFACE \FONTFILENAME
|
"WRITE-BDF-TO-DISPLAYFONT-FILES") ( IMPORT-FROM "IL" "BITBLT" "BITMAPCREATE" "BITMAPHEIGHT"
|
||||||
\FSETOFFSET \FSETWIDTH \FONTSYMBOL \GETSTREAM \INSTALLCHARSETINFO \PUTBASE BITBLT BITMAPCREATE
|
"BITMAPWIDTH" "BLACKSHADE" "BLTSHADE" "BOLD" "COMPRESSED" "CHARSETINFO" "DISPLAY" "FONTDESCRIPTOR"
|
||||||
BITMAPHEIGHT BITMAPWIDTH BLACKSHADE BLTSHADE BOLD CONDENSED CHARSETINFO DISPLAY FONTDESCRIPTOR FONTP
|
"FONTP" "FONTPROP" "INPUT" "ITALIC" "LIGHT" "LRSH" "MEDIUM" "REGULAR" "TCONC" "UTOMCODE" "UTOMCODE?"
|
||||||
FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITESTRIKEFONTFILE))
|
"WRITESTRIKEFONTFILE")) READTABLE "XCL" BASE 10)
|
||||||
READTABLE "XCL" BASE 10)
|
|
||||||
|
|
||||||
(IL:FILECREATED "30-Apr-2025 13:20:10" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;61| 47500
|
(IL:FILECREATED " 6-Nov-2025 23:10:51" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;13| 49101
|
||||||
|
|
||||||
:EDIT-BY "mth"
|
:EDIT-BY "mth"
|
||||||
|
|
||||||
:CHANGES-TO (IL:FUNCTIONS GET-FAMILY-FACE-SIZE-FROM-NAME)
|
:CHANGES-TO (IL:FUNCTIONS BDF-TO-FONTDESCRIPTOR BDF-TO-CHARSETINFO READ-GLYPH
|
||||||
|
WRITE-BDF-TO-DISPLAYFONT-FILES)
|
||||||
|
(FILE-ENVIRONMENTS "READ-BDF")
|
||||||
|
(IL:VARS IL:READ-BDFCOMS)
|
||||||
|
|
||||||
:PREVIOUS-DATE "25-Apr-2025 10:10:08" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;60|
|
:PREVIOUS-DATE " 6-Nov-2025 22:43:21" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;9|
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
@@ -23,8 +25,10 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
|
|||||||
(IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR GET-FAMILY-FACE-SIZE-FROM-NAME
|
(IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR GET-FAMILY-FACE-SIZE-FROM-NAME
|
||||||
GLYPHS-BY-CHARSET PACKFILENAME.STRING READ-BDF READ-DELIMITED-LIST-FROM-STRING
|
GLYPHS-BY-CHARSET PACKFILENAME.STRING READ-BDF READ-DELIMITED-LIST-FROM-STRING
|
||||||
READ-GLYPH SPLIT-FONT-NAME WRITE-BDF-TO-DISPLAYFONT-FILES)
|
READ-GLYPH SPLIT-FONT-NAME WRITE-BDF-TO-DISPLAYFONT-FILES)
|
||||||
(IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILES (IL:LOADCOMP)
|
(IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILES (IL:SYSLOAD)
|
||||||
IL:FONT))
|
IL:SYSEDIT)
|
||||||
|
(IL:FILES (IL:LOADCOMP)
|
||||||
|
IL:FONT))
|
||||||
(FILE-ENVIRONMENTS "READ-BDF")
|
(FILE-ENVIRONMENTS "READ-BDF")
|
||||||
(IL:PROP (IL:DATABASE)
|
(IL:PROP (IL:DATABASE)
|
||||||
IL:READ-BDF)))
|
IL:READ-BDF)))
|
||||||
@@ -40,10 +44,10 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
|
|||||||
(SLUG NIL :TYPE GLYPH))
|
(SLUG NIL :TYPE GLYPH))
|
||||||
|
|
||||||
(DEFSTRUCT GLYPH
|
(DEFSTRUCT GLYPH
|
||||||
"This is an individual BDF glyph. Includes some values calculted for creating CHARSETINFO"
|
"This is an individual BDF glyph. Includes some values calculated for creating CHARSETINFO"
|
||||||
(NAME NIL :TYPE STRING)
|
(NAME NIL :TYPE STRING)
|
||||||
ENCODING SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR BBW BBH BBXOFF0 BBYOFF0 BITMAP
|
ENCODING SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR BBW BBH BBXOFF0 BBYOFF0 BITMAP
|
||||||
(XCODE 0 :TYPE INTEGER)
|
(MCODE 0 :TYPE INTEGER)
|
||||||
(WIDTH 0 :TYPE INTEGER)
|
(WIDTH 0 :TYPE INTEGER)
|
||||||
(ASCENT 0 :TYPE INTEGER)
|
(ASCENT 0 :TYPE INTEGER)
|
||||||
(DESCENT 0 :TYPE INTEGER))
|
(DESCENT 0 :TYPE INTEGER))
|
||||||
@@ -55,6 +59,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
|
|||||||
(DEFCONSTANT NOMAPPINGCHARSET (1+ MAXCHARSET))
|
(DEFCONSTANT NOMAPPINGCHARSET (1+ MAXCHARSET))
|
||||||
|
|
||||||
(DEFUN BDF-TO-CHARSETINFO (FONT CSET SLUG-OR-WIDTH &OPTIONAL MAP-UNKNOWN-TO-PRIVATE)
|
(DEFUN BDF-TO-CHARSETINFO (FONT CSET SLUG-OR-WIDTH &OPTIONAL MAP-UNKNOWN-TO-PRIVATE)
|
||||||
|
(IL:* IL:\; "Edited 6-Nov-2025 17:30 by mth")
|
||||||
(IL:* IL:\; "Edited 23-Apr-2025 17:53 by mth")
|
(IL:* IL:\; "Edited 23-Apr-2025 17:53 by mth")
|
||||||
(IL:* IL:\; "Edited 21-Apr-2025 16:23 by mth")
|
(IL:* IL:\; "Edited 21-Apr-2025 16:23 by mth")
|
||||||
(IL:* IL:\; "Edited 30-Jan-2025 16:40 by mth")
|
(IL:* IL:\; "Edited 30-Jan-2025 16:40 by mth")
|
||||||
@@ -98,7 +103,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
|
|||||||
((INTEGERP SLUG-OR-WIDTH)
|
((INTEGERP SLUG-OR-WIDTH)
|
||||||
(SETQ SLUGWIDTH SLUG-OR-WIDTH))
|
(SETQ SLUGWIDTH SLUG-OR-WIDTH))
|
||||||
(T (ERROR "Invalid SLUG-OR-WIDTH: ~S" SLUG-OR-WIDTH)))
|
(T (ERROR "Invalid SLUG-OR-WIDTH: ~S" SLUG-OR-WIDTH)))
|
||||||
(SETQ CSGLYPHS (LOOP :FOR XGL :IN CSGLYPHS :COLLECT (LET* ((XCODE (CAR XGL))
|
(SETQ CSGLYPHS (LOOP :FOR XGL :IN CSGLYPHS :COLLECT (LET* ((MCODE (CAR XGL))
|
||||||
(GL (CDR XGL))
|
(GL (CDR XGL))
|
||||||
(GWIDTH (GLYPH-WIDTH
|
(GWIDTH (GLYPH-WIDTH
|
||||||
GL))
|
GL))
|
||||||
@@ -112,13 +117,13 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
|
|||||||
|
|
||||||
"Is the above statement actually true?")
|
"Is the above statement actually true?")
|
||||||
|
|
||||||
(SETF (GLYPH-XCODE GL)
|
(SETF (GLYPH-MCODE GL)
|
||||||
XCODE)
|
MCODE)
|
||||||
(SETQ FIRSTCHAR
|
(SETQ FIRSTCHAR
|
||||||
(MIN FIRSTCHAR XCODE
|
(MIN FIRSTCHAR MCODE
|
||||||
))
|
))
|
||||||
(SETQ LASTCHAR
|
(SETQ LASTCHAR
|
||||||
(MAX LASTCHAR XCODE)
|
(MAX LASTCHAR MCODE)
|
||||||
)
|
)
|
||||||
(INCF TOTAL-WIDTH GWIDTH)
|
(INCF TOTAL-WIDTH GWIDTH)
|
||||||
(SETQ ASCENT
|
(SETQ ASCENT
|
||||||
@@ -133,13 +138,13 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
|
|||||||
(IL:* IL:|;;|
|
(IL:* IL:|;;|
|
||||||
"Initialize the offsets to the TOTAL-WIDTH (without the SLUG. It will be added later)")
|
"Initialize the offsets to the TOTAL-WIDTH (without the SLUG. It will be added later)")
|
||||||
|
|
||||||
(IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (\\FSETOFFSET OFFSETS I
|
(IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (IL:\\FSETOFFSET OFFSETS I
|
||||||
TOTAL-WIDTH))
|
TOTAL-WIDTH))
|
||||||
(SETQ WIDTHS (IL:|fetch| (CHARSETINFO IL:WIDTHS) IL:|of| CSINFO))
|
(SETQ WIDTHS (IL:|fetch| (CHARSETINFO IL:WIDTHS) IL:|of| CSINFO))
|
||||||
|
|
||||||
(IL:* IL:|;;| "Initialize the widths to SLUGWIDTH")
|
(IL:* IL:|;;| "Initialize the widths to SLUGWIDTH")
|
||||||
|
|
||||||
(IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (\\FSETWIDTH WIDTHS I
|
(IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (IL:\\FSETWIDTH WIDTHS I
|
||||||
SLUGWIDTH))
|
SLUGWIDTH))
|
||||||
(IL:|replace| (CHARSETINFO IL:IMAGEWIDTHS) IL:|of| CSINFO IL:|with| WIDTHS)
|
(IL:|replace| (CHARSETINFO IL:IMAGEWIDTHS) IL:|of| CSINFO IL:|with| WIDTHS)
|
||||||
|
|
||||||
@@ -151,19 +156,19 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
|
|||||||
(SETQ BMAP (BITMAPCREATE (+ TOTAL-WIDTH SLUGWIDTH)
|
(SETQ BMAP (BITMAPCREATE (+ TOTAL-WIDTH SLUGWIDTH)
|
||||||
HEIGHT 1))
|
HEIGHT 1))
|
||||||
(IL:|replace| (CHARSETINFO IL:CHARSETBITMAP) IL:|of| CSINFO IL:|with| BMAP)
|
(IL:|replace| (CHARSETINFO IL:CHARSETBITMAP) IL:|of| CSINFO IL:|with| BMAP)
|
||||||
(LOOP :FOR GL :IN CSGLYPHS :WITH GLBM :WITH GLW :WITH XCODE :DO (SETQ GLBM
|
(LOOP :FOR GL :IN CSGLYPHS :WITH GLBM :WITH GLW :WITH MCODE :DO (SETQ GLBM
|
||||||
(GLYPH-BITMAP
|
(GLYPH-BITMAP
|
||||||
GL))
|
GL))
|
||||||
(SETQ GLW (GLYPH-WIDTH GL))
|
(SETQ GLW (GLYPH-WIDTH GL))
|
||||||
(SETQ XCODE (GLYPH-XCODE GL))
|
(SETQ MCODE (GLYPH-MCODE GL))
|
||||||
(BITBLT GLBM 0 0 BMAP (+ DLEFT (MAX 0 (GLYPH-BBXOFF0 GL)))
|
(BITBLT GLBM 0 0 BMAP (+ DLEFT (MAX 0 (GLYPH-BBXOFF0 GL)))
|
||||||
(+ DESCENT (GLYPH-BBYOFF0 GL))
|
(+ DESCENT (GLYPH-BBYOFF0 GL))
|
||||||
(BITMAPWIDTH GLBM)
|
(BITMAPWIDTH GLBM)
|
||||||
(BITMAPHEIGHT GLBM)
|
(BITMAPHEIGHT GLBM)
|
||||||
'INPUT
|
'INPUT
|
||||||
'IL:REPLACE)
|
'IL:REPLACE)
|
||||||
(\\FSETOFFSET OFFSETS XCODE DLEFT)
|
(IL:\\FSETOFFSET OFFSETS MCODE DLEFT)
|
||||||
(\\FSETOFFSET WIDTHS XCODE GLW)
|
(IL:\\FSETOFFSET WIDTHS MCODE GLW)
|
||||||
(INCF DLEFT GLW))
|
(INCF DLEFT GLW))
|
||||||
|
|
||||||
(IL:* IL:|;;| "Now insert the SLUG glyph into the BMAP, or make a slug (block)")
|
(IL:* IL:|;;| "Now insert the SLUG glyph into the BMAP, or make a slug (block)")
|
||||||
@@ -185,6 +190,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
|
|||||||
|
|
||||||
(DEFUN BDF-TO-FONTDESCRIPTOR (BDFONT FAMILY SIZE FACE ROTATION DEVICE &OPTIONAL
|
(DEFUN BDF-TO-FONTDESCRIPTOR (BDFONT FAMILY SIZE FACE ROTATION DEVICE &OPTIONAL
|
||||||
MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING)
|
MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING)
|
||||||
|
(IL:* IL:\; "Edited 5-Nov-2025 16:09 by mth")
|
||||||
(IL:* IL:\; "Edited 21-Apr-2025 16:03 by mth")
|
(IL:* IL:\; "Edited 21-Apr-2025 16:03 by mth")
|
||||||
(IL:* IL:\; "Edited 30-Jan-2025 21:27 by mth")
|
(IL:* IL:\; "Edited 30-Jan-2025 21:27 by mth")
|
||||||
(WHEN (AND (BDF-FONT-P BDFONT)
|
(WHEN (AND (BDF-FONT-P BDFONT)
|
||||||
@@ -200,18 +206,22 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
|
|||||||
(OR DEVICE (FONTPROP FAMILY 'IL:DEVICE))
|
(OR DEVICE (FONTPROP FAMILY 'IL:DEVICE))
|
||||||
MAP-UNKNOWN-TO-PRIVATE)))
|
MAP-UNKNOWN-TO-PRIVATE)))
|
||||||
(WHEN (LISTP FAMILY)
|
(WHEN (LISTP FAMILY)
|
||||||
(RETURN (BDF-TO-FONTDESCRIPTOR BDFONT (FIRST FAMILY)
|
|
||||||
(OR (SECOND FAMILY)
|
(IL:* IL:|;;| "Assume this is a FONTSPEC")
|
||||||
|
|
||||||
|
(RETURN (BDF-TO-FONTDESCRIPTOR BDFONT (IL:|fetch| (IL:FONTSPEC IL:FSFAMILY)
|
||||||
|
IL:|of| FAMILY)
|
||||||
|
(OR (IL:|fetch| (IL:FONTSPEC IL:FSSIZE) IL:|of| FAMILY)
|
||||||
SIZE)
|
SIZE)
|
||||||
(OR (THIRD FAMILY)
|
(OR (IL:|fetch| (IL:FONTSPEC IL:FSFACE) IL:|of| FAMILY)
|
||||||
FACE "MRR")
|
FACE "MRR")
|
||||||
(OR (FOURTH FAMILY)
|
(OR (IL:|fetch| (IL:FONTSPEC IL:FSROTATION) IL:|of| FAMILY)
|
||||||
ROTATION 0)
|
ROTATION 0)
|
||||||
(OR (FIFTH FAMILY)
|
(OR (IL:|fetch| (IL:FONTSPEC IL:FSDEVICE) IL:|of| FAMILY)
|
||||||
DEVICE
|
DEVICE
|
||||||
'DISPLAY)
|
'DISPLAY)
|
||||||
MAP-UNKNOWN-TO-PRIVATE)))
|
MAP-UNKNOWN-TO-PRIVATE)))
|
||||||
(SETQ FAMILY (\\FONTSYMBOL FAMILY))
|
(SETQ FAMILY (IL:\\FONTSYMBOL FAMILY))
|
||||||
(UNLESS (AND (INTEGERP SIZE)
|
(UNLESS (AND (INTEGERP SIZE)
|
||||||
(PLUSP SIZE))
|
(PLUSP SIZE))
|
||||||
(ERROR "Invalid SIZE: ~S~%" SIZE))
|
(ERROR "Invalid SIZE: ~S~%" SIZE))
|
||||||
@@ -236,7 +246,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
|
|||||||
(INTERN (STRING-UPCASE DEVICE)
|
(INTERN (STRING-UPCASE DEVICE)
|
||||||
"IL"))
|
"IL"))
|
||||||
(T (IL:\\ILLEGAL.ARG DEVICE))))
|
(T (IL:\\ILLEGAL.ARG DEVICE))))
|
||||||
(SETQ FACE (\\FONTFACE FACE NIL DEV))
|
(SETQ FACE (IL:\\FONTFACE FACE NIL DEV))
|
||||||
(SETQ GBCSL (GLYPHS-BY-CHARSET BDFONT MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING))
|
(SETQ GBCSL (GLYPHS-BY-CHARSET BDFONT MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING))
|
||||||
(UNLESS SLUGWIDTH
|
(UNLESS SLUGWIDTH
|
||||||
|
|
||||||
@@ -268,15 +278,16 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
|
|||||||
GBCS CSET (OR SLUG (1+
|
GBCS CSET (OR SLUG (1+
|
||||||
SLUGWIDTH
|
SLUGWIDTH
|
||||||
))))
|
))))
|
||||||
(\\INSTALLCHARSETINFO FONTDESC CSINFO CSET)
|
(IL:\\INSTALLCHARSETINFO FONTDESC CSINFO CSET
|
||||||
|
)
|
||||||
(LIST CSET)))))
|
(LIST CSET)))))
|
||||||
(LIST FONTDESC CHARSETS))))
|
(LIST FONTDESC CHARSETS))))
|
||||||
(RETURN (VALUES-LIST (NCONC (GBCS-TO-FONTDESC (FIRST GBCSL)
|
(RETURN (VALUES-LIST (NCONC (GBCS-TO-FONTDESC (FIRST GBCSL)
|
||||||
FAMILY)
|
FAMILY)
|
||||||
(GBCS-TO-FONTDESC (SECOND GBCSL)
|
(GBCS-TO-FONTDESC (SECOND GBCSL)
|
||||||
(\\FONTSYMBOL (CONCATENATE 'STRING
|
(IL:\\FONTSYMBOL (CONCATENATE 'STRING
|
||||||
(SYMBOL-NAME FAMILY)
|
(SYMBOL-NAME FAMILY)
|
||||||
"-UNMAPPED")))
|
"-UNMAPPED")))
|
||||||
(LIST (ASSOC NOMAPPINGCHARSET (FIRST GBCSL)
|
(LIST (ASSOC NOMAPPINGCHARSET (FIRST GBCSL)
|
||||||
:TEST
|
:TEST
|
||||||
#'EQL)))))))))
|
#'EQL)))))))))
|
||||||
@@ -311,8 +322,8 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
|
|||||||
'((#\R . REGULAR)
|
'((#\R . REGULAR)
|
||||||
(#\N . REGULAR)
|
(#\N . REGULAR)
|
||||||
(#\B . BOLD)
|
(#\B . BOLD)
|
||||||
(#\S . CONDENSED)
|
(#\S . COMPRESSED)
|
||||||
(#\C . CONDENSED)))))
|
(#\C . COMPRESSED)))))
|
||||||
'REGULAR)) (IL:* IL:\;
|
'REGULAR)) (IL:* IL:\;
|
||||||
"S is for \"SemiCondensed\", Assuming \"Condensed\"")
|
"S is for \"SemiCondensed\", Assuming \"Condensed\"")
|
||||||
|
|
||||||
@@ -336,17 +347,19 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
|
|||||||
(FIRST (BF-SIZE BDFONT))))))
|
(FIRST (BF-SIZE BDFONT))))))
|
||||||
|
|
||||||
(DEFUN GLYPHS-BY-CHARSET (FONT &OPTIONAL MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING)
|
(DEFUN GLYPHS-BY-CHARSET (FONT &OPTIONAL MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING)
|
||||||
|
(IL:* IL:\; "Edited 6-Nov-2025 18:11 by mth")
|
||||||
|
(IL:* IL:\; "Edited 5-Nov-2025 16:18 by mth")
|
||||||
(IL:* IL:\; "Edited 21-Apr-2025 15:48 by mth")
|
(IL:* IL:\; "Edited 21-Apr-2025 15:48 by mth")
|
||||||
(IL:* IL:\; "Edited 9-Jan-2025 11:23 by mth")
|
(IL:* IL:\; "Edited 9-Jan-2025 11:23 by mth")
|
||||||
(LET* ((NCSETS (+ MAXCHARSET 2))
|
(LET* ((NCSETS (+ MAXCHARSET 2))
|
||||||
(CSETS (MAKE-ARRAY NCSETS :INITIAL-CONTENTS (LOOP :REPEAT NCSETS :COLLECT (CONS NIL))))
|
(CSETS (MAKE-ARRAY NCSETS :INITIAL-CONTENTS (LOOP :REPEAT NCSETS :COLLECT (CONS NIL))))
|
||||||
(UTOXFN (COND
|
(UTOMFN (COND
|
||||||
(RAW-UNICODE-MAPPING #'IDENTITY)
|
(RAW-UNICODE-MAPPING #'IDENTITY)
|
||||||
(MAP-UNKNOWN-TO-PRIVATE #'UTOXCODE)
|
(MAP-UNKNOWN-TO-PRIVATE #'UTOMCODE)
|
||||||
(T #'UTOXCODE?)))
|
(T #'UTOMCODE?)))
|
||||||
(SLUG (BF-SLUG FONT))
|
(SLUG (BF-SLUG FONT))
|
||||||
(SLUGWIDTH (AND SLUG (GLYPH-WIDTH SLUG)))
|
(SLUGWIDTH (AND SLUG (GLYPH-WIDTH SLUG)))
|
||||||
NOMAPPINGCSETS ENC XCODE XCS)
|
NOMAPPINGCSETS ENC MCODE MCS)
|
||||||
(UNLESS (OR MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING)
|
(UNLESS (OR MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING)
|
||||||
(SETQ NOMAPPINGCSETS (MAKE-ARRAY NCSETS :INITIAL-CONTENTS (LOOP :REPEAT NCSETS :COLLECT
|
(SETQ NOMAPPINGCSETS (MAKE-ARRAY NCSETS :INITIAL-CONTENTS (LOOP :REPEAT NCSETS :COLLECT
|
||||||
(CONS NIL)))))
|
(CONS NIL)))))
|
||||||
@@ -358,7 +371,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
|
|||||||
:UNLESS
|
:UNLESS
|
||||||
(EQ GL SLUG)
|
(EQ GL SLUG)
|
||||||
:DO
|
:DO
|
||||||
(SETQ XCS NIL)
|
(SETQ MCS NIL)
|
||||||
(SETQ ENC (GLYPH-ENCODING GL))
|
(SETQ ENC (GLYPH-ENCODING GL))
|
||||||
(WHEN (LISTP ENC)
|
(WHEN (LISTP ENC)
|
||||||
|
|
||||||
@@ -372,9 +385,9 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
|
|||||||
"The -1 case of the (OR ...) shouldn't happen. The (EQ GL SLUG) test above should have caught it")
|
"The -1 case of the (OR ...) shouldn't happen. The (EQ GL SLUG) test above should have caught it")
|
||||||
|
|
||||||
)
|
)
|
||||||
(SETQ XCODE (AND (INTEGERP ENC)
|
(SETQ MCODE (AND (INTEGERP ENC)
|
||||||
(PLUSP ENC)
|
(PLUSP ENC)
|
||||||
(FUNCALL UTOXFN ENC)))
|
(FUNCALL UTOMFN ENC)))
|
||||||
(IF RAW-UNICODE-MAPPING
|
(IF RAW-UNICODE-MAPPING
|
||||||
(COND
|
(COND
|
||||||
((> ENC 65535)
|
((> ENC 65535)
|
||||||
@@ -394,7 +407,15 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
|
|||||||
(CONS ENC GL)))
|
(CONS ENC GL)))
|
||||||
(T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL CSETS)))
|
(T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL CSETS)))
|
||||||
(COND
|
(COND
|
||||||
((NULL XCODE)
|
((AND (ZEROP (GLYPH-BBW GL))
|
||||||
|
(ZEROP (FIRST (GLYPH-DWIDTH GL))))
|
||||||
|
|
||||||
|
(IL:* IL:|;;|
|
||||||
|
"This has zero-width \"image\" with zero-width \"escapement\", put it in the NOMAPPINGCHARSET")
|
||||||
|
|
||||||
|
(TCONC (AREF CSETS NOMAPPINGCHARSET)
|
||||||
|
(CONS ENC GL)))
|
||||||
|
((NULL MCODE)
|
||||||
|
|
||||||
(IL:* IL:|;;| "These assoc with the Unicode encoding")
|
(IL:* IL:|;;| "These assoc with the Unicode encoding")
|
||||||
|
|
||||||
@@ -408,37 +429,37 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
|
|||||||
(TCONC (AREF CSETS NOMAPPINGCHARSET)
|
(TCONC (AREF CSETS NOMAPPINGCHARSET)
|
||||||
(CONS ENC GL)))
|
(CONS ENC GL)))
|
||||||
(T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL NOMAPPINGCSETS))))
|
(T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL NOMAPPINGCSETS))))
|
||||||
((AND (INTEGERP XCODE)
|
((AND (INTEGERP MCODE)
|
||||||
(<= 0 XCODE 65535))
|
(<= 0 MCODE 65535))
|
||||||
|
|
||||||
(IL:* IL:|;;|
|
(IL:* IL:|;;|
|
||||||
"These assoc with the 8 bit character code within the charset")
|
"These assoc with the 8 bit character code within the charset")
|
||||||
|
|
||||||
(PUT-GLYPH-IN-CHARSET-ARRAY XCODE GL CSETS)
|
(PUT-GLYPH-IN-CHARSET-ARRAY MCODE GL CSETS)
|
||||||
|
|
||||||
(IL:* IL:|;;| "Default SLUG width is width of A.")
|
(IL:* IL:|;;| "Default SLUG width is width of A.")
|
||||||
|
|
||||||
(WHEN (AND (NOT SLUGWIDTH)
|
(WHEN (AND (NOT SLUGWIDTH)
|
||||||
(= ENC (CHAR-CODE #\A)))
|
(= ENC (CHAR-CODE #\A)))
|
||||||
|
|
||||||
(IL:* IL:|;;| "A is the same code in XCCS and UNICODE ")
|
(IL:* IL:|;;| "A is the same code in MCCS and UNICODE ")
|
||||||
|
|
||||||
(IL:* IL:|;;|
|
(IL:* IL:|;;|
|
||||||
"Comparing with ENC, not XCODE, to look only in charset 0")
|
"Comparing with ENC, not MCODE, to look only in charset 0")
|
||||||
|
|
||||||
(SETQ SLUGWIDTH (GLYPH-WIDTH GL))))
|
(SETQ SLUGWIDTH (GLYPH-WIDTH GL))))
|
||||||
((LISTP XCODE)
|
((LISTP MCODE)
|
||||||
|
|
||||||
(IL:* IL:|;;|
|
(IL:* IL:|;;|
|
||||||
"These assoc with the 8 bit character code within the charset (like above)")
|
"These assoc with the 8 bit character code within the charset (like above)")
|
||||||
|
|
||||||
(LOOP :FOR XC :IN XCODE :WITH CS :UNLESS (MEMBER (SETQ CS
|
(LOOP :FOR MC :IN MCODE :WITH CS :UNLESS (MEMBER (SETQ CS
|
||||||
(LRSH XC 8))
|
(LRSH MC 8))
|
||||||
XCS)
|
MCS)
|
||||||
:DO
|
:DO
|
||||||
(PUSH CS XCS)
|
(PUSH CS MCS)
|
||||||
(PUT-GLYPH-IN-CHARSET-ARRAY XC GL CSETS)))
|
(PUT-GLYPH-IN-CHARSET-ARRAY MC GL CSETS)))
|
||||||
(T (ERROR "Invalid XCODE: ~A~%"))))))
|
(T (ERROR "Invalid MCODE: ~A~%"))))))
|
||||||
|
|
||||||
(IL:* IL:|;;| "Extract the lists from the TCONC pointers")
|
(IL:* IL:|;;| "Extract the lists from the TCONC pointers")
|
||||||
|
|
||||||
@@ -488,7 +509,8 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
|
|||||||
X))
|
X))
|
||||||
Y))))
|
Y))))
|
||||||
|
|
||||||
(DEFUN READ-BDF (PATH &OPTIONAL VERBOSE) (IL:* IL:\; "Edited 24-Apr-2025 00:44 by mth")
|
(DEFUN READ-BDF (PATH &OPTIONAL VERBOSE) (IL:* IL:\; "Edited 30-Apr-2025 13:37 by mth")
|
||||||
|
(IL:* IL:\; "Edited 24-Apr-2025 00:44 by mth")
|
||||||
(IL:* IL:\; "Edited 17-Apr-2025 15:10 by mth")
|
(IL:* IL:\; "Edited 17-Apr-2025 15:10 by mth")
|
||||||
(IL:* IL:\; "Edited 12-Jul-2024 23:02 by mth")
|
(IL:* IL:\; "Edited 12-Jul-2024 23:02 by mth")
|
||||||
(LET
|
(LET
|
||||||
@@ -603,15 +625,15 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
|
|||||||
(SETF (BF-SLUG FONT)
|
(SETF (BF-SLUG FONT)
|
||||||
GL))))))
|
GL))))))
|
||||||
(ENDFONT (SETQ FONT-COMPLETE T))))))))
|
(ENDFONT (SETQ FONT-COMPLETE T))))))))
|
||||||
(WHEN VERBOSE
|
(DESTRUCTURING-BIND (FAMILY (WEIGHT SLANT EXPANSION)
|
||||||
(DESTRUCTURING-BIND (FAMILY (WEIGHT SLANT EXPANSION)
|
SIZE)
|
||||||
SIZE)
|
(GET-FAMILY-FACE-SIZE-FROM-NAME FONT)
|
||||||
(GET-FAMILY-FACE-SIZE-FROM-NAME FONT)
|
(WHEN VERBOSE
|
||||||
(FORMAT *STANDARD-OUTPUT*
|
(FORMAT *STANDARD-OUTPUT*
|
||||||
"Name: ~A~%Family: ~A~%Size: ~A~%Weight: ~A~%Slant: ~A~%Expansion: ~A~%"
|
"Name: ~A~%Family: ~A~%Size: ~A~%Weight: ~A~%Slant: ~A~%Expansion: ~A~%"
|
||||||
(BF-NAME FONT)
|
(BF-NAME FONT)
|
||||||
FAMILY SIZE WEIGHT SLANT EXPANSION)))
|
FAMILY SIZE WEIGHT SLANT EXPANSION))
|
||||||
FONT)))
|
(VALUES FONT FAMILY WEIGHT SLANT EXPANSION SIZE)))))
|
||||||
|
|
||||||
(DEFUN READ-DELIMITED-LIST-FROM-STRING (INPUT-STRING &OPTIONAL (DELIMIT #\]))
|
(DEFUN READ-DELIMITED-LIST-FROM-STRING (INPUT-STRING &OPTIONAL (DELIMIT #\]))
|
||||||
(IL:* IL:\; "Edited 20-Aug-2024 16:46 by mth")
|
(IL:* IL:\; "Edited 20-Aug-2024 16:46 by mth")
|
||||||
@@ -699,7 +721,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
|
|||||||
(SETQ WORDINDEX (* BITROW BM.RASTERWIDTH))
|
(SETQ WORDINDEX (* BITROW BM.RASTERWIDTH))
|
||||||
(SETQ BYTEPOS (* 16 (1- NWORDS)))
|
(SETQ BYTEPOS (* 16 (1- NWORDS)))
|
||||||
(LOOP :REPEAT NWORDS :DO
|
(LOOP :REPEAT NWORDS :DO
|
||||||
(\\PUTBASE BM.BASE WORDINDEX
|
(IL:\\PUTBASE BM.BASE WORDINDEX
|
||||||
(LDB (BYTE 16 BYTEPOS)
|
(LDB (BYTE 16 BYTEPOS)
|
||||||
BITS))
|
BITS))
|
||||||
(INCF WORDINDEX)
|
(INCF WORDINDEX)
|
||||||
@@ -744,12 +766,13 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
|
|||||||
(CHAR-SETS T)
|
(CHAR-SETS T)
|
||||||
MAP-UNKNOWN-TO-PRIVATE WRITE-UNMAPPED
|
MAP-UNKNOWN-TO-PRIVATE WRITE-UNMAPPED
|
||||||
RAW-UNICODE-MAPPING)
|
RAW-UNICODE-MAPPING)
|
||||||
|
(IL:* IL:\; "Edited 5-Nov-2025 23:06 by mth")
|
||||||
(IL:* IL:\; "Edited 25-Apr-2025 10:08 by mth")
|
(IL:* IL:\; "Edited 25-Apr-2025 10:08 by mth")
|
||||||
(IL:* IL:\; "Edited 24-Apr-2025 00:09 by mth")
|
(IL:* IL:\; "Edited 24-Apr-2025 00:09 by mth")
|
||||||
(IL:* IL:\; "Edited 21-Apr-2025 16:03 by mth")
|
(IL:* IL:\; "Edited 21-Apr-2025 16:03 by mth")
|
||||||
(IL:* IL:\; "Edited 3-Feb-2025 23:18 by mth")
|
(IL:* IL:\; "Edited 3-Feb-2025 23:18 by mth")
|
||||||
(UNLESS (TYPEP BDFONT 'BDF-FONT)
|
(UNLESS (TYPEP BDFONT 'BDF-FONT)
|
||||||
(ERROR "Not a BDF-FONT: ~S~%" BDFONT))
|
(ERROR "Not a BDF-FONT: ~S ~%" BDFONT))
|
||||||
(COND
|
(COND
|
||||||
((EQ CHAR-SETS T) (IL:* IL:\; "This means ALL charsets")
|
((EQ CHAR-SETS T) (IL:* IL:\; "This means ALL charsets")
|
||||||
)
|
)
|
||||||
@@ -769,7 +792,7 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
|
|||||||
(GET-FAMILY-FACE-SIZE-FROM-NAME BDFONT)
|
(GET-FAMILY-FACE-SIZE-FROM-NAME BDFONT)
|
||||||
(SETQ FAMILY (OR FAMILY FN-FAMILY))
|
(SETQ FAMILY (OR FAMILY FN-FAMILY))
|
||||||
(WHEN RAW-UNICODE-MAPPING
|
(WHEN RAW-UNICODE-MAPPING
|
||||||
(SETQ FAMILY (\\FONTSYMBOL (CONCATENATE 'STRING "RAW-" (STRING FAMILY)))))
|
(SETQ FAMILY (IL:\\FONTSYMBOL (CONCATENATE 'STRING "RAW-" (STRING FAMILY)))))
|
||||||
(SETQ FACE (OR FACE FN-FACE))
|
(SETQ FACE (OR FACE FN-FACE))
|
||||||
(SETQ SIZE (OR SIZE FN-SIZE))
|
(SETQ SIZE (OR SIZE FN-SIZE))
|
||||||
(MULTIPLE-VALUE-BIND (FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS)
|
(MULTIPLE-VALUE-BIND (FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS)
|
||||||
@@ -780,16 +803,16 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
|
|||||||
(SETQ UNICODE-CSETS (INTERSECTION CHAR-SETS UNICODE-CSETS)))
|
(SETQ UNICODE-CSETS (INTERSECTION CHAR-SETS UNICODE-CSETS)))
|
||||||
(LOOP :FOR CS :IN CSETS :DO (WRITESTRIKEFONTFILE FONTDESC CS
|
(LOOP :FOR CS :IN CSETS :DO (WRITESTRIKEFONTFILE FONTDESC CS
|
||||||
(PACKFILENAME.STRING :BODY DEST-DIR :NAME
|
(PACKFILENAME.STRING :BODY DEST-DIR :NAME
|
||||||
(\\FONTFILENAME FAMILY SIZE FACE
|
(IL:\\FONTFILENAME FAMILY SIZE FACE
|
||||||
"DISPLAYFONT" CS))))
|
"DISPLAYFONT" CS))))
|
||||||
(IF WRITE-UNMAPPED
|
(IF WRITE-UNMAPPED
|
||||||
(LOOP :FOR CS :IN UNICODE-CSETS :DO (WRITESTRIKEFONTFILE
|
(LOOP :FOR CS :IN UNICODE-CSETS :DO (WRITESTRIKEFONTFILE
|
||||||
UNMAPPED-FONTDESC CS
|
UNMAPPED-FONTDESC CS
|
||||||
(PACKFILENAME.STRING
|
(PACKFILENAME.STRING
|
||||||
:BODY DEST-DIR :NAME
|
:BODY DEST-DIR :NAME
|
||||||
(\\FONTFILENAME (FONTPROP
|
(IL:\\FONTFILENAME (FONTPROP
|
||||||
UNMAPPED-FONTDESC
|
UNMAPPED-FONTDESC
|
||||||
'IL:FAMILY)
|
'IL:FAMILY)
|
||||||
SIZE FACE "DISPLAYFONT" CS))))
|
SIZE FACE "DISPLAYFONT" CS))))
|
||||||
(SETQ UNICODE-CSETS NIL))
|
(SETQ UNICODE-CSETS NIL))
|
||||||
|
|
||||||
@@ -801,6 +824,10 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
|
|||||||
(VALUES FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS))))
|
(VALUES FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS))))
|
||||||
(IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY
|
(IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY
|
||||||
|
|
||||||
|
(IL:FILESLOAD (IL:SYSLOAD)
|
||||||
|
IL:SYSEDIT)
|
||||||
|
|
||||||
|
|
||||||
(IL:FILESLOAD (IL:LOADCOMP)
|
(IL:FILESLOAD (IL:LOADCOMP)
|
||||||
IL:FONT)
|
IL:FONT)
|
||||||
)
|
)
|
||||||
@@ -808,25 +835,23 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
|
|||||||
(DEFINE-FILE-ENVIRONMENT "READ-BDF" :PACKAGE (DEFPACKAGE "BDF" (:USE "XCL" "LISP")
|
(DEFINE-FILE-ENVIRONMENT "READ-BDF" :PACKAGE (DEFPACKAGE "BDF" (:USE "XCL" "LISP")
|
||||||
(:EXPORT "READ-BDF"
|
(:EXPORT "READ-BDF"
|
||||||
"WRITE-BDF-TO-DISPLAYFONT-FILES")
|
"WRITE-BDF-TO-DISPLAYFONT-FILES")
|
||||||
(:IMPORT \\AVGCHARWIDTH \\FGETWIDTH \\FONTFACE
|
(:IMPORT-FROM "IL" "BITBLT" "BITMAPCREATE"
|
||||||
\\FONTFILENAME \\FSETOFFSET \\FSETWIDTH
|
"BITMAPHEIGHT" "BITMAPWIDTH" "BLACKSHADE"
|
||||||
\\FONTSYMBOL \\GETSTREAM
|
"BLTSHADE" "BOLD" "COMPRESSED"
|
||||||
\\INSTALLCHARSETINFO \\PUTBASE BITBLT
|
"CHARSETINFO" "DISPLAY" "FONTDESCRIPTOR"
|
||||||
BITMAPCREATE BITMAPHEIGHT BITMAPWIDTH
|
"FONTP" "FONTPROP" "INPUT" "ITALIC"
|
||||||
BLACKSHADE BLTSHADE BOLD CONDENSED
|
"LIGHT" "LRSH" "MEDIUM" "REGULAR" "TCONC"
|
||||||
CHARSETINFO DISPLAY FONTDESCRIPTOR FONTP
|
"UTOMCODE" "UTOMCODE?"
|
||||||
FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM
|
"WRITESTRIKEFONTFILE"))
|
||||||
REGULAR TCONC UTOXCODE UTOXCODE?
|
|
||||||
WRITESTRIKEFONTFILE))
|
|
||||||
:READTABLE "XCL"
|
:READTABLE "XCL"
|
||||||
:COMPILER :COMPILE-FILE)
|
:COMPILER :COMPILE-FILE)
|
||||||
|
|
||||||
(IL:PUTPROPS IL:READ-BDF IL:DATABASE IL:NO)
|
(IL:PUTPROPS IL:READ-BDF IL:DATABASE IL:NO)
|
||||||
(IL:DECLARE\: IL:DONTCOPY
|
(IL:DECLARE\: IL:DONTCOPY
|
||||||
(IL:FILEMAP (NIL (2316 10275 (BDF-TO-CHARSETINFO 2316 . 10275)) (10277 16147 (BDF-TO-FONTDESCRIPTOR
|
(IL:FILEMAP (NIL (2497 10576 (BDF-TO-CHARSETINFO 2497 . 10576)) (10578 16996 (BDF-TO-FONTDESCRIPTOR
|
||||||
10277 . 16147)) (16149 19687 (GET-FAMILY-FACE-SIZE-FROM-NAME 16149 . 19687)) (19689 26500 (
|
10578 . 16996)) (16998 20538 (GET-FAMILY-FACE-SIZE-FROM-NAME 16998 . 20538)) (20540 27970 (
|
||||||
GLYPHS-BY-CHARSET 19689 . 26500)) (26502 27927 (PACKFILENAME.STRING 26502 . 27927)) (27929 34733 (
|
GLYPHS-BY-CHARSET 20540 . 27970)) (27972 29397 (PACKFILENAME.STRING 27972 . 29397)) (29399 36358 (
|
||||||
READ-BDF 27929 . 34733)) (34735 35058 (READ-DELIMITED-LIST-FROM-STRING 34735 . 35058)) (35060 41548 (
|
READ-BDF 29399 . 36358)) (36360 36683 (READ-DELIMITED-LIST-FROM-STRING 36360 . 36683)) (36685 43176 (
|
||||||
READ-GLYPH 35060 . 41548)) (41550 42291 (SPLIT-FONT-NAME 41550 . 42291)) (42293 46075 (
|
READ-GLYPH 36685 . 43176)) (43178 43919 (SPLIT-FONT-NAME 43178 . 43919)) (43921 47827 (
|
||||||
WRITE-BDF-TO-DISPLAYFONT-FILES 42293 . 46075)))))
|
WRITE-BDF-TO-DISPLAYFONT-FILES 43921 . 47827)))))
|
||||||
IL:STOP
|
IL:STOP
|
||||||
|
|||||||
Binary file not shown.
Binary file not shown.
35
sources/AOFD
35
sources/AOFD
@@ -1,10 +1,12 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||||
|
|
||||||
(FILECREATED "17-May-2023 08:29:55" {DSK}<home>larry>il>medley>sources>AOFD.;5 36263
|
(FILECREATED "24-Apr-2025 21:46:04" {WMEDLEY}<sources>AOFD.;10 36381
|
||||||
|
|
||||||
:EDIT-BY "lmm"
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:PREVIOUS-DATE "17-May-2023 08:05:56" {DSK}<home>larry>il>medley>sources>AOFD.;4)
|
:CHANGES-TO (FNS MAKE-STRING-FORMAT)
|
||||||
|
|
||||||
|
:PREVIOUS-DATE "17-May-2023 08:29:55" {WMEDLEY}<sources>AOFD.;9)
|
||||||
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT AOFDCOMS)
|
(PRETTYCOMPRINT AOFDCOMS)
|
||||||
@@ -558,9 +560,10 @@
|
|||||||
STREAM])
|
STREAM])
|
||||||
|
|
||||||
(MAKE-STRING-FORMAT
|
(MAKE-STRING-FORMAT
|
||||||
[LAMBDA NIL (* ; "Edited 8-Aug-2021 00:10 by rmk:")
|
[LAMBDA NIL (* ; "Edited 24-Apr-2025 21:45 by rmk")
|
||||||
|
(* ; "Edited 8-Aug-2021 00:10 by rmk:")
|
||||||
|
|
||||||
(* ;; "We are looking at an in-core string, we know that EOL is CR, that the characters have the internal (XCCS) encoding, and that the string is fat. ")
|
(* ;; "We are looking at an in-core string, we know that EOL is CR, that the characters have the internal (MCCS) encoding, and that the string is fat. ")
|
||||||
|
|
||||||
(MAKE-EXTERNALFORMAT :STRING [FUNCTION (LAMBDA (STRM COUNTP)
|
(MAKE-EXTERNALFORMAT :STRING [FUNCTION (LAMBDA (STRM COUNTP)
|
||||||
(DECLARE (USEDFREE *BYTECOUNTER*))
|
(DECLARE (USEDFREE *BYTECOUNTER*))
|
||||||
@@ -761,15 +764,15 @@
|
|||||||
(ADDTOVAR LAMA WHENCLOSE)
|
(ADDTOVAR LAMA WHENCLOSE)
|
||||||
)
|
)
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (2363 3482 (\ADD-OPEN-STREAM 2373 . 2654) (\GENERIC-UNREGISTER-STREAM 2656 . 3480)) (
|
(FILEMAP (NIL (2372 3491 (\ADD-OPEN-STREAM 2382 . 2663) (\GENERIC-UNREGISTER-STREAM 2665 . 3489)) (
|
||||||
3523 10587 (CLOSEALL 3533 . 4011) (CLOSEF 4013 . 5227) (EOFCLOSEF 5229 . 5529) (INPUT 5531 . 6301) (
|
3532 10596 (CLOSEALL 3542 . 4020) (CLOSEF 4022 . 5236) (EOFCLOSEF 5238 . 5538) (INPUT 5540 . 6310) (
|
||||||
OPENP 6303 . 6706) (OUTPUT 6708 . 7480) (POSITION 7482 . 8290) (RANDACCESSP 8292 . 8682) (\IOMODEP
|
OPENP 6312 . 6715) (OUTPUT 6717 . 7489) (POSITION 7491 . 8299) (RANDACCESSP 8301 . 8691) (\IOMODEP
|
||||||
8684 . 9313) (WHENCLOSE 9315 . 10585)) (10588 10710 (STREAMADDPROP 10598 . 10708)) (11668 24521 (
|
8693 . 9322) (WHENCLOSE 9324 . 10594)) (10597 10719 (STREAMADDPROP 10607 . 10717)) (11677 24530 (
|
||||||
\BASEBYTES.IO.INIT 11678 . 14878) (\MAKEBASEBYTESTREAM 14880 . 17808) (\MBS.OUTCHARFN 17810 . 18210) (
|
\BASEBYTES.IO.INIT 11687 . 14887) (\MAKEBASEBYTESTREAM 14889 . 17817) (\MBS.OUTCHARFN 17819 . 18219) (
|
||||||
\BASEBYTES.NAME.FROM.STREAM 18212 . 18671) (\BASEBYTES.BOUT 18673 . 19427) (\BASEBYTES.SETFILEPTR
|
\BASEBYTES.NAME.FROM.STREAM 18221 . 18680) (\BASEBYTES.BOUT 18682 . 19436) (\BASEBYTES.SETFILEPTR
|
||||||
19429 . 20050) (\BASEBYTES.READP 20052 . 20696) (\BASEBYTES.BIN 20698 . 21205) (\BASEBYTES.PEEKBIN
|
19438 . 20059) (\BASEBYTES.READP 20061 . 20705) (\BASEBYTES.BIN 20707 . 21214) (\BASEBYTES.PEEKBIN
|
||||||
21207 . 22037) (\BASEBYTES.TRUNCATEFN 22039 . 22547) (\BASEBYTES.OPENFN 22549 . 23343) (
|
21216 . 22046) (\BASEBYTES.TRUNCATEFN 22048 . 22556) (\BASEBYTES.OPENFN 22558 . 23352) (
|
||||||
\BASEBYTES.BLOCKIO 23345 . 24519)) (24644 27948 (OPENSTRINGSTREAM 24654 . 26363) (MAKE-STRING-FORMAT
|
\BASEBYTES.BLOCKIO 23354 . 24528)) (24653 28066 (OPENSTRINGSTREAM 24663 . 26372) (MAKE-STRING-FORMAT
|
||||||
26365 . 27946)) (28220 32528 (\STRINGSTREAM.INIT 28230 . 32526)) (32605 35305 (GETSTREAM 32615 . 32846
|
26374 . 28064)) (28338 32646 (\STRINGSTREAM.INIT 28348 . 32644)) (32723 35423 (GETSTREAM 32733 . 32964
|
||||||
) (\CLEAROFD 32848 . 33141) (\GETSTREAM 33143 . 35303)))))
|
) (\CLEAROFD 32966 . 33259) (\GETSTREAM 33261 . 35421)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
88
sources/ATBL
88
sources/ATBL
@@ -1,16 +1,13 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||||
|
|
||||||
(FILECREATED "26-Dec-2021 14:32:50" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>ATBL.;32 91860
|
(FILECREATED "24-Apr-2025 21:52:35" {WMEDLEY}<sources>ATBL.;33 91754
|
||||||
|
|
||||||
:CHANGES-TO (FNS MAKE-READER-ENVIRONMENT)
|
:EDIT-BY rmk
|
||||||
|
|
||||||
:PREVIOUS-DATE "19-Dec-2021 14:09:43"
|
:CHANGES-TO (FNS \ATBLSET EQUAL-READER-ENVIRONMENT)
|
||||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>ATBL.;31)
|
|
||||||
|
|
||||||
|
:PREVIOUS-DATE "26-Dec-2021 14:32:50" {WMEDLEY}<sources>ATBL.;32)
|
||||||
|
|
||||||
(* ; "
|
|
||||||
Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
|
|
||||||
")
|
|
||||||
|
|
||||||
(PRETTYCOMPRINT ATBLCOMS)
|
(PRETTYCOMPRINT ATBLCOMS)
|
||||||
|
|
||||||
@@ -1733,26 +1730,27 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
|
|||||||
(DEFINEQ
|
(DEFINEQ
|
||||||
|
|
||||||
(\ATBLSET
|
(\ATBLSET
|
||||||
[LAMBDA NIL (* ; "Edited 28-Jun-2021 09:29 by rmk:")
|
[LAMBDA NIL (* ; "Edited 24-Apr-2025 21:51 by rmk")
|
||||||
(* ; "Edited 3-Dec-86 18:07 by Pavel")
|
(* ; "Edited 28-Jun-2021 09:29 by rmk:")
|
||||||
|
(* ; "Edited 3-Dec-86 18:07 by Pavel")
|
||||||
(DECLARE (GLOBALVARS \ORIGREADTABLE \ORIGTERMTABLE))
|
(DECLARE (GLOBALVARS \ORIGREADTABLE \ORIGTERMTABLE))
|
||||||
(COND
|
(COND
|
||||||
((NULL (BOUNDP '\PRIMREADTABLE))
|
((NULL (BOUNDP '\PRIMREADTABLE))
|
||||||
(initrecord CHARTABLE)
|
(initrecord CHARTABLE)
|
||||||
|
|
||||||
(* ;; "Read tables")
|
(* ;; "Read tables")
|
||||||
|
|
||||||
(* ;; "RMK: If reloading, don't smash an existing hash table")
|
(* ;; "RMK: If reloading, don't smash an existing hash table")
|
||||||
|
|
||||||
[OR (HARRAYP \READTABLEHASH)
|
[OR (HARRAYP \READTABLEHASH)
|
||||||
(SETQ \READTABLEHASH (HASHARRAY 20 NIL (FUNCTION STRING-EQUAL-HASHBITS)
|
(SETQ \READTABLEHASH (HASHARRAY 20 NIL (FUNCTION STRING-EQUAL-HASHBITS)
|
||||||
(FUNCTION STRING-EQUAL]
|
(FUNCTION STRING-EQUAL]
|
||||||
(LET (TRDTBL NEW-IL-RDTBL)
|
(LET (TRDTBL NEW-IL-RDTBL)
|
||||||
(PROGN (* ; "The ORIG read table")
|
(PROGN (* ; "The ORIG read table")
|
||||||
(SETQ \ORIGREADTABLE (\ORIGREADTABLE))
|
(SETQ \ORIGREADTABLE (\ORIGREADTABLE))
|
||||||
(READTABLEPROP \ORIGREADTABLE 'NAME 'ORIG))
|
(READTABLEPROP \ORIGREADTABLE 'NAME 'ORIG))
|
||||||
(PROGN (* ;
|
(PROGN (* ;
|
||||||
"The old Interlisp T read table. May not have a use for this any more")
|
"The old Interlisp T read table. May not have a use for this any more")
|
||||||
(SETQ TRDTBL (COPYREADTABLE \ORIGREADTABLE))
|
(SETQ TRDTBL (COPYREADTABLE \ORIGREADTABLE))
|
||||||
(SETSYNTAX (CHARCODE "|")
|
(SETSYNTAX (CHARCODE "|")
|
||||||
'(MACRO READVBAR)
|
'(MACRO READVBAR)
|
||||||
@@ -1767,9 +1765,9 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
|
|||||||
'(MACRO FIRST READQUOTE)
|
'(MACRO FIRST READQUOTE)
|
||||||
TRDTBL)
|
TRDTBL)
|
||||||
(READTABLEPROP TRDTBL 'NAME "OLD-INTERLISP-T")
|
(READTABLEPROP TRDTBL 'NAME "OLD-INTERLISP-T")
|
||||||
(PROGN (* ; "Temporary")
|
(PROGN (* ; "Temporary")
|
||||||
(SETTOPVAL '%#CURRENTRDTBL# TRDTBL)))
|
(SETTOPVAL '%#CURRENTRDTBL# TRDTBL)))
|
||||||
(PROGN (* ; "The old FILERDTBL")
|
(PROGN (* ; "The old FILERDTBL")
|
||||||
(SETQ FILERDTBL (COPYREADTABLE \ORIGREADTABLE))
|
(SETQ FILERDTBL (COPYREADTABLE \ORIGREADTABLE))
|
||||||
(SETSYNTAX (CHARCODE "|")
|
(SETSYNTAX (CHARCODE "|")
|
||||||
TRDTBL FILERDTBL)
|
TRDTBL FILERDTBL)
|
||||||
@@ -1778,12 +1776,12 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
|
|||||||
(create READER-ENVIRONMENT
|
(create READER-ENVIRONMENT
|
||||||
REREADTABLE _ FILERDTBL
|
REREADTABLE _ FILERDTBL
|
||||||
REBASE _ 10
|
REBASE _ 10
|
||||||
REFORMAT _ :XCCS)) (* ;
|
REFORMAT _ :MCCS)) (* ;
|
||||||
"need this to read files in the loadup")
|
"need this to read files in the loadup")
|
||||||
)
|
)
|
||||||
(PROGN (SETQ NEW-IL-RDTBL (COPYREADTABLE TRDTBL))
|
(PROGN (SETQ NEW-IL-RDTBL (COPYREADTABLE TRDTBL))
|
||||||
(* ;
|
(* ;
|
||||||
"The new Interlisp read table is more common lispy")
|
"The new Interlisp read table is more common lispy")
|
||||||
(READTABLEPROP NEW-IL-RDTBL 'MULTIPLE-ESCAPECHAR (CHARCODE "|"))
|
(READTABLEPROP NEW-IL-RDTBL 'MULTIPLE-ESCAPECHAR (CHARCODE "|"))
|
||||||
(READTABLEPROP NEW-IL-RDTBL 'HASHMACROCHAR (CHARCODE "#"))
|
(READTABLEPROP NEW-IL-RDTBL 'HASHMACROCHAR (CHARCODE "#"))
|
||||||
(SET-DEFAULT-HASHMACRO-SETTINGS NEW-IL-RDTBL)
|
(SET-DEFAULT-HASHMACRO-SETTINGS NEW-IL-RDTBL)
|
||||||
@@ -1791,11 +1789,11 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
|
|||||||
(READTABLEPROP NEW-IL-RDTBL 'USESILPACKAGE NIL)
|
(READTABLEPROP NEW-IL-RDTBL 'USESILPACKAGE NIL)
|
||||||
(READTABLEPROP NEW-IL-RDTBL 'NAME "INTERLISP")
|
(READTABLEPROP NEW-IL-RDTBL 'NAME "INTERLISP")
|
||||||
(for I from 1 to 26 do (SETSYNTAX I 'SEPRCHAR FILERDTBL)
|
(for I from 1 to 26 do (SETSYNTAX I 'SEPRCHAR FILERDTBL)
|
||||||
(* ; "Make font switch chars seprs")
|
(* ; "Make font switch chars seprs")
|
||||||
(SETSYNTAX I 'SEPRCHAR NEW-IL-RDTBL))
|
(SETSYNTAX I 'SEPRCHAR NEW-IL-RDTBL))
|
||||||
(SETQ *READTABLE* NEW-IL-RDTBL))
|
(SETQ *READTABLE* NEW-IL-RDTBL))
|
||||||
|
|
||||||
(* ;; "Make ^Y like #. in the old T readtable and the new INTERLISP one.")
|
(* ;; "Make ^Y like #. in the old T readtable and the new INTERLISP one.")
|
||||||
|
|
||||||
(SETSYNTAX (CHARCODE ^Y)
|
(SETSYNTAX (CHARCODE ^Y)
|
||||||
'[MACRO ALWAYS (LAMBDA (FILE RDTBL)
|
'[MACRO ALWAYS (LAMBDA (FILE RDTBL)
|
||||||
@@ -1805,7 +1803,7 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
|
|||||||
TRDTBL NEW-IL-RDTBL)
|
TRDTBL NEW-IL-RDTBL)
|
||||||
(DEFPRINT 'READTABLEP '\READTABLEP.DEFPRINT))
|
(DEFPRINT 'READTABLEP '\READTABLEP.DEFPRINT))
|
||||||
|
|
||||||
(* ;; "Terminal tables")
|
(* ;; "Terminal tables")
|
||||||
|
|
||||||
(SETQ \ORIGTERMTABLE (\ORIGTERMTABLE))
|
(SETQ \ORIGTERMTABLE (\ORIGTERMTABLE))
|
||||||
(SETQ \PRIMTERMTABLE (COPYTERMTABLE \ORIGTERMTABLE))
|
(SETQ \PRIMTERMTABLE (COPYTERMTABLE \ORIGTERMTABLE))
|
||||||
@@ -1868,7 +1866,9 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
|
|||||||
(EQUAL-READER-ENVIRONMENT
|
(EQUAL-READER-ENVIRONMENT
|
||||||
[LAMBDA (ENV1 ENV2)
|
[LAMBDA (ENV1 ENV2)
|
||||||
|
|
||||||
(* ;; "Edited 19-Dec-2021 14:09 by rmk: Replace constant :XCCS with *DEFAULT-EXTERNALFORMAT*")
|
(* ;; "Edited 24-Apr-2025 21:52 by rmk")
|
||||||
|
|
||||||
|
(* ;; "Edited 19-Dec-2021 14:09 by rmk: Use *DEFAULT-EXTERNALFORMAT*")
|
||||||
|
|
||||||
(* ;; "Edited 19-Dec-2021 14:01 by rmk")
|
(* ;; "Edited 19-Dec-2021 14:01 by rmk")
|
||||||
|
|
||||||
@@ -1921,25 +1921,23 @@ Copyright (c) 1982-1987, 1990, 1993, 2018, 2021 by Venue & Xerox Corporation.
|
|||||||
|
|
||||||
(ADDTOVAR LAMA READTABLEPROP)
|
(ADDTOVAR LAMA READTABLEPROP)
|
||||||
)
|
)
|
||||||
(PUTPROPS ATBL COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1990 1993 2018
|
|
||||||
2021))
|
|
||||||
(DECLARE%: DONTCOPY
|
(DECLARE%: DONTCOPY
|
||||||
(FILEMAP (NIL (17749 28901 (GETSYNTAX 17759 . 22590) (SETSYNTAX 22592 . 23665) (SYNTAXP 23667 . 26164)
|
(FILEMAP (NIL (17619 28771 (GETSYNTAX 17629 . 22460) (SETSYNTAX 22462 . 23535) (SYNTAXP 23537 . 26034)
|
||||||
(\COPYSYNTAX 26166 . 26883) (\GETCHARCODE 26885 . 27173) (\SETFATSYNCODE 27175 . 28466) (
|
(\COPYSYNTAX 26036 . 26753) (\GETCHARCODE 26755 . 27043) (\SETFATSYNCODE 27045 . 28336) (
|
||||||
\MAPCHARTABLE 28468 . 28899)) (28934 43900 (CONTROL 28944 . 29196) (COPYTERMTABLE 29198 . 29565) (
|
\MAPCHARTABLE 28338 . 28769)) (28804 43770 (CONTROL 28814 . 29066) (COPYTERMTABLE 29068 . 29435) (
|
||||||
DELETECONTROL 29567 . 32208) (GETDELETECONTROL 32210 . 33172) (ECHOCHAR 33174 . 34615) (ECHOCONTROL
|
DELETECONTROL 29437 . 32078) (GETDELETECONTROL 32080 . 33042) (ECHOCHAR 33044 . 34485) (ECHOCONTROL
|
||||||
34617 . 35074) (ECHOMODE 35076 . 35322) (GETECHOMODE 35324 . 35488) (GETCONTROL 35490 . 35656) (
|
34487 . 34944) (ECHOMODE 34946 . 35192) (GETECHOMODE 35194 . 35358) (GETCONTROL 35360 . 35526) (
|
||||||
GETTERMTABLE 35658 . 35725) (RAISE 35727 . 36153) (GETRAISE 36155 . 36317) (RESETTERMTABLE 36319 .
|
GETTERMTABLE 35528 . 35595) (RAISE 35597 . 36023) (GETRAISE 36025 . 36187) (RESETTERMTABLE 36189 .
|
||||||
37403) (SETTERMTABLE 37405 . 37639) (TERMTABLEP 37641 . 37802) (\GETTERMSYNTAX 37804 . 38075) (
|
37273) (SETTERMTABLE 37275 . 37509) (TERMTABLEP 37511 . 37672) (\GETTERMSYNTAX 37674 . 37945) (
|
||||||
\GTTERMTABLE 38077 . 38413) (\ORIGTERMTABLE 38415 . 42025) (\SETTERMSYNTAX 42027 . 42662) (
|
\GTTERMTABLE 37947 . 38283) (\ORIGTERMTABLE 38285 . 41895) (\SETTERMSYNTAX 41897 . 42532) (
|
||||||
\TERMCLASSTOCODE 42664 . 43093) (\TERMCODETOCLASS 43095 . 43482) (\LITCHECK 43484 . 43898)) (46411
|
\TERMCLASSTOCODE 42534 . 42963) (\TERMCODETOCLASS 42965 . 43352) (\LITCHECK 43354 . 43768)) (46281
|
||||||
70235 (COPYREADTABLE 46421 . 46619) (FIND-READTABLE 46621 . 46768) (IN-READTABLE 46770 . 46930) (
|
70105 (COPYREADTABLE 46291 . 46489) (FIND-READTABLE 46491 . 46638) (IN-READTABLE 46640 . 46800) (
|
||||||
ESCAPE 46932 . 47185) (GETBRK 47187 . 47325) (GETREADTABLE 47327 . 47463) (GETSEPR 47465 . 47603) (
|
ESCAPE 46802 . 47055) (GETBRK 47057 . 47195) (GETREADTABLE 47197 . 47333) (GETSEPR 47335 . 47473) (
|
||||||
READMACROS 47605 . 47868) (READTABLEP 47870 . 48033) (READTABLEPROP 48035 . 53193) (RESETREADTABLE
|
READMACROS 47475 . 47738) (READTABLEP 47740 . 47903) (READTABLEPROP 47905 . 53063) (RESETREADTABLE
|
||||||
53195 . 57442) (SETBRK 57444 . 59054) (SETREADTABLE 59056 . 59244) (SETSEPR 59246 . 60788) (
|
53065 . 57312) (SETBRK 57314 . 58924) (SETREADTABLE 58926 . 59114) (SETSEPR 59116 . 60658) (
|
||||||
\GETREADSYNTAX 60790 . 63480) (\GTREADTABLE 63482 . 63707) (\GTREADTABLE1 63709 . 63965) (
|
\GETREADSYNTAX 60660 . 63350) (\GTREADTABLE 63352 . 63577) (\GTREADTABLE1 63579 . 63835) (
|
||||||
\ORIGREADTABLE 63967 . 65875) (\READCLASSTOCODE 65877 . 66328) (\SETMACROSYNTAX 66330 . 68125) (
|
\ORIGREADTABLE 63837 . 65745) (\READCLASSTOCODE 65747 . 66198) (\SETMACROSYNTAX 66200 . 67995) (
|
||||||
\SETREADSYNTAX 68127 . 69188) (\READTABLEP.DEFPRINT 69190 . 70233)) (83067 87520 (\ATBLSET 83077 .
|
\SETREADSYNTAX 67997 . 69058) (\READTABLEP.DEFPRINT 69060 . 70103)) (82937 87494 (\ATBLSET 82947 .
|
||||||
87518)) (87967 91384 (MAKE-READER-ENVIRONMENT 87977 . 89634) (EQUAL-READER-ENVIRONMENT 89636 . 90786)
|
87492)) (87941 91385 (MAKE-READER-ENVIRONMENT 87951 . 89608) (EQUAL-READER-ENVIRONMENT 89610 . 90787)
|
||||||
(SET-READER-ENVIRONMENT 90788 . 91382)))))
|
(SET-READER-ENVIRONMENT 90789 . 91383)))))
|
||||||
STOP
|
STOP
|
||||||
|
|||||||
Binary file not shown.
@@ -1,12 +1,12 @@
|
|||||||
(DEFINE-FILE-INFO PACKAGE "LISP" READTABLE "XCL" BASE 10)
|
(DEFINE-FILE-INFO PACKAGE "LISP" READTABLE "XCL" BASE 10)
|
||||||
|
|
||||||
(IL:FILECREATED " 5-Sep-2024 17:42:20" IL:|{DSK}<home>matt>Interlisp>medley>sources>LLPACKAGE.;3| 87515
|
(IL:FILECREATED " 2-Nov-2025 19:49:02" IL:|{DSK}<home>matt>Interlisp>medley>sources>LLPACKAGE.;2| 92970
|
||||||
|
|
||||||
:EDIT-BY "mth"
|
:EDIT-BY "mth"
|
||||||
|
|
||||||
:CHANGES-TO (IL:FNS XCL:DEFPACKAGE)
|
:CHANGES-TO (IL:FNS XCL:DEFPACKAGE)
|
||||||
|
|
||||||
:PREVIOUS-DATE " 4-Sep-2024 13:17:23" IL:|{DSK}<home>matt>Interlisp>medley>sources>LLPACKAGE.;2|
|
:PREVIOUS-DATE "30-Oct-2025 14:25:43" IL:|{DSK}<home>matt>Interlisp>medley>sources>LLPACKAGE.;1|
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
@@ -524,7 +524,9 @@
|
|||||||
(IL:DEFINEQ
|
(IL:DEFINEQ
|
||||||
|
|
||||||
(XCL:DEFPACKAGE
|
(XCL:DEFPACKAGE
|
||||||
(IL:NLAMBDA IL:ARGS (IL:* IL:\; "Edited 4-Sep-2024 13:17 by mth")
|
(IL:NLAMBDA IL:ARGS (IL:* IL:\; "Edited 2-Nov-2025 19:48 by mth")
|
||||||
|
(IL:* IL:\; "Edited 30-Oct-2025 11:34 by mth")
|
||||||
|
(IL:* IL:\; "Edited 4-Sep-2024 13:17 by mth")
|
||||||
(IL:* IL:\; "Edited 2-Dec-87 10:39 by raf")
|
(IL:* IL:\; "Edited 2-Dec-87 10:39 by raf")
|
||||||
(IL:SETQ IL:ARGS (XCL:REMOVE-COMMENTS IL:ARGS))
|
(IL:SETQ IL:ARGS (XCL:REMOVE-COMMENTS IL:ARGS))
|
||||||
(LET
|
(LET
|
||||||
@@ -571,6 +573,30 @@
|
|||||||
IL:SYMBOL)))
|
IL:SYMBOL)))
|
||||||
PACKAGE))
|
PACKAGE))
|
||||||
(:IMPORT (IMPORT VALUES PACKAGE))
|
(:IMPORT (IMPORT VALUES PACKAGE))
|
||||||
|
(:IMPORT-FROM (LET* ((PACKAGE-NAME (POP VALUES))
|
||||||
|
(XCL::PACKAGE-FROM (FIND-PACKAGE PACKAGE-NAME)))
|
||||||
|
(IMPORT (IL:MAPCAR VALUES
|
||||||
|
(IL:FUNCTION (IL:LAMBDA (XCL::SN)
|
||||||
|
(COND
|
||||||
|
((IL:LITATOM XCL::SN)
|
||||||
|
(SETQ XCL::SN
|
||||||
|
(SYMBOL-NAME
|
||||||
|
XCL::SN))))
|
||||||
|
(COND
|
||||||
|
((IL:STRINGP XCL::SN)
|
||||||
|
(OR (FIND-SYMBOL
|
||||||
|
XCL::SN
|
||||||
|
XCL::PACKAGE-FROM
|
||||||
|
)
|
||||||
|
(ERROR
|
||||||
|
"Symbol ~S not found in package ~S in :import-from option of defpackage"
|
||||||
|
XCL::SN
|
||||||
|
PACKAGE-NAME
|
||||||
|
)))
|
||||||
|
(T (IL:ERROR
|
||||||
|
"Bad object in :import-from option of defpackage "
|
||||||
|
XCL::SN))))))
|
||||||
|
PACKAGE)))
|
||||||
((:SHADOW :SHADOWING-IMPORT)
|
((:SHADOW :SHADOWING-IMPORT)
|
||||||
(LET ((IL:SYMBOLS-TO-SHADOW (IL:MAPCONC
|
(LET ((IL:SYMBOLS-TO-SHADOW (IL:MAPCONC
|
||||||
VALUES
|
VALUES
|
||||||
@@ -620,7 +646,8 @@
|
|||||||
((:PREFIX-NAME :INTERNAL-SYMBOLS :EXTERNAL-SYMBOLS
|
((:PREFIX-NAME :INTERNAL-SYMBOLS :EXTERNAL-SYMBOLS
|
||||||
:EXTERNAL-ONLY)
|
:EXTERNAL-ONLY)
|
||||||
(LIST IL:KEY (CAR VALUES)))
|
(LIST IL:KEY (CAR VALUES)))
|
||||||
((:SHADOW :EXPORT :IMPORT :SHADOWING-IMPORT)
|
((:SHADOW :EXPORT :IMPORT :IMPORT-FROM
|
||||||
|
:SHADOWING-IMPORT)
|
||||||
(IL:SETQ IL:POST-MAKE-FORMS
|
(IL:SETQ IL:POST-MAKE-FORMS
|
||||||
(CONS (CONS IL:KEY VALUES)
|
(CONS (CONS IL:KEY VALUES)
|
||||||
IL:POST-MAKE-FORMS))
|
IL:POST-MAKE-FORMS))
|
||||||
@@ -648,6 +675,37 @@
|
|||||||
PACKAGE))
|
PACKAGE))
|
||||||
(:IMPORT (IMPORT (CDR IL:FORM)
|
(:IMPORT (IMPORT (CDR IL:FORM)
|
||||||
PACKAGE))
|
PACKAGE))
|
||||||
|
(:IMPORT-FROM (LET* ((PACKAGE-NAME (CADR IL:FORM))
|
||||||
|
(XCL::PACKAGE-FROM (FIND-PACKAGE PACKAGE-NAME)))
|
||||||
|
(IMPORT (IL:MAPCAR (CDDR IL:FORM)
|
||||||
|
(IL:FUNCTION (IL:LAMBDA (XCL::SN)
|
||||||
|
(COND
|
||||||
|
((IL:LITATOM
|
||||||
|
XCL::SN)
|
||||||
|
(SETQ
|
||||||
|
XCL::SN
|
||||||
|
(SYMBOL-NAME
|
||||||
|
XCL::SN))))
|
||||||
|
(COND
|
||||||
|
((IL:STRINGP
|
||||||
|
XCL::SN)
|
||||||
|
(OR
|
||||||
|
(FIND-SYMBOL
|
||||||
|
XCL::SN
|
||||||
|
XCL::PACKAGE-FROM
|
||||||
|
)
|
||||||
|
(ERROR
|
||||||
|
"Symbol ~S not found in package ~S in :import-from option of defpackage"
|
||||||
|
XCL::SN
|
||||||
|
|
||||||
|
PACKAGE-NAME
|
||||||
|
)))
|
||||||
|
(T (IL:ERROR
|
||||||
|
|
||||||
|
"Bad object in :import-from option of defpackage "
|
||||||
|
XCL::SN)))))
|
||||||
|
)
|
||||||
|
PACKAGE)))
|
||||||
(:SHADOWING-IMPORT
|
(:SHADOWING-IMPORT
|
||||||
(SHADOWING-IMPORT (CDR IL:FORM)
|
(SHADOWING-IMPORT (CDR IL:FORM)
|
||||||
PACKAGE))
|
PACKAGE))
|
||||||
@@ -1663,7 +1721,7 @@
|
|||||||
(IL:* IL:|;;| "Proper compiler, readtable and package environment")
|
(IL:* IL:|;;| "Proper compiler, readtable and package environment")
|
||||||
|
|
||||||
|
|
||||||
(IL:PUTPROPS IL:LLPACKAGE IL:FILETYPE COMPILE-FILE)
|
(IL:PUTPROPS IL:LLPACKAGE IL:FILETYPE :FAKE-COMPILE-FILE)
|
||||||
|
|
||||||
(IL:PUTPROPS IL:LLPACKAGE IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE "LISP"))
|
(IL:PUTPROPS IL:LLPACKAGE IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE "LISP"))
|
||||||
(IL:DECLARE\: IL:DONTEVAL@LOAD IL:DOEVAL@COMPILE IL:DONTCOPY IL:COMPILERVARS
|
(IL:DECLARE\: IL:DONTEVAL@LOAD IL:DOEVAL@COMPILE IL:DONTCOPY IL:COMPILERVARS
|
||||||
@@ -1691,23 +1749,23 @@ IL:\\PKG-FIND-FREE-PACKAGE-INDEX 17838 . 18248)) (18305 18451 (IL:SETF-SYMBOL-PA
|
|||||||
IL:ENTRY-HASH 20528 . 20919)) (20968 21314 (IL:COUNT-PACKAGE-HASHTABLE 20968 . 21314)) (21316 21488 (
|
IL:ENTRY-HASH 20528 . 20919)) (20968 21314 (IL:COUNT-PACKAGE-HASHTABLE 20968 . 21314)) (21316 21488 (
|
||||||
IL:INTERNAL-SYMBOL-COUNT 21316 . 21488)) (21490 21608 (IL:EXTERNAL-SYMBOL-COUNT 21490 . 21608)) (21610
|
IL:INTERNAL-SYMBOL-COUNT 21316 . 21488)) (21490 21608 (IL:EXTERNAL-SYMBOL-COUNT 21490 . 21608)) (21610
|
||||||
22766 (IL:ENTER-NEW-NICKNAMES 21610 . 22766)) (22768 23194 (IL:MAKE-PRIME-HASHTABLE-SIZE 22768 .
|
22766 (IL:ENTER-NEW-NICKNAMES 21610 . 22766)) (22768 23194 (IL:MAKE-PRIME-HASHTABLE-SIZE 22768 .
|
||||||
23194)) (23196 24845 (MAKE-PACKAGE 23196 . 24845)) (24846 34317 (XCL:DEFPACKAGE 24859 . 34315)) (34366
|
23194)) (23196 24845 (MAKE-PACKAGE 23196 . 24845)) (24846 39766 (XCL:DEFPACKAGE 24859 . 39764)) (39815
|
||||||
34588 (FIND-PACKAGE 34366 . 34588)) (34590 37951 (USE-PACKAGE 34590 . 37951)) (37953 38433 (
|
40037 (FIND-PACKAGE 39815 . 40037)) (40039 43400 (USE-PACKAGE 40039 . 43400)) (43402 43882 (
|
||||||
IN-PACKAGE 37953 . 38433)) (38435 38709 (XCL:PKG-GOTO 38435 . 38709)) (38711 39811 (RENAME-PACKAGE
|
IN-PACKAGE 43402 . 43882)) (43884 44158 (XCL:PKG-GOTO 43884 . 44158)) (44160 45260 (RENAME-PACKAGE
|
||||||
38711 . 39811)) (39813 41264 (XCL:DELETE-PACKAGE 39813 . 41264)) (41266 44212 (EXPORT 41266 . 44212))
|
44160 . 45260)) (45262 46713 (XCL:DELETE-PACKAGE 45262 . 46713)) (46715 49661 (EXPORT 46715 . 49661))
|
||||||
(44214 45457 (UNEXPORT 44214 . 45457)) (45459 47103 (IMPORT 45459 . 47103)) (47105 48385 (
|
(49663 50906 (UNEXPORT 49663 . 50906)) (50908 52552 (IMPORT 50908 . 52552)) (52554 53834 (
|
||||||
SHADOWING-IMPORT 47105 . 48385)) (48387 49441 (SHADOW 48387 . 49441)) (49443 50098 (UNUSE-PACKAGE
|
SHADOWING-IMPORT 52554 . 53834)) (53836 54890 (SHADOW 53836 . 54890)) (54892 55547 (UNUSE-PACKAGE
|
||||||
49443 . 50098)) (50162 50468 (LIST-ALL-PACKAGES 50162 . 50468)) (50525 54208 (IL:ADD-SYMBOL 50525 .
|
54892 . 55547)) (55611 55917 (LIST-ALL-PACKAGES 55611 . 55917)) (55974 59657 (IL:ADD-SYMBOL 55974 .
|
||||||
54208)) (54210 58263 (IL:WITH-SYMBOL 54210 . 58263)) (58265 59568 (IL:INTERN* 58265 . 59568)) (59570
|
59657)) (59659 63712 (IL:WITH-SYMBOL 59659 . 63712)) (63714 65017 (IL:INTERN* 63714 . 65017)) (65019
|
||||||
65402 (IL:FIND-SYMBOL* 59570 . 65402)) (65404 66855 (INTERN 65404 . 66855)) (66857 67435 (FIND-SYMBOL
|
70851 (IL:FIND-SYMBOL* 65019 . 70851)) (70853 72304 (INTERN 70853 . 72304)) (72306 72884 (FIND-SYMBOL
|
||||||
66857 . 67435)) (67493 68389 (IL:NUKE-SYMBOL 67493 . 68389)) (68391 70505 (UNINTERN 68391 . 70505)) (
|
72306 . 72884)) (72942 73838 (IL:NUKE-SYMBOL 72942 . 73838)) (73840 75954 (UNINTERN 73840 . 75954)) (
|
||||||
70507 71650 (IL:MOBY-UNINTERN 70507 . 71650)) (71709 71781 (IL:\\INDEXATOMPNAME 71709 . 71781)) (71893
|
75956 77099 (IL:MOBY-UNINTERN 75956 . 77099)) (77158 77230 (IL:\\INDEXATOMPNAME 77158 . 77230)) (77342
|
||||||
72040 (IL:MAKE-DO-SYMBOLS-VARS 71893 . 72040)) (72042 73497 (IL:MAKE-DO-SYMBOLS-CODE 72042 . 73497))
|
77489 (IL:MAKE-DO-SYMBOLS-VARS 77342 . 77489)) (77491 78946 (IL:MAKE-DO-SYMBOLS-CODE 77491 . 78946))
|
||||||
(73501 74279 (DO-EXTERNAL-SYMBOLS 73501 . 74279)) (74281 75627 (XCL:DO-LOCAL-SYMBOLS 74281 . 75627)) (
|
(78950 79728 (DO-EXTERNAL-SYMBOLS 78950 . 79728)) (79730 81076 (XCL:DO-LOCAL-SYMBOLS 79730 . 81076)) (
|
||||||
75629 76745 (XCL:DO-INTERNAL-SYMBOLS 75629 . 76745)) (76747 79045 (DO-SYMBOLS 76747 . 79045)) (79047
|
81078 82194 (XCL:DO-INTERNAL-SYMBOLS 81078 . 82194)) (82196 84494 (DO-SYMBOLS 82196 . 84494)) (84496
|
||||||
80729 (DO-ALL-SYMBOLS 79047 . 80729)) (80797 81322 (FIND-ALL-SYMBOLS 80797 . 81322)) (81324 81603 (
|
86178 (DO-ALL-SYMBOLS 84496 . 86178)) (86246 86771 (FIND-ALL-SYMBOLS 86246 . 86771)) (86773 87052 (
|
||||||
IL:BRIEFLY-DESCRIBE-SYMBOL 81324 . 81603)) (81605 83119 (APROPOS 81605 . 83119)) (83121 84688 (
|
IL:BRIEFLY-DESCRIBE-SYMBOL 86773 . 87052)) (87054 88568 (APROPOS 87054 . 88568)) (88570 90137 (
|
||||||
APROPOS-LIST 83121 . 84688)) (84792 86319 (IL:FIND-EXTERNAL-SYMBOL 84792 . 86319)) (86321 86841 (
|
APROPOS-LIST 88570 . 90137)) (90241 91768 (IL:FIND-EXTERNAL-SYMBOL 90241 . 91768)) (91770 92290 (
|
||||||
IL:FIND-EXACT-SYMBOL 86321 . 86841)) (86843 86923 (IL:PACKAGE-NAME-AS-SYMBOL 86843 . 86923)) (86925
|
IL:FIND-EXACT-SYMBOL 91770 . 92290)) (92292 92372 (IL:PACKAGE-NAME-AS-SYMBOL 92292 . 92372)) (92374
|
||||||
87074 (IL:\\FIND.PACKAGE.INTERNAL 86925 . 87074)))))
|
92523 (IL:\\FIND.PACKAGE.INTERNAL 92374 . 92523)))))
|
||||||
IL:STOP
|
IL:STOP
|
||||||
|
|||||||
Binary file not shown.
Reference in New Issue
Block a user