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
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
include <fset.h>
include "xhelp.h"
# XH_OPEN_FILE -- Open the named file and send it to the GUI. If this is
# a help document (i.e. it contains a ".help" block) we first convert it
# to HTML, otherwise send it as is.
procedure xh_open_file (xh, parameter, filename, check_for_help, warn)
pointer xh # task descriptor
char parameter[ARB] # GUI parameter to notify
char filename[ARB] # file to open
int check_for_help # check file for help block?
int warn # warn if not present?
pointer sp, ip, buf, out, text
int fdi, fdo
long fsize
bool has_help
int access(), open(), getline()
int strmatch(), gstrcpy()
long fstatl()
errchk open
define err_ 99
begin
call smark (sp)
call salloc (buf, SZ_LINE, TY_CHAR)
call salloc (out, SZ_FNAME, TY_CHAR)
# Make sure the file exists.
if (access (filename, 0, 0) == NO) {
if (warn == YES) {
call sprintf (Memc[buf], SZ_LINE, "File does not exist:\n`%s'.")
call pargstr (filename)
call gmsg (XH_GP(xh), "alert", Memc[buf])
}
goto err_
} else if (access (filename, 0, BINARY_FILE) == YES) {
if (warn == YES) {
call sprintf (Memc[buf], SZ_LINE,
"Attempt to load binary file:\n`%s'.")
call pargstr (filename)
call gmsg (XH_GP(xh), "alert", "pop")
call gmsg (XH_GP(xh), "alert", Memc[buf])
}
goto err_
}
# If we're told not to look for help simply open the file and send
# it to the GUI (e.g. used for homepage and online help).
if (check_for_help == NO) {
call xh_load_file (xh, parameter, filename)
call sfree (sp)
return
}
# Open the file.
iferr (fdi = open (filename, READ_ONLY, TEXT_FILE)) {
if (warn == YES) {
call sprintf (Memc[buf], SZ_LINE, "Cannot open file\n`%s'.")
call pargstr (filename)
call gmsg (XH_GP(xh), "alert", Memc[buf])
}
goto err_
}
# Allocate an array the length of the file, if this isn't a help file
# we use this as the message buffer and send it to the GUI.
fsize = fstatl (fdi, F_FILESIZE)
call salloc (text, fsize+1, TY_CHAR)
call aclrc (Memc[text], fsize+1)
# See whether this is a help file
has_help = FALSE
ip = text
while (getline (fdi, Memc[buf]) != EOF) {
if (strmatch (Memc[buf], "^.help") > 0) {
has_help = TRUE
break
}
ip = ip + gstrcpy (Memc[buf], Memc[ip], SZ_LINE)
}
Memc[ip] = EOS
# If the file was found to have a .help block we're positioned at
# the beginning of the block. Convert the remainder to an HTML
# temp file and send that to the GUI, otherwise we already have the
# contents of the file in the text buffer so send that.
if (has_help) {
# Create an output filename and open it for writing.
call mktemp ("tmp$xhelpi", Memc[out], SZ_FNAME)
fdo = open (Memc[out], NEW_FILE, TEXT_FILE)
# Convert the remainder to HTML and send it to the GUI.
if (fdo != ERR) {
call lroff2html (fdi, fdo, filename, "", "", "", "")
call close (fdo)
call xh_load_file (xh, "helpres", Memc[out])
call delete (Memc[out])
}
} else {
# No help was found, send the contents straight to the display.
call xh_text_msg (XH_GP(xh), "helpres", Memc[text])
}
err_ if (fdi != ERR)
call close (fdi)
call sfree (sp)
end
# XH_LOAD_FILE -- Load the named file in the GUI.
procedure xh_load_file (xh, parameter, filename)
pointer xh # task descriptor
char parameter[ARB] # GUI parameter to notify
char filename[ARB] # file to display
pointer sp, ip, line, text
int fd, open(), getline(), gstrcpy()
long fsize, fstatl()
errchk open
begin
call smark (sp)
call salloc (line, SZ_LINE, TY_CHAR)
# Open the file and send it to the display.
fd = open (filename, READ_ONLY, TEXT_FILE)
if (fd != ERR) {
fsize = fstatl (fd, F_FILESIZE)
call salloc (text, fsize+1, TY_CHAR)
call aclrc (Memc[text], fsize+1)
for (ip=text; getline (fd, Memc[line]) != EOF; )
ip = ip + gstrcpy (Memc[line], Memc[ip], SZ_LINE)
Memc[ip] = EOS
call close (fd)
call xh_text_msg (XH_GP(xh), parameter, Memc[text])
}
call sfree (sp)
end
# XH_TEXT_MSG -- Send a text message to a named UI parameter but first
# escape all curly braces so it passes through the Tcl correctly.
procedure xh_text_msg (gp, param, msg)
pointer gp
char param[ARB], msg[ARB]
pointer buf, ip
int i, nchars
int strlen()
begin
nchars = strlen (msg)
call calloc (buf, nchars + SZ_LINE, TY_CHAR)
ip = buf
for (i=1; i < nchars; i=i+1) {
if (msg[i] == '{' || msg[i] == '}') {
Memc[ip] = '\\'
ip = ip + 1
}
Memc[ip] = msg[i]
ip = ip + 1
}
call gmsg (gp, "type", "file")
call gmsg (gp, param, Memc[buf])
call mfree (buf, TY_CHAR)
end
|
