comparison lisp/term/w32-win.el @ 59704:a53730244ba3

Simplify code.

59703:51a8532d9066

;;; 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

;; This file is part of GNU Emacs.

(defun x-handle-switch (switch)
  "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."
  (or (consp x-invocation-args)
      (error "%s: missing argument to `%s' option" (invocation-name) switch))

  "Handle a \"-name\" SWITCH."
;; Handle the -name option.  Set the variable x-resource-name
;; 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.
This is done before the user's startup file is loaded.  They are copied to
`x-invocation args' from which the X-related things are extracted, first

	  (if argval
	      (let ((x-invocation-args
		     (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))

;;
;; Available colors
;;

XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp")

(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))


;;;; Function keys

(setq command-line-args (x-handle-args command-line-args))

;;; 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
;; to have the multi-display support.
(if (fboundp 'x-close-connection)

			       (cons '(user-size . t) parsed))))
	;; All geometry parms apply to the initial frame.
	(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."
  (error "Suspending an Emacs running under W32 makes no sense"))
(add-hook 'suspend-hook 'x-win-suspend-error)

       (let ((chosen-font (w32-select-font (selected-frame)
					   w32-list-proportional-fonts)))
	 (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)))))))
  (if fonts
      (let (font)

        (png "libpng13d.dll" "libpng13.dll" "libpng12d.dll" "libpng12.dll" "libpng.dll")
        (jpeg "jpeg62.dll" "libjpeg.dll" "jpeg-62.dll" "jpeg.dll")
        (tiff "libtiff3.dll" "libtiff.dll")
        (gif "libungif.dll")))

;;; arch-tag: 69fb1701-28c2-4890-b351-3d1fe4b4f166
;;; w32-win.el ends here

59704:a53730244ba3

;;; 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

;; This file is part of GNU Emacs.

(defun x-handle-switch (switch)
  "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."
  (or (consp x-invocation-args)
      (error "%s: missing argument to `%s' option" (invocation-name) switch))

  "Handle a \"-name\" SWITCH."
;; Handle the -name option.  Set the variable x-resource-name
;; 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.
This is done before the user's startup file is loaded.  They are copied to
`x-invocation args' from which the X-related things are extracted, first

	  (if argval
	      (let ((x-invocation-args
		     (cons argval x-invocation-args)))
		(funcall handler this-switch))
	    (funcall handler this-switch))
	(push orig-this-switch args))))
  (nconc (nreverse args) x-invocation-args))

;;
;; Available colors
;;

XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp")

(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))


;;;; Function keys

(setq command-line-args (x-handle-args command-line-args))

;;; 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
;; to have the multi-display support.
(if (fboundp 'x-close-connection)

			       (cons '(user-size . t) parsed))))
	;; All geometry parms apply to the initial frame.
	(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."
  (error "Suspending an Emacs running under W32 makes no sense"))
(add-hook 'suspend-hook 'x-win-suspend-error)

       (let ((chosen-font (w32-select-font (selected-frame)
					   w32-list-proportional-fonts)))
	 (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)))))))
  (if fonts
      (let (font)

        (png "libpng13d.dll" "libpng13.dll" "libpng12d.dll" "libpng12.dll" "libpng.dll")
        (jpeg "jpeg62.dll" "libjpeg.dll" "jpeg-62.dll" "jpeg.dll")
        (tiff "libtiff3.dll" "libtiff.dll")
        (gif "libungif.dll")))

;; arch-tag: 69fb1701-28c2-4890-b351-3d1fe4b4f166
;;; w32-win.el ends here