aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJason Rumney2008-07-14 10:30:56 +0000
committerJason Rumney2008-07-14 10:30:56 +0000
commitaaa5e420779a599d911c150e4b94b03cb3d2cefe (patch)
treef1da7af68755c47a9aba5ba483985dc68a80583e
parent83750bb1cdaadeaea1ac99a3afb17d614eb84ad3 (diff)
downloademacs-aaa5e420779a599d911c150e4b94b03cb3d2cefe.tar.gz
emacs-aaa5e420779a599d911c150e4b94b03cb3d2cefe.zip
(x-handle-switch, x-handle-name-switch)
(x-handle-numeric-switch, x-handle-initial-switch) (x-handle-xrm-switch, x-handle-args, x-handle-display) (xw-defined-colors, w32-initialize-window-system): Avoid use of cl pop and push macros.
-rw-r--r--lisp/ChangeLog8
-rw-r--r--lisp/term/w32-win.el79
2 files changed, 67 insertions, 20 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 76626351a64..61497df6504 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,11 @@
12008-07-14 Jason Rumney <jasonr@gnu.org>
2
3 * term/w32-win.el (x-handle-switch, x-handle-name-switch)
4 (x-handle-numeric-switch, x-handle-initial-switch)
5 (x-handle-xrm-switch, x-handle-args, x-handle-display)
6 (xw-defined-colors, w32-initialize-window-system):
7 Avoid use of cl pop and push macros.
8
12008-07-14 Martin Rudalics <rudalics@gmx.at> 92008-07-14 Martin Rudalics <rudalics@gmx.at>
2 10
3 * add-log.el (change-log-goto-source): Avoid wrong-type-argument 11 * add-log.el (change-log-goto-source): Avoid wrong-type-argument
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index cf867b3505c..298234f465e 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -154,30 +154,53 @@ the last file dropped is selected."
154 "Handle SWITCH of the form \"-switch value\" or \"-switch\"." 154 "Handle SWITCH of the form \"-switch value\" or \"-switch\"."
155 (let ((aelt (assoc switch command-line-x-option-alist))) 155 (let ((aelt (assoc switch command-line-x-option-alist)))
156 (if aelt 156 (if aelt
157 (push (cons (nth 3 aelt) (or (nth 4 aelt) (pop x-invocation-args))) 157 (let ((param (nth 3 aelt))
158 default-frame-alist)))) 158 (value (nth 4 aelt)))
159 (if value
160 (setq default-frame-alist
161 (cons (cons param value)
162 default-frame-alist))
163 (setq default-frame-alist
164 (cons (cons param
165 (car x-invocation-args))
166 default-frame-alist)
167 x-invocation-args (cdr x-invocation-args)))))))
159 168
160(defun x-handle-numeric-switch (switch) 169(defun x-handle-numeric-switch (switch)
161 "Handle SWITCH of the form \"-switch n\"." 170 "Handle SWITCH of the form \"-switch n\"."
162 (let ((aelt (assoc switch command-line-x-option-alist))) 171 (let ((aelt (assoc switch command-line-x-option-alist)))
163 (if aelt 172 (if aelt
164 (push (cons (nth 3 aelt) (string-to-number (pop x-invocation-args))) 173 (let ((param (nth 3 aelt)))
165 default-frame-alist)))) 174 (setq default-frame-alist
175 (cons (cons param
176 (string-to-number (car x-invocation-args)))
177 default-frame-alist)
178 x-invocation-args
179 (cdr x-invocation-args))))))
166 180
167;; Handle options that apply to initial frame only 181;; Handle options that apply to initial frame only
168(defun x-handle-initial-switch (switch) 182(defun x-handle-initial-switch (switch)
169 (let ((aelt (assoc switch command-line-x-option-alist))) 183 (let ((aelt (assoc switch command-line-x-option-alist)))
170 (if aelt 184 (if aelt
171 (push (cons (nth 3 aelt) (or (nth 4 aelt) (pop x-invocation-args))) 185 (let ((param (nth 3 aelt))
172 initial-frame-alist)))) 186 (value (nth 4 aelt)))
187 (if value
188 (setq initial-frame-alist
189 (cons (cons param value)
190 initial-frame-alist))
191 (setq initial-frame-alist
192 (cons (cons param
193 (car x-invocation-args))
194 initial-frame-alist)
195 x-invocation-args (cdr x-invocation-args)))))))
173 196
174(defun x-handle-iconic (switch) 197(defun x-handle-iconic (switch)
175 "Make \"-iconic\" SWITCH apply only to the initial frame." 198 "Make \"-iconic\" SWITCH apply only to the initial frame."
176 (push '(visibility . icon) initial-frame-alist)) 199 (setq default-frame-alist (cons '(icon-type) default-frame-alist)))
177 200
178(defun x-handle-xrm-switch (switch) 201(defun x-handle-xrm-switch (switch)
179 "Handle the \"-xrm\" SWITCH." 202 "Handle the \"-xrm\" SWITCH."
180 (or (consp x-invocation-args) 203 (unless (consp x-invocation-args)
181 (error "%s: missing argument to `%s' option" (invocation-name) switch)) 204 (error "%s: missing argument to `%s' option" (invocation-name) switch))
182 (setq x-command-line-resources 205 (setq x-command-line-resources
183 (if (null x-command-line-resources) 206 (if (null x-command-line-resources)
@@ -221,15 +244,26 @@ the last file dropped is selected."
221;; to the option's operand; set the name of the initial frame, too. 244;; to the option's operand; set the name of the initial frame, too.
222 (or (consp x-invocation-args) 245 (or (consp x-invocation-args)
223 (error "%s: missing argument to `%s' option" (invocation-name) switch)) 246 (error "%s: missing argument to `%s' option" (invocation-name) switch))
224 (setq x-resource-name (pop x-invocation-args)) 247 (setq x-resource-name (car x-invocation-args)
225 (push (cons 'name x-resource-name) initial-frame-alist)) 248 x-invocation-args (cdr x-invocation-args))
249 (setq initial-frame-alist (cons (cons 'name x-resource-name)
250 initial-frame-alist)))
226 251
227(defvar x-display-name nil 252(defvar x-display-name nil
228 "The display name specifying server and frame.") 253 "The display name specifying server and frame.")
229 254
230(defun x-handle-display (switch) 255(defun x-handle-display (switch)
231 "Handle the \"-display\" SWITCH." 256 "Handle the \"-display\" SWITCH."
232 (setq x-display-name (pop x-invocation-args))) 257 (setq x-display-name (car x-invocation-args)
258 x-invocation-args (cdr x-invocation-args))
259 ;; Make subshell programs see the same DISPLAY value Emacs really uses.
260 ;; Note that this isn't completely correct, since Emacs can use
261 ;; multiple displays. However, there is no way to tell an already
262 ;; running subshell which display the user is currently typing on.
263
264 ;; On Windows, this will not have any affect on Windows programs,
265 ;; but might be useful for X programs (running under Cygwin, tramp etc).
266 (setenv "DISPLAY" x-display-name))
233 267
234(defun x-handle-args (args) 268(defun x-handle-args (args)
235 "Process the X-related command line options in ARGS. 269 "Process the X-related command line options in ARGS.
@@ -273,7 +307,7 @@ This returns ARGS with the arguments that have been processed removed."
273 (cons argval x-invocation-args))) 307 (cons argval x-invocation-args)))
274 (funcall handler this-switch)) 308 (funcall handler this-switch))
275 (funcall handler this-switch)) 309 (funcall handler this-switch))
276 (push orig-this-switch args)))) 310 (setq args (cons orig-this-switch args)))))
277 (nconc (nreverse args) x-invocation-args)) 311 (nconc (nreverse args) x-invocation-args))
278 312
279;; 313;;
@@ -381,7 +415,7 @@ XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp")
381 (let ((defined-colors nil)) 415 (let ((defined-colors nil))
382 (dolist (this-color (or (mapcar 'car w32-color-map) x-colors)) 416 (dolist (this-color (or (mapcar 'car w32-color-map) x-colors))
383 (and (color-supported-p this-color frame t) 417 (and (color-supported-p this-color frame t)
384 (push this-color defined-colors))) 418 (setq defined-colors (cons this-color defined-colors))))
385 defined-colors)) 419 defined-colors))
386 420
387 421
@@ -507,18 +541,23 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
507 ;; All geometry parms apply to the initial frame. 541 ;; All geometry parms apply to the initial frame.
508 (setq initial-frame-alist (append initial-frame-alist parsed)) 542 (setq initial-frame-alist (append initial-frame-alist parsed))
509 ;; The size parms apply to all frames. 543 ;; The size parms apply to all frames.
510 (if (assq 'height parsed) 544 (if (and (assq 'height parsed)
511 (push (cons 'height (cdr (assq 'height parsed))) 545 (not (assq 'height default-frame-alist)))
512 default-frame-alist)) 546 (setq default-frame-alist
513 (if (assq 'width parsed) 547 (cons (cons 'height (cdr (assq 'height parsed)))
514 (push (cons 'width (cdr (assq 'width parsed))) 548 default-frame-alist))
515 default-frame-alist))))) 549 (if (and (assq 'width parsed)
550 (not (assq 'width default-frame-alist)))
551 (setq default-frame-alist
552 (cons (cons 'width (cdr (assq 'width parsed)))
553 default-frame-alist)))))))
516 554
517 ;; Check the reverseVideo resource. 555 ;; Check the reverseVideo resource.
518 (let ((case-fold-search t)) 556 (let ((case-fold-search t))
519 (let ((rv (x-get-resource "reverseVideo" "ReverseVideo"))) 557 (let ((rv (x-get-resource "reverseVideo" "ReverseVideo")))
520 (if (and rv (string-match "^\\(true\\|yes\\|on\\)$" rv)) 558 (if (and rv (string-match "^\\(true\\|yes\\|on\\)$" rv))
521 (push '(reverse . t) default-frame-alist)))) 559 (setq default-frame-alist
560 (cons '(reverse . t) default-frame-alist)))))
522 561
523 ;; Don't let Emacs suspend under w32 gui 562 ;; Don't let Emacs suspend under w32 gui
524 (add-hook 'suspend-hook 'x-win-suspend-error) 563 (add-hook 'suspend-hook 'x-win-suspend-error)