/[emacs]/emacs/lisp/term/w32-win.el
ViewVC logotype

Diff of /emacs/lisp/term/w32-win.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.64 by jasonr, Sat Jan 22 23:49:06 2005 UTC revision 1.65 by monnier, Sun Jan 23 16:56:11 2005 UTC
# Line 1  Line 1 
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
# Line 139  the last file dropped is selected." Line 139  the last file dropped is selected."
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."
# Line 226  the last file dropped is selected." Line 202  the last file dropped is selected."
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.
# Line 281  This returns ARGS with the arguments tha Line 254  This returns ARGS with the arguments tha
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  ;;  ;;
# Line 1046  XConsortium: rgb.txt,v 10.41 94/02/20 18 Line 1019  XConsortium: rgb.txt,v 10.41 94/02/20 18
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    
# Line 1076  XConsortium: rgb.txt,v 10.41 94/02/20 18 Line 1044  XConsortium: rgb.txt,v 10.41 94/02/20 18
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
# Line 1166  See the documentation of `create-fontset Line 1131  See the documentation of `create-fontset
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."
# Line 1244  font dialog to get the matching FONTS. O Line 1205  font dialog to get the matching FONTS. O
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)))))))
# Line 1268  font dialog to get the matching FONTS. O Line 1229  font dialog to get the matching FONTS. O
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

Legend:
Removed from v.1.64  
changed lines
  Added in v.1.65

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26