1 |
;;; w32-win.el --- parse switches controlling interface with W32 window system |
;;; w32-win.el --- parse switches controlling interface with W32 window system |
2 |
|
|
3 |
;; Copyright (C) 1993, 1994, 2003, 2004 Free Software Foundation, Inc. |
;; Copyright (C) 1993, 1994, 2003, 2004, 2005 Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: Kevin Gallo |
;; Author: Kevin Gallo |
6 |
;; Keywords: terminals |
;; Keywords: terminals |
139 |
"Handle SWITCH of the form \"-switch value\" or \"-switch\"." |
"Handle SWITCH of the form \"-switch value\" or \"-switch\"." |
140 |
(let ((aelt (assoc switch command-line-x-option-alist))) |
(let ((aelt (assoc switch command-line-x-option-alist))) |
141 |
(if aelt |
(if aelt |
142 |
(let ((param (nth 3 aelt)) |
(push (cons (nth 3 aelt) (or (nth 4 aelt) (pop x-invocation-args))) |
143 |
(value (nth 4 aelt))) |
default-frame-alist)))) |
|
(if value |
|
|
(setq default-frame-alist |
|
|
(cons (cons param value) |
|
|
default-frame-alist)) |
|
|
(setq default-frame-alist |
|
|
(cons (cons param |
|
|
(car x-invocation-args)) |
|
|
default-frame-alist) |
|
|
x-invocation-args (cdr x-invocation-args))))))) |
|
144 |
|
|
145 |
(defun x-handle-numeric-switch (switch) |
(defun x-handle-numeric-switch (switch) |
146 |
"Handle SWITCH of the form \"-switch n\"." |
"Handle SWITCH of the form \"-switch n\"." |
147 |
(let ((aelt (assoc switch command-line-x-option-alist))) |
(let ((aelt (assoc switch command-line-x-option-alist))) |
148 |
(if aelt |
(if aelt |
149 |
(let ((param (nth 3 aelt))) |
(push (cons (nth 3 aelt) (string-to-int (pop x-invocation-args))) |
150 |
(setq default-frame-alist |
default-frame-alist)))) |
|
(cons (cons param |
|
|
(string-to-int (car x-invocation-args))) |
|
|
default-frame-alist) |
|
|
x-invocation-args |
|
|
(cdr x-invocation-args)))))) |
|
151 |
|
|
152 |
;; Handle options that apply to initial frame only |
;; Handle options that apply to initial frame only |
153 |
(defun x-handle-initial-switch (switch) |
(defun x-handle-initial-switch (switch) |
154 |
(let ((aelt (assoc switch command-line-x-option-alist))) |
(let ((aelt (assoc switch command-line-x-option-alist))) |
155 |
(if aelt |
(if aelt |
156 |
(let ((param (nth 3 aelt)) |
(push (cons (nth 3 aelt) (or (nth 4 aelt) (pop x-invocation-args))) |
157 |
(value (nth 4 aelt))) |
initial-frame-alist)))) |
|
(if value |
|
|
(setq initial-frame-alist |
|
|
(cons (cons param value) |
|
|
initial-frame-alist)) |
|
|
(setq initial-frame-alist |
|
|
(cons (cons param |
|
|
(car x-invocation-args)) |
|
|
initial-frame-alist) |
|
|
x-invocation-args (cdr x-invocation-args))))))) |
|
158 |
|
|
159 |
(defun x-handle-iconic (switch) |
(defun x-handle-iconic (switch) |
160 |
"Make \"-iconic\" SWITCH apply only to the initial frame." |
"Make \"-iconic\" SWITCH apply only to the initial frame." |
161 |
(setq initial-frame-alist |
(push '(visibility . icon) initial-frame-alist)) |
|
(cons '(visibility . icon) initial-frame-alist))) |
|
162 |
|
|
163 |
(defun x-handle-xrm-switch (switch) |
(defun x-handle-xrm-switch (switch) |
164 |
"Handle the \"-xrm\" SWITCH." |
"Handle the \"-xrm\" SWITCH." |
202 |
;; to the option's operand; set the name of the initial frame, too. |
;; to the option's operand; set the name of the initial frame, too. |
203 |
(or (consp x-invocation-args) |
(or (consp x-invocation-args) |
204 |
(error "%s: missing argument to `%s' option" (invocation-name) switch)) |
(error "%s: missing argument to `%s' option" (invocation-name) switch)) |
205 |
(setq x-resource-name (car x-invocation-args) |
(setq x-resource-name (pop x-invocation-args)) |
206 |
x-invocation-args (cdr x-invocation-args)) |
(push (cons 'name x-resource-name) initial-frame-alist)) |
|
(setq initial-frame-alist (cons (cons 'name x-resource-name) |
|
|
initial-frame-alist))) |
|
207 |
|
|
208 |
(defvar x-display-name nil |
(defvar x-display-name nil |
209 |
"The display name specifying server and frame.") |
"The display name specifying server and frame.") |
210 |
|
|
211 |
(defun x-handle-display (switch) |
(defun x-handle-display (switch) |
212 |
"Handle the \"-display\" SWITCH." |
"Handle the \"-display\" SWITCH." |
213 |
(setq x-display-name (car x-invocation-args) |
(setq x-display-name (pop x-invocation-args))) |
|
x-invocation-args (cdr x-invocation-args))) |
|
214 |
|
|
215 |
(defun x-handle-args (args) |
(defun x-handle-args (args) |
216 |
"Process the X-related command line options in ARGS. |
"Process the X-related command line options in ARGS. |
254 |
(cons argval x-invocation-args))) |
(cons argval x-invocation-args))) |
255 |
(funcall handler this-switch)) |
(funcall handler this-switch)) |
256 |
(funcall handler this-switch)) |
(funcall handler this-switch)) |
257 |
(setq args (cons orig-this-switch args))))) |
(push orig-this-switch args)))) |
258 |
(nconc (nreverse args) x-invocation-args)) |
(nconc (nreverse args) x-invocation-args)) |
259 |
|
|
260 |
;; |
;; |
1019 |
(defun xw-defined-colors (&optional frame) |
(defun xw-defined-colors (&optional frame) |
1020 |
"Internal function called by `defined-colors', which see." |
"Internal function called by `defined-colors', which see." |
1021 |
(or frame (setq frame (selected-frame))) |
(or frame (setq frame (selected-frame))) |
1022 |
(let* ((color-map-colors (mapcar (lambda (clr) (car clr)) w32-color-map)) |
(let ((defined-colors nil)) |
1023 |
(all-colors (or color-map-colors x-colors)) |
(dolist (this-color (or (mapcar 'car w32-color-map) x-colors)) |
|
(this-color nil) |
|
|
(defined-colors nil)) |
|
|
(while all-colors |
|
|
(setq this-color (car all-colors) |
|
|
all-colors (cdr all-colors)) |
|
1024 |
(and (color-supported-p this-color frame t) |
(and (color-supported-p this-color frame t) |
1025 |
(setq defined-colors (cons this-color defined-colors)))) |
(push this-color defined-colors))) |
1026 |
defined-colors)) |
defined-colors)) |
1027 |
|
|
1028 |
|
|
1044 |
|
|
1045 |
;;; Make sure we have a valid resource name. |
;;; Make sure we have a valid resource name. |
1046 |
(or (stringp x-resource-name) |
(or (stringp x-resource-name) |
1047 |
(let (i) |
(setq x-resource-name |
1048 |
(setq x-resource-name (invocation-name)) |
;; Change any . or * characters in x-resource-name to hyphens, |
1049 |
|
;; so as not to choke when we use it in X resource queries. |
1050 |
;; Change any . or * characters in x-resource-name to hyphens, |
(replace-regexp-in-string "[.*]" "-" (invocation-name)))) |
|
;; so as not to choke when we use it in X resource queries. |
|
|
(while (setq i (string-match "[.*]" x-resource-name)) |
|
|
(aset x-resource-name i ?-)))) |
|
1051 |
|
|
1052 |
;; For the benefit of older Emacses (19.27 and earlier) that are sharing |
;; For the benefit of older Emacses (19.27 and earlier) that are sharing |
1053 |
;; the same lisp directory, don't pass the third argument unless we seem |
;; the same lisp directory, don't pass the third argument unless we seem |
1131 |
(setq initial-frame-alist (append initial-frame-alist parsed)) |
(setq initial-frame-alist (append initial-frame-alist parsed)) |
1132 |
;; The size parms apply to all frames. |
;; The size parms apply to all frames. |
1133 |
(if (assq 'height parsed) |
(if (assq 'height parsed) |
1134 |
(setq default-frame-alist |
(push (cons 'height (cdr (assq 'height parsed))) |
1135 |
(cons (cons 'height (cdr (assq 'height parsed))) |
default-frame-alist)) |
|
default-frame-alist))) |
|
1136 |
(if (assq 'width parsed) |
(if (assq 'width parsed) |
1137 |
(setq default-frame-alist |
(push (cons 'width (cdr (assq 'width parsed))) |
1138 |
(cons (cons 'width (cdr (assq 'width parsed))) |
default-frame-alist))))) |
|
default-frame-alist)))))) |
|
1139 |
|
|
1140 |
;; Check the reverseVideo resource. |
;; Check the reverseVideo resource. |
1141 |
(let ((case-fold-search t)) |
(let ((case-fold-search t)) |
1142 |
(let ((rv (x-get-resource "reverseVideo" "ReverseVideo"))) |
(let ((rv (x-get-resource "reverseVideo" "ReverseVideo"))) |
1143 |
(if (and rv |
(if (and rv (string-match "^\\(true\\|yes\\|on\\)$" rv)) |
1144 |
(string-match "^\\(true\\|yes\\|on\\)$" rv)) |
(push '(reverse . t) default-frame-alist)))) |
|
(setq default-frame-alist |
|
|
(cons '(reverse . t) default-frame-alist))))) |
|
1145 |
|
|
1146 |
(defun x-win-suspend-error () |
(defun x-win-suspend-error () |
1147 |
"Report an error when a suspend is attempted." |
"Report an error when a suspend is attempted." |
1205 |
(and chosen-font (list chosen-font))) |
(and chosen-font (list chosen-font))) |
1206 |
(x-popup-menu |
(x-popup-menu |
1207 |
last-nonmenu-event |
last-nonmenu-event |
1208 |
;; Append list of fontsets currently defined. |
;; Append list of fontsets currently defined. |
1209 |
;; Conditional on new-fontset so bootstrapping works on non-GUI compiles |
;; Conditional on new-fontset so bootstrapping works on non-GUI compiles |
1210 |
(if (fboundp 'new-fontset) |
(if (fboundp 'new-fontset) |
1211 |
(append w32-fixed-font-alist (list (generate-fontset-menu))))))) |
(append w32-fixed-font-alist (list (generate-fontset-menu))))))) |
1229 |
(tiff "libtiff3.dll" "libtiff.dll") |
(tiff "libtiff3.dll" "libtiff.dll") |
1230 |
(gif "libungif.dll"))) |
(gif "libungif.dll"))) |
1231 |
|
|
1232 |
;;; arch-tag: 69fb1701-28c2-4890-b351-3d1fe4b4f166 |
;; arch-tag: 69fb1701-28c2-4890-b351-3d1fe4b4f166 |
1233 |
;;; w32-win.el ends here |
;;; w32-win.el ends here |