-
Notifications
You must be signed in to change notification settings - Fork 0
/
WEBCARD
215 lines (173 loc) · 11.3 KB
/
WEBCARD
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
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "22-Oct-2024 18:47:47" {DSK}<home>paolo>il>webcard>WEBCARD.;26 11178
:EDIT-BY "PA"
:CHANGES-TO (VARS WEBCARDCOMS)
(FNS WCD.CreateWebCardType)
:PREVIOUS-DATE "22-Oct-2024 12:13:33" {DSK}<home>paolo>il>webcard>WEBCARD.;25)
(PRETTYCOMPRINT WEBCARDCOMS)
(RPAQQ WEBCARDCOMS
((* A NoteCards extension for visiting websites.)
(FNS WCD.AskURL WCD.CreateWebCardType WCD.EditURLMenuCmd WCD.InitCard WCD.InitWebCard
WCD.MakeWebCard WCD.TraverseWebLink WCD.UpdateCardText WCD.ValidURLP WCD.VisitURL
WCD.VisitURLMenuCmd)
(BITMAPS (WCD.WebCardBitMap #*(21 18)OOOOOH@@OOOOOH@@OOOOOH@@OOOOOH@@H@@@@H@@H@G@@H@@HAJL@H@@HBJJ@H@@HGOO@H@@HEBE@H@@HGOO@H@@HEBE@H@@HGOO@H@@HBJJ@H@@HAJL@H@@H@G@@H@@H@@@@H@@OOOOOH@@
))
(P (WCD.InitWebCard))))
(* A NoteCards extension for visiting websites.)
(DEFINEQ
(WCD.AskURL
[LAMBDA (MainWindow Default) (* ; "Edited 13-Oct-2024 18:59 by PA")
(* ; "Edited 9-Oct-2024 16:50 by PA")
(* ; "Edited 3-Oct-2024 14:00 by PA")
(* Ask for a URL in a dialog attached to MainWindow and return the URL.
Provides Default as a URL prefix that can be edited.
If MainWindow is NIL then the top level prompt window is used.)
(bind (URL _ NIL)
(ValidURLP _ NIL) until ValidURLP do (SETQ URL (NCP.AskUser "Enter full URL" ": "
(if Default
then Default
else "")
NIL MainWindow NIL NIL T))
(if (WCD.ValidURLP URL)
then (SETQ ValidURLP T)
else (NCP.PrintMsg MainWindow NIL (CHARACTER 13)
URL
(CHARACTER 13)
"is an invalid URL, try again."
(CHARACTER 13)))
finally (RETURN URL])
(WCD.CreateWebCardType
[LAMBDA NIL (* ; "Edited 22-Oct-2024 18:46 by PA")
(* ; "Edited 21-Oct-2024 13:01 by PA")
(* ; "Edited 14-Oct-2024 11:55 by PA")
(* ; "Edited 1-Oct-2024 17:35 by PA")
(* Define the new card type Web that
inherits from Text.)
(DECLARE (GLOBALVARS WCD.WebCardBitMap))
[NCP.CreateCardType 'Web 'Text '((MakeFn WCD.MakeWebCard))
`((DefaultHeight 70)
(LinkAnchorModesSupported NIL)
(DisplayedInMenuFlg T)
(LinkIconAttachedBitMap ,WCD.WebCardBitMap]
(PUTPROP 'Web 'LinkIconLeftButtonFn 'WCD.TraverseWebLink])
(WCD.EditURLMenuCmd
[LAMBDA (Window) (* ; "Edited 12-Oct-2024 19:32 by PA")
(* Edit the URL associated with the card when the user selects the relevant
option of the card's left-click menu.)
(LET* [(Card (NCP.CoerceToCard Window))
(URL (WCD.AskURL Window (NCP.CardProp Card 'URL]
(NCP.CardProp Card 'URL URL)
(WCD.UpdateCardText Card URL])
(WCD.InitCard
[LAMBDA (Card Title URL NoDisplayFlg) (* ; "Edited 14-Oct-2024 13:50 by PA")
(* Initialize new card of type Web by
setting Title and URL.
Returns Card.)
(NCP.CardProp Card 'URL URL)
(NCP.CardTitle Card (OR Title "Untitled"))
(WCD.UpdateCardText Card URL)
Card])
(WCD.InitWebCard
[LAMBDA NIL (* ; "Edited 11-Oct-2024 18:22 by PA")
(* Initialize the Web card type.)
(WCD.CreateWebCardType)
(NCP.AddTitleBarMenuItemsToType 'Web 'Left '((Visit% URL (FUNCTION WCD.VisitURLMenuCmd)
"Open the website associated with the card.")
(Edit% URL (FUNCTION WCD.EditURLMenuCmd)
"Edit the URL associated with the card."))
'Top])
(WCD.MakeWebCard
[LAMBDA (Card Title NoDisplayFlg) (* ; "Edited 14-Oct-2024 13:52 by PA")
(* ; "Edited 12-Oct-2024 19:22 by PA")
(* ; "Edited 9-Oct-2024 14:08 by PA")
(* ; "Edited 3-Oct-2024 13:58 by PA")
(* ; "Edited 1-Oct-2024 17:51 by PA")
(* Make a new card of type Web. Return the window of the new card if NoDisplayFlg
is non-NIL, and the ID if NoDisplayFlg is NIL.)
(LET* [(Window (NCP.ApplySuperTypeFn MakeFn Card Card Title NoDisplayFlg))
(URL (WCD.AskURL (if NoDisplayFlg
then NIL
else Window]
(WCD.InitCard Card Title URL NoDisplayFlg)
(if (NOT NoDisplayFlg)
then Window
else Card])
(WCD.TraverseWebLink
[LAMBDA (Card Window) (* ; "Edited 15-Oct-2024 17:13 by PA")
(* ; "Edited 13-Oct-2024 10:55 by PA")
(* ; "Edited 9-Oct-2024 17:16 by PA")
(* ; "Edited 5-Oct-2024 19:50 by PA")
(* ; "Edited 4-Oct-2024 18:43 by PA")
(* Open in the system web browser the URL associated with the destination Web
Card. Also opens the card and returns it.
The Window containing the link icon is ignored.)
(if (NCP.ValidCardP Card)
then (NCP.OpenCard Card)
(* Make card text read only. Notefiles don't preserve the read only state which
is a runtime property, so this is necessary for not yet opened cards from newly
loaded notefiles. To catch this the first link traversal triggers read only.)
(TEXTPROP (NCP.CardSubstance Card)
'READONLY T)
(LET ((Window (NCP.CardWindow Card)))
(if (NOT (WINDOWPROP Window 'URLVisitedP))
then (WCD.VisitURL Card)
(WINDOWPROP Window 'URLVisitedP T])
(WCD.UpdateCardText
[LAMBDA (Card NewText) (* ; "Edited 14-Oct-2024 14:47 by PA")
(* Replace the Card text with NewText.)
(LET ((TextStream (NCP.CardSubstance Card))
(Window (NCP.WindowFromCard Card)))
(* Set the card text to read-write, clear the existing text, insert the new text,
and make the text read only again,)
(TEXTPROP TextStream 'READONLY NIL) (* Clear card text.)
(TEDIT.DELETE TextStream 1 (TEDIT.NCHARS TextStream))
(NCP.CardAddText Card URL 'END) (* If the card is displayed in a
window scroll it back to the top.)
(if Window
then (SCROLLW Window 0.0 0.0)) (* Make card text read only.)
(TEXTPROP TextStream 'READONLY T])
(WCD.ValidURLP
[LAMBDA (String) (* ; "Edited 14-Oct-2024 17:17 by PA")
(* ; "Edited 7-Oct-2024 13:21 by PA")
(* Return String if it is a valid URL, NIL otherwise.
A URL is valid if it is not null, contains no spaces or tabs, and starts with
https%://, http%://, or mailto%:.)
(LET ((LowerString (L-CASE String)))
(if [AND LowerString (STRINGP LowerString)
(NOT (STRPOS " " LowerString))
(LET ((Length (NCHARS LowerString))) (* Text stored in card properties must
be less than 255 characters.)
(AND (LEQ Length 255)
(OR (AND (EQP (STRPOS "https://" LowerString)
1)
(GREATERP Length 8))
(AND (EQP (STRPOS "http://" LowerString)
1)
(GREATERP Length 7))
(AND (EQP (STRPOS "mailto:" LowerString)
1)
(GREATERP Length 7]
then String
else NIL])
(WCD.VisitURL
[LAMBDA (Card) (* ; "Edited 9-Oct-2024 17:15 by PA")
(* Visit the URL associated with Card. Commands the browser to of the host
operating system to open the URL.)
(LET [(URL (NCP.CardProp Card 'URL]
(if URL
then (ShellBrowse URL])
(WCD.VisitURLMenuCmd
[LAMBDA (Window) (* ; "Edited 11-Oct-2024 18:03 by PA")
(* Visit the URL associated with the card when the user selects the relevant
option of the card's left-click menu.)
(WCD.VisitURL (NCP.CoerceToCard Window])
)
(RPAQ WCD.WebCardBitMap #*(21 18)OOOOOH@@OOOOOH@@OOOOOH@@OOOOOH@@H@@@@H@@H@G@@H@@HAJL@H@@HBJJ@H@@HGOO@H@@HEBE@H@@HGOO@H@@HEBE@H@@HGOO@H@@HBJJ@H@@HAJL@H@@H@G@@H@@H@@@@H@@OOOOOH@@
)
(WCD.InitWebCard)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (997 10947 (WCD.AskURL 1007 . 2642) (WCD.CreateWebCardType 2644 . 3635) (
WCD.EditURLMenuCmd 3637 . 4104) (WCD.InitCard 4106 . 4632) (WCD.InitWebCard 4634 . 5294) (
WCD.MakeWebCard 5296 . 6391) (WCD.TraverseWebLink 6393 . 7836) (WCD.UpdateCardText 7838 . 8830) (
WCD.ValidURLP 8832 . 10249) (WCD.VisitURL 10251 . 10617) (WCD.VisitURLMenuCmd 10619 . 10945)))))
STOP