-
-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy pathDEMO
127 lines (103 loc) · 5.83 KB
/
DEMO
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "24-Mar-2023 11:59:58" {DSK}<home>larry>il>medley>lispusers>DEMO.;3 5662
:EDIT-BY "lmm"
:CHANGES-TO (VARS DEMOCOMS)
:PREVIOUS-DATE "24-Mar-2023 07:29:15" {DSK}<home>larry>il>medley>lispusers>DEMO.;2)
(PRETTYCOMPRINT DEMOCOMS)
(RPAQQ DEMOCOMS ((VARS (HELPTIME 1)
(AUTOBACKTRACEFLG 'ALWAYS))
(COMS * BKSYSOBJCOMS)
(FNS MEDLEY-CONTRIB OPEN-URL)))
(RPAQQ HELPTIME 1)
(RPAQQ AUTOBACKTRACEFLG ALWAYS)
(RPAQQ BKSYSOBJCOMS [(FNS BKSYSOBJ BKSYSOBJ.BUTTONEVENTINFN BKSYSOBJ.COPYBUTTONEVENTINFN
BKSYSOBJ.DISPLAYFN BKSYSOBJ.FINDEXEC BKSYSOBJ.IMAGEBOXFN)
(INITVARS (BKSYSOBJFNS (IMAGEFNSCREATE 'BKSYSOBJ.DISPLAYFN 'BKSYSOBJ.IMAGEBOXFN
NIL NIL NIL 'BKSYSOBJ.BUTTONEVENTINFN
'BKSYSOBJ.COPYBUTTONEVENTINFN])
(DEFINEQ
(BKSYSOBJ
[LAMBDA (STRING) (* ; "Edited 18-Mar-2023 12:52 by rmk")
(IMAGEOBJCREATE STRING BKSYSOBJFNS])
(BKSYSOBJ.BUTTONEVENTINFN
[LAMBDA (OBJ WINDOW) (* ; "Edited 18-Mar-2023 13:51 by rmk")
(LET [(EXECW (BKSYSOBJ.FINDEXEC))
(STR (IMAGEOBJPROP OBJ 'OBJECTDATUM]
(CL:WHEN (MEMB (NTHCHARCODE STR -1)
(CHARCODE (%) %])))
(SETQ STR (SUBSTRING STR 1 -2)))
(CL:WHEN EXECW
(GIVE.TTY.PROCESS EXECW)
(BKSYSBUF STR))])
(BKSYSOBJ.COPYBUTTONEVENTINFN
[LAMBDA (OBJ WINDOW REGION) (* ; "Edited 3-Jan-2022 08:36 by rmk")
(CL:WHEN (CAR (IMAGEOBJPROP OBJ 'COMPAREDATA))
[COPYINSERT (CAR (IMAGEOBJPROP OBJ 'COMPAREDATA])])
(BKSYSOBJ.DISPLAYFN
[LAMBDA (OBJ WINDOW) (* ; "Edited 18-Mar-2023 13:04 by rmk")
(DSPFONT DEFAULTFONT WINDOW)
(FOR I C (FONTARRAY _ (FONTMAPARRAY))
(STRING _ (IMAGEOBJPROP OBJ 'OBJECTDATUM)) FROM 1
DO (SELCHARQ (SETQ C (NTHCHARCODE STRING I))
(EOL (TERPRI WINDOW))
(NIL (RETURN))
(IF (EQ C (CONSTANT (CHARCODE.DECODE FONTESCAPECHAR)))
THEN (DSPFONT (ELT FONTARRAY (NTHCHARCODE STRING (ADD I 1)))
WINDOW)
ELSE (PRINTCCODE C WINDOW])
(BKSYSOBJ.FINDEXEC
[LAMBDA NIL (* ; "Edited 18-Mar-2023 13:45 by rmk")
(* ;; "Finds the first exec with an Interlisp read table.")
(find W P in (OPENWINDOWS) suchthat (SETQ P (WINDOWPROP W 'PROCESS))
(AND (STRPOS "EXEC" (PROCESSPROP P 'NAME)
1 NIL T)
(STREQUAL "INTERLISP" (READTABLEPROP
(LISTGET (PROCESSPROP P 'PROFILE)
'*READTABLE*)
'NAME])
(BKSYSOBJ.IMAGEBOXFN
[LAMBDA (OBJ IMAGESTREAM CURRENTX RIGHTMARGIN) (* ; "Edited 18-Mar-2023 13:04 by rmk")
(* ;; "Calculate the height of each line, and the width of the widest line.")
(* ;;
"Probably ought to compute the max height per line, at every font change, add it at each EOL.")
(SETQ IMAGESTREAM (GETSTREAM IMAGESTREAM 'OUTPUT))
(FOR I C (STRING _ (IMAGEOBJPROP OBJ 'OBJECTDATUM))
(FONT _ (FONTCREATE DEFAULTFONT NIL NIL NIL IMAGESTREAM))
(HEIGHT _ 0)
(LINELENGTH _ 0)
(MAXLINELENGTH _ 0)
(FONTARRAY _ (FONTMAPARRAY)) FROM 1
DO (SELCHARQ (SETQ C (NTHCHARCODE STRING I))
(EOL (ADD HEIGHT (FONTPROP FONT 'HEIGHT))
(CL:WHEN (IGREATERP LINELENGTH MAXLINELENGTH)
(SETQ MAXLINELENGTH LINELENGTH))
(SETQ LINELENGTH 0))
(NIL (* ; "end of string")
(CL:WHEN (IGREATERP LINELENGTH MAXLINELENGTH)
(SETQ MAXLINELENGTH LINELENGTH))
(RETURN (CREATE IMAGEBOX
XSIZE _ MAXLINELENGTH
YSIZE _ HEIGHT
YDESC _ (DIFFERENCE HEIGHT (FONTPROP FONT 'HEIGHT))
XKERN _ 0)))
(IF (EQ C (CONSTANT (CHARCODE.DECODE FONTESCAPECHAR)))
THEN (SETQ FONT (FONTCREATE (ELT FONTARRAY (NTHCHARCODE STRING (ADD I 1)))
NIL NIL NIL IMAGESTREAM))
ELSE (ADD LINELENGTH (CHARWIDTH C FONT])
)
(RPAQ? BKSYSOBJFNS (IMAGEFNSCREATE 'BKSYSOBJ.DISPLAYFN 'BKSYSOBJ.IMAGEBOXFN NIL NIL NIL
'BKSYSOBJ.BUTTONEVENTINFN 'BKSYSOBJ.COPYBUTTONEVENTINFN))
(DEFINEQ
(MEDLEY-CONTRIB
[LAMBDA (REPO) (* ; "Edited 15-Mar-2023 08:05 by lmm")
(OPEN-URL (CONCAT "https://github.com/Interlisp/" REPO "/graphs/contributors"])
(OPEN-URL
[LAMBDA (URL) (* ; "Edited 24-Mar-2023 06:31 by lmm")
(ShellBrowse URL])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1038 5085 (BKSYSOBJ 1048 . 1211) (BKSYSOBJ.BUTTONEVENTINFN 1213 . 1668) (
BKSYSOBJ.COPYBUTTONEVENTINFN 1670 . 1923) (BKSYSOBJ.DISPLAYFN 1925 . 2572) (BKSYSOBJ.FINDEXEC 2574 .
3334) (BKSYSOBJ.IMAGEBOXFN 3336 . 5083)) (5264 5639 (MEDLEY-CONTRIB 5274 . 5490) (OPEN-URL 5492 . 5637
)))))
STOP