[Emacs-diffs] Changes to emacs/lisp/term/w32-win.el

[Stefan Monnier]

Index: emacs/lisp/term/w32-win.el
diff -c emacs/lisp/term/w32-win.el:1.64 emacs/lisp/term/w32-win.el:1.65
*** emacs/lisp/term/w32-win.el:1.64     Sat Jan 22 23:49:06 2005
--- emacs/lisp/term/w32-win.el  Sun Jan 23 16:56:11 2005
***************
*** 1,6 ****
  ;;; w32-win.el --- parse switches controlling interface with W32 window system
  
! ;; Copyright (C) 1993, 1994, 2003, 2004 Free Software Foundation, Inc.
  
  ;; Author: Kevin Gallo
  ;; Keywords: terminals
--- 1,6 ----
  ;;; w32-win.el --- parse switches controlling interface with W32 window system
  
! ;; Copyright (C) 1993, 1994, 2003, 2004, 2005  Free Software Foundation, Inc.
  
  ;; Author: Kevin Gallo
  ;; Keywords: terminals
***************
*** 139,188 ****
    "Handle SWITCH of the form \"-switch value\" or \"-switch\"."
    (let ((aelt (assoc switch command-line-x-option-alist)))
      (if aelt
!       (let ((param (nth 3 aelt))
!             (value (nth 4 aelt)))
!         (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)))))))
  
  (defun x-handle-numeric-switch (switch)
    "Handle SWITCH of the form \"-switch n\"."
    (let ((aelt (assoc switch command-line-x-option-alist)))
      (if aelt
!       (let ((param (nth 3 aelt)))
!       (setq default-frame-alist
!             (cons (cons param
!                         (string-to-int (car x-invocation-args)))
!                   default-frame-alist)
!             x-invocation-args
!             (cdr x-invocation-args))))))
  
  ;; Handle options that apply to initial frame only
  (defun x-handle-initial-switch (switch)
    (let ((aelt (assoc switch command-line-x-option-alist)))
      (if aelt
!       (let ((param (nth 3 aelt))
!             (value (nth 4 aelt)))
!         (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)))))))
  
  (defun x-handle-iconic (switch)
    "Make \"-iconic\" SWITCH apply only to the initial frame."
!   (setq initial-frame-alist
!       (cons '(visibility . icon) initial-frame-alist)))
  
  (defun x-handle-xrm-switch (switch)
    "Handle the \"-xrm\" SWITCH."
--- 139,164 ----
    "Handle SWITCH of the form \"-switch value\" or \"-switch\"."
    (let ((aelt (assoc switch command-line-x-option-alist)))
      (if aelt
!       (push (cons (nth 3 aelt) (or (nth 4 aelt) (pop x-invocation-args)))
!             default-frame-alist))))
  
  (defun x-handle-numeric-switch (switch)
    "Handle SWITCH of the form \"-switch n\"."
    (let ((aelt (assoc switch command-line-x-option-alist)))
      (if aelt
!       (push (cons (nth 3 aelt) (string-to-int (pop x-invocation-args)))
!             default-frame-alist))))
  
  ;; Handle options that apply to initial frame only
  (defun x-handle-initial-switch (switch)
    (let ((aelt (assoc switch command-line-x-option-alist)))
      (if aelt
!       (push (cons (nth 3 aelt) (or (nth 4 aelt) (pop x-invocation-args)))
!             initial-frame-alist))))
  
  (defun x-handle-iconic (switch)
    "Make \"-iconic\" SWITCH apply only to the initial frame."
!   (push '(visibility . icon) initial-frame-alist))
  
  (defun x-handle-xrm-switch (switch)
    "Handle the \"-xrm\" SWITCH."
***************
*** 226,243 ****
  ;; to the option's operand; set the name of the initial frame, too.
    (or (consp x-invocation-args)
        (error "%s: missing argument to `%s' option" (invocation-name) switch))
!   (setq x-resource-name (car x-invocation-args)
!       x-invocation-args (cdr x-invocation-args))
!   (setq initial-frame-alist (cons (cons 'name x-resource-name)
!                                 initial-frame-alist)))
  
  (defvar x-display-name nil
    "The display name specifying server and frame.")
  
  (defun x-handle-display (switch)
    "Handle the \"-display\" SWITCH."
!   (setq x-display-name (car x-invocation-args)
!       x-invocation-args (cdr x-invocation-args)))
  
  (defun x-handle-args (args)
    "Process the X-related command line options in ARGS.
--- 202,216 ----
  ;; to the option's operand; set the name of the initial frame, too.
    (or (consp x-invocation-args)
        (error "%s: missing argument to `%s' option" (invocation-name) switch))
!   (setq x-resource-name (pop x-invocation-args))
!   (push (cons 'name x-resource-name) initial-frame-alist))
  
  (defvar x-display-name nil
    "The display name specifying server and frame.")
  
  (defun x-handle-display (switch)
    "Handle the \"-display\" SWITCH."
!   (setq x-display-name (pop x-invocation-args)))
  
  (defun x-handle-args (args)
    "Process the X-related command line options in ARGS.
***************
*** 281,287 ****
                     (cons argval x-invocation-args)))
                (funcall handler this-switch))
            (funcall handler this-switch))
!       (setq args (cons orig-this-switch args)))))
    (nconc (nreverse args) x-invocation-args))
  
  ;;
--- 254,260 ----
                     (cons argval x-invocation-args)))
                (funcall handler this-switch))
            (funcall handler this-switch))
