152 |
|
|
153 |
(defvar x-command-line-resources nil) |
(defvar x-command-line-resources nil) |
154 |
|
|
|
(defconst x-option-alist |
|
|
'(("-bw" . x-handle-numeric-switch) |
|
|
("-d" . x-handle-display) |
|
|
("-display" . x-handle-display) |
|
|
("-name" . x-handle-name-rn-switch) |
|
|
("-rn" . x-handle-name-rn-switch) |
|
|
("-T" . x-handle-switch) |
|
|
("-r" . x-handle-switch) |
|
|
("-rv" . x-handle-switch) |
|
|
("-reverse" . x-handle-switch) |
|
|
("-fn" . x-handle-switch) |
|
|
("-font" . x-handle-switch) |
|
|
("-ib" . x-handle-numeric-switch) |
|
|
("-g" . x-handle-geometry) |
|
|
("-geometry" . x-handle-geometry) |
|
|
("-fg" . x-handle-switch) |
|
|
("-foreground". x-handle-switch) |
|
|
("-bg" . x-handle-switch) |
|
|
("-background". x-handle-switch) |
|
|
("-ms" . x-handle-switch) |
|
|
("-itype" . x-handle-switch) |
|
|
("-i" . x-handle-switch) |
|
|
("-iconic" . x-handle-iconic) |
|
|
("-xrm" . x-handle-xrm-switch) |
|
|
("-cr" . x-handle-switch) |
|
|
("-vb" . x-handle-switch) |
|
|
("-hb" . x-handle-switch) |
|
|
("-bd" . x-handle-switch))) |
|
|
|
|
|
(defconst x-long-option-alist |
|
|
'(("--border-width" . "-bw") |
|
|
("--display" . "-d") |
|
|
("--name" . "-name") |
|
|
("--title" . "-T") |
|
|
("--reverse-video" . "-reverse") |
|
|
("--font" . "-font") |
|
|
("--internal-border" . "-ib") |
|
|
("--geometry" . "-geometry") |
|
|
("--foreground-color" . "-fg") |
|
|
("--background-color" . "-bg") |
|
|
("--mouse-color" . "-ms") |
|
|
("--icon-type" . "-itype") |
|
|
("--iconic" . "-iconic") |
|
|
("--xrm" . "-xrm") |
|
|
("--cursor-color" . "-cr") |
|
|
("--vertical-scroll-bars" . "-vb") |
|
|
("--border-color" . "-bd"))) |
|
|
|
|
|
(defconst x-switch-definitions |
|
|
'(("-name" name) |
|
|
("-T" name) |
|
|
("-r" reverse t) |
|
|
("-rv" reverse t) |
|
|
("-reverse" reverse t) |
|
|
("-fn" font) |
|
|
("-font" font) |
|
|
("-ib" internal-border-width) |
|
|
("-fg" foreground-color) |
|
|
("-foreground" foreground-color) |
|
|
("-bg" background-color) |
|
|
("-background" background-color) |
|
|
("-ms" mouse-color) |
|
|
("-cr" cursor-color) |
|
|
("-itype" icon-type t) |
|
|
("-i" icon-type t) |
|
|
("-vb" vertical-scroll-bars t) |
|
|
("-hb" horizontal-scroll-bars t) |
|
|
("-bd" border-color) |
|
|
("-bw" border-width))) |
|
|
|
|
|
|
|
155 |
(defun x-handle-switch (switch) |
(defun x-handle-switch (switch) |
156 |
"Handle SWITCH of the form \"-switch value\" or \"-switch\"." |
"Handle SWITCH of the form \"-switch value\" or \"-switch\"." |
157 |
(let ((aelt (assoc switch x-switch-definitions))) |
(let ((aelt (assoc switch command-line-x-option-alist))) |
158 |
(if aelt |
(if aelt |
159 |
(if (nth 2 aelt) |
(let ((param (nth 3 aelt)) |
160 |
|
(value (nth 4 aelt))) |
161 |
|
(if value |
162 |
|
(setq default-frame-alist |
163 |
|
(cons (cons param value) |
164 |
|
default-frame-alist)) |
165 |
(setq default-frame-alist |
(setq default-frame-alist |
166 |
(cons (cons (nth 1 aelt) (nth 2 aelt)) |
(cons (cons param |
167 |
|
(car x-invocation-args)) |
168 |
default-frame-alist)) |
default-frame-alist)) |
169 |
(setq default-frame-alist |
x-invocation-args (cdr x-invocation-args)))))) |
|
(cons (cons (nth 1 aelt) |
|
|
(car x-invocation-args)) |
|
|
default-frame-alist) |
|
|
x-invocation-args (cdr x-invocation-args)))))) |
|
|
|
|
|
(defun x-handle-iconic (switch) |
|
|
"Make \"-iconic\" SWITCH apply only to the initial frame." |
|
|
(setq initial-frame-alist |
|
|
(cons '(visibility . icon) initial-frame-alist))) |
|
|
|
|
170 |
|
|
171 |
(defun x-handle-numeric-switch (switch) |
(defun x-handle-numeric-switch (switch) |
172 |
"Handle SWITCH of the form \"-switch n\"." |
"Handle SWITCH of the form \"-switch n\"." |
173 |
(let ((aelt (assoc switch x-switch-definitions))) |
(let ((aelt (assoc switch command-line-x-option-alist))) |
174 |
(if aelt |
(if aelt |
175 |
|
(let ((param (nth 3 aelt))) |
176 |
(setq default-frame-alist |
(setq default-frame-alist |
177 |
(cons (cons (nth 1 aelt) |
(cons (cons param |
178 |
(string-to-int (car x-invocation-args))) |
(string-to-int (car x-invocation-args))) |
179 |
default-frame-alist) |
default-frame-alist) |
180 |
x-invocation-args |
x-invocation-args |
181 |
(cdr x-invocation-args))))) |
(cdr x-invocation-args)))))) |
182 |
|
|
183 |
|
;; Handle options that apply to initial frame only |
184 |
|
(defun x-handle-initial-switch (switch) |
185 |
|
(let ((aelt (assoc switch command-line-x-option-alist))) |
186 |
|
(if aelt |
187 |
|
(let ((param (nth 3 aelt)) |
188 |
|
(value (nth 4 aelt))) |
189 |
|
(if value |
190 |
|
(setq initial-frame-alist |
191 |
|
(cons (cons param value) |
192 |
|
initial-frame-alist)) |
193 |
|
(setq initial-frame-alist |
194 |
|
(cons (cons param |
195 |
|
(car x-invocation-args)) |
196 |
|
initial-frame-alist) |
197 |
|
x-invocation-args (cdr x-invocation-args))))))) |
198 |
|
|
199 |
|
(defun x-handle-iconic (switch) |
200 |
|
"Make \"-iconic\" SWITCH apply only to the initial frame." |
201 |
|
(setq initial-frame-alist |
202 |
|
(cons '(visibility . icon) initial-frame-alist))) |
203 |
|
|
204 |
(defun x-handle-xrm-switch (switch) |
(defun x-handle-xrm-switch (switch) |
205 |
"Handle the \"-xrm\" SWITCH." |
"Handle the \"-xrm\" SWITCH." |
206 |
(or (consp x-invocation-args) |
(or (consp x-invocation-args) |
207 |
(error "%s: missing argument to `%s' option" (invocation-name) switch)) |
(error "%s: missing argument to `%s' option" (invocation-name) switch)) |
208 |
(setq x-command-line-resources (car x-invocation-args)) |
(setq x-command-line-resources |
209 |
|
(if (null x-command-line-resources) |
210 |
|
(car x-invocation-args) |
211 |
|
(concat x-command-line-resources "\n" (car x-invocation-args)))) |
212 |
(setq x-invocation-args (cdr x-invocation-args))) |
(setq x-invocation-args (cdr x-invocation-args))) |
213 |
|
|
214 |
(defun x-handle-geometry (switch) |
(defun x-handle-geometry (switch) |
232 |
(if top (list top))))) |
(if top (list top))))) |
233 |
(setq x-invocation-args (cdr x-invocation-args)))) |
(setq x-invocation-args (cdr x-invocation-args)))) |
234 |
|
|
235 |
(defun x-handle-name-rn-switch (switch) |
(defun x-handle-name-switch (switch) |
236 |
"Handle a \"-name\" or \"-rn\" SWITCH." |
"Handle a \"-name\" SWITCH." |
237 |
;; Handle the -name and -rn options. Set the variable x-resource-name |
;; Handle the -name option. Set the variable x-resource-name |
238 |
;; to the option's operand; if the switch was `-name', set the name of |
;; to the option's operand; set the name of the initial frame, too. |
|
;; the initial frame, too. |
|
239 |
(or (consp x-invocation-args) |
(or (consp x-invocation-args) |
240 |
(error "%s: missing argument to `%s' option" (invocation-name) switch)) |
(error "%s: missing argument to `%s' option" (invocation-name) switch)) |
241 |
(setq x-resource-name (car x-invocation-args) |
(setq x-resource-name (car x-invocation-args) |
242 |
x-invocation-args (cdr x-invocation-args)) |
x-invocation-args (cdr x-invocation-args)) |
243 |
(if (string= switch "-name") |
(setq initial-frame-alist (cons (cons 'name x-resource-name) |
244 |
(setq initial-frame-alist (cons (cons 'name x-resource-name) |
initial-frame-alist))) |
|
initial-frame-alist)))) |
|
245 |
|
|
246 |
(defvar x-display-name nil |
(defvar x-display-name nil |
247 |
"The display name specifying server and frame.") |
"The display name specifying server and frame.") |
251 |
(setq x-display-name (car x-invocation-args) |
(setq x-display-name (car x-invocation-args) |
252 |
x-invocation-args (cdr x-invocation-args))) |
x-invocation-args (cdr x-invocation-args))) |
253 |
|
|
|
(defvar x-invocation-args nil) |
|
|
|
|
254 |
(defun x-handle-args (args) |
(defun x-handle-args (args) |
255 |
"Process the X-related command line options in ARGS. |
"Process the X-related command line options in ARGS. |
256 |
This is done before the user's startup file is loaded. They are copied to |
This is done before the user's startup file is loaded. They are copied to |
257 |
x-invocation args from which the X-related things are extracted, first |
`x-invocation args' from which the X-related things are extracted, first |
258 |
the switch (e.g., \"-fg\") in the following code, and possible values |
the switch (e.g., \"-fg\") in the following code, and possible values |
259 |
\(e.g., \"black\") in the option handler code (e.g., x-handle-switch). |
\(e.g., \"black\") in the option handler code (e.g., x-handle-switch). |
260 |
This returns ARGS with the arguments that have been processed removed." |
This returns ARGS with the arguments that have been processed removed." |
261 |
|
;; We use ARGS to accumulate the args that we don't handle here, to return. |
262 |
(setq x-invocation-args args |
(setq x-invocation-args args |
263 |
args nil) |
args nil) |
264 |
(while x-invocation-args |
(while (and x-invocation-args |
265 |
|
(not (equal (car x-invocation-args) "--"))) |
266 |
(let* ((this-switch (car x-invocation-args)) |
(let* ((this-switch (car x-invocation-args)) |
267 |
(orig-this-switch this-switch) |
(orig-this-switch this-switch) |
268 |
completion argval aelt) |
completion argval aelt handler) |
269 |
(setq x-invocation-args (cdr x-invocation-args)) |
(setq x-invocation-args (cdr x-invocation-args)) |
270 |
;; Check for long options with attached arguments |
;; Check for long options with attached arguments |
271 |
;; and separate out the attached option argument into argval. |
;; and separate out the attached option argument into argval. |
272 |
(if (string-match "^--[^=]*=" this-switch) |
(if (string-match "^--[^=]*=" this-switch) |
273 |
(setq argval (substring this-switch (match-end 0)) |
(setq argval (substring this-switch (match-end 0)) |
274 |
this-switch (substring this-switch 0 (1- (match-end 0))))) |
this-switch (substring this-switch 0 (1- (match-end 0))))) |
275 |
(setq completion (try-completion this-switch x-long-option-alist)) |
;; Complete names of long options. |
276 |
(if (eq completion t) |
(if (string-match "^--" this-switch) |
277 |
;; Exact match for long option. |
(progn |
278 |
(setq this-switch (cdr (assoc this-switch x-long-option-alist))) |
(setq completion (try-completion this-switch command-line-x-option-alist)) |
279 |
(if (stringp completion) |
(if (eq completion t) |
280 |
(let ((elt (assoc completion x-long-option-alist))) |
;; Exact match for long option. |
281 |
;; Check for abbreviated long option. |
nil |
282 |
(or elt |
(if (stringp completion) |
283 |
(error "Option `%s' is ambiguous" this-switch)) |
(let ((elt (assoc completion command-line-x-option-alist))) |
284 |
(setq this-switch (cdr elt))) |
;; Check for abbreviated long option. |
285 |
;; Check for a short option. |
(or elt |
286 |
(setq argval nil this-switch orig-this-switch))) |
(error "Option `%s' is ambiguous" this-switch)) |
287 |
(setq aelt (assoc this-switch x-option-alist)) |
(setq this-switch completion)))))) |
288 |
(if aelt |
(setq aelt (assoc this-switch command-line-x-option-alist)) |
289 |
|
(if aelt (setq handler (nth 2 aelt))) |
290 |
|
(if handler |
291 |
(if argval |
(if argval |
292 |
(let ((x-invocation-args |
(let ((x-invocation-args |
293 |
(cons argval x-invocation-args))) |
(cons argval x-invocation-args))) |
294 |
(funcall (cdr aelt) this-switch)) |
(funcall handler this-switch)) |
295 |
(funcall (cdr aelt) this-switch)) |
(funcall handler this-switch)) |
296 |
(setq args (cons this-switch args))))) |
(setq args (cons orig-this-switch args))))) |
297 |
(setq args (nreverse args))) |
(nconc (nreverse args) x-invocation-args)) |
|
|
|
|
|
|
298 |
|
|
299 |
;; |
;; |
300 |
;; Available colors |
;; Available colors |