-
Notifications
You must be signed in to change notification settings - Fork 0
/
WEBCARD
206 lines (164 loc) · 10.6 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
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "15-Oct-2024 17:15:40" {DSK}<home>paolo>il>webcard>WEBCARD.;23 10511
:EDIT-BY "PA"
:CHANGES-TO (FNS WCD.TraverseWebLink)
:PREVIOUS-DATE "14-Oct-2024 17:18:08" {DSK}<home>paolo>il>webcard>WEBCARD.;22)
(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)
(P (WCD.InitWebCard))
(PROP LinkIconLeftButtonFn Web)))
(* 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 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.)
(NCP.CreateCardType 'Web 'Text '((MakeFn WCD.MakeWebCard))
`((DefaultHeight 70)
(LinkAnchorModesSupported NIL)
(DisplayedInMenuFlg T])
(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])
)
(WCD.InitWebCard)
(PUTPROPS Web LinkIconLeftButtonFn WCD.TraverseWebLink)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (834 10400 (WCD.AskURL 844 . 2479) (WCD.CreateWebCardType 2481 . 3088) (
WCD.EditURLMenuCmd 3090 . 3557) (WCD.InitCard 3559 . 4085) (WCD.InitWebCard 4087 . 4747) (
WCD.MakeWebCard 4749 . 5844) (WCD.TraverseWebLink 5846 . 7289) (WCD.UpdateCardText 7291 . 8283) (
WCD.ValidURLP 8285 . 9702) (WCD.VisitURL 9704 . 10070) (WCD.VisitURLMenuCmd 10072 . 10398)))))
STOP