!       (push orig-this-switch args))))
    (nconc (nreverse args) x-invocation-args))
  
  ;;
***************
*** 1046,1060 ****
  (defun xw-defined-colors (&optional frame)
    "Internal function called by `defined-colors', which see."
    (or frame (setq frame (selected-frame)))
!   (let* ((color-map-colors (mapcar (lambda (clr) (car clr)) w32-color-map))
!        (all-colors (or color-map-colors x-colors))
!        (this-color nil)
!        (defined-colors nil))
!     (while all-colors
!       (setq this-color (car all-colors)
!           all-colors (cdr all-colors))
        (and (color-supported-p this-color frame t)
!          (setq defined-colors (cons this-color defined-colors))))
      defined-colors))
  
  
--- 1019,1028 ----
  (defun xw-defined-colors (&optional frame)
    "Internal function called by `defined-colors', which see."
    (or frame (setq frame (selected-frame)))
!   (let ((defined-colors nil))
!     (dolist (this-color (or (mapcar 'car w32-color-map) x-colors))
        (and (color-supported-p this-color frame t)
!          (push this-color defined-colors)))
      defined-colors))
  
  
***************
*** 1076,1088 ****
  
  ;;; Make sure we have a valid resource name.
  (or (stringp x-resource-name)
!     (let (i)
!       (setq x-resource-name (invocation-name))
! 
!       ;; Change any . or * characters in x-resource-name to hyphens,
!       ;; 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 ?-))))
  
  ;; For the benefit of older Emacses (19.27 and earlier) that are sharing
  ;; the same lisp directory, don't pass the third argument unless we seem
--- 1044,1053 ----
  
  ;;; Make sure we have a valid resource name.
  (or (stringp x-resource-name)
!     (setq x-resource-name
!         ;; Change any . or * characters in x-resource-name to hyphens,
!         ;; so as not to choke when we use it in X resource queries.
!         (replace-regexp-in-string "[.*]" "-" (invocation-name))))
  
  ;; For the benefit of older Emacses (19.27 and earlier) that are sharing
  ;; the same lisp directory, don't pass the third argument unless we seem
***************
*** 1166,1186 ****
        (setq initial-frame-alist (append initial-frame-alist parsed))
        ;; The size parms apply to all frames.
        (if (assq 'height parsed)
!           (setq default-frame-alist
!                 (cons (cons 'height (cdr (assq 'height parsed)))
!                       default-frame-alist)))
        (if (assq 'width parsed)
!           (setq default-frame-alist
!                 (cons (cons 'width (cdr (assq 'width parsed)))
!                       default-frame-alist))))))
  
  ;; Check the reverseVideo resource.
  (let ((case-fold-search t))
    (let ((rv (x-get-resource "reverseVideo" "ReverseVideo")))
!     (if (and rv
!            (string-match "^\\(true\\|yes\\|on\\)$" rv))
!       (setq default-frame-alist
!             (cons '(reverse . t) default-frame-alist)))))
  
  (defun x-win-suspend-error ()
    "Report an error when a suspend is attempted."
--- 1131,1147 ----
        (setq initial-frame-alist (append initial-frame-alist parsed))
        ;; The size parms apply to all frames.
        (if (assq 'height parsed)
!           (push (cons 'height (cdr (assq 'height parsed)))
!                 default-frame-alist))
        (if (assq 'width parsed)
!           (push (cons 'width (cdr (assq 'width parsed)))
!                 default-frame-alist)))))
  
  ;; Check the reverseVideo resource.
  (let ((case-fold-search t))
    (let ((rv (x-get-resource "reverseVideo" "ReverseVideo")))
!     (if (and rv (string-match "^\\(true\\|yes\\|on\\)$" rv))
!       (push '(reverse . t) default-frame-alist))))
  
  (defun x-win-suspend-error ()
    "Report an error when a suspend is attempted."
***************
*** 1244,1250 ****
         (and chosen-font (list chosen-font)))
       (x-popup-menu
        last-nonmenu-event
!     ;; Append list of fontsets currently defined.
        ;; Conditional on new-fontset so bootstrapping works on non-GUI compiles
        (if (fboundp 'new-fontset)
        (append w32-fixed-font-alist (list (generate-fontset-menu)))))))
--- 1205,1211 ----
         (and chosen-font (list chosen-font)))
       (x-popup-menu
        last-nonmenu-event
!       ;; Append list of fontsets currently defined.
        ;; Conditional on new-fontset so bootstrapping works on non-GUI compiles
        (if (fboundp 'new-fontset)
        (append w32-fixed-font-alist (list (generate-fontset-menu)))))))
***************
*** 1268,1272 ****
          (tiff "libtiff3.dll" "libtiff.dll")
          (gif "libungif.dll")))
  
! ;;; arch-tag: 69fb1701-28c2-4890-b351-3d1fe4b4f166
  ;;; w32-win.el ends here
--- 1229,1233 ----
          (tiff "libtiff3.dll" "libtiff.dll")
          (gif "libungif.dll")))
  
! ;; arch-tag: 69fb1701-28c2-4890-b351-3d1fe4b4f166
  ;;; w32-win.el ends here