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

[Miles Bader]

CVSROOT:        /cvsroot/emacs
Module name:    emacs
Changes by:     Miles Bader <miles>     07/08/29 05:28:10

Index: lisp/term/w32-win.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/term/w32-win.el,v
retrieving revision 1.82
retrieving revision 1.83
diff -u -b -r1.82 -r1.83
--- lisp/term/w32-win.el        26 Jul 2007 05:27:31 -0000      1.82
+++ lisp/term/w32-win.el        29 Aug 2007 05:27:59 -0000      1.83
@@ -68,8 +68,8 @@
 ;; An alist of X options and the function which handles them.  See
 ;; ../startup.el.
 
-(if (not (eq window-system 'w32))
-    (error "%s: Loading w32-win.el but not compiled for w32" 
(invocation-name)))
+;; (if (not (eq window-system 'w32))
+;;     (error "%s: Loading w32-win.el but not compiled for w32" 
(invocation-name)))
 
 (require 'frame)
 (require 'mouse)
@@ -89,9 +89,6 @@
 ;; The following definition is used for debugging scroll bar events.
 ;(defun w32-handle-scroll-bar-event (event) (interactive "e") (princ event))
 
-;; Handle mouse-wheel events with mwheel.
-(mouse-wheel-mode 1)
-
 (defun w32-drag-n-drop-debug (event)
   "Print the drag-n-drop EVENT in a readable form."
   (interactive "e")
@@ -1039,58 +1036,30 @@
 
 ;;;; Function keys
 
-;;; make f10 activate the real menubar rather than the mini-buffer menu
-;;; navigation feature.
-(defun menu-bar-open (&optional frame)
+ ;;; make f10 activate the real menubar rather than the mini-buffer menu
+ ;;; navigation feature.
+ (defun menu-bar-open (&optional frame)
   "Start key navigation of the menu bar in FRAME.
 
-This initially activates the first menu-bar item, and you can then navigate
-with the arrow keys, select a menu entry with the Return key or cancel with
-the Escape key.  If FRAME has no menu bar, this function does nothing.
+ This initially activates the first menu-bar item, and you can then navigate
+ with the arrow keys, select a menu entry with the Return key or cancel with
+ the Escape key.  If FRAME has no menu bar, this function does nothing.
 
-If FRAME is nil or not given, use the selected frame."
+ If FRAME is nil or not given, use the selected frame."
   (interactive "i")
   (w32-send-sys-command ?\xf100 frame))
-;
-(global-set-key [f10] 'menu-bar-open)
-
-(substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame
-                          global-map)
-
-(define-key function-key-map [S-tab] [backtab])
-
 
-;;; Do the actual Windows setup here; the above code just defines
-;;; functions and variables that we use now.
+(defun x-setup-function-keys (frame)
+  "Setup Function Keys for w32."
+  (with-selected-frame frame
+     (define-key local-function-key-map [f10] 'menu-bar-open)
 
-(setq command-line-args (x-handle-args command-line-args))
+     (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame
+                                local-function-key-map global-map)
 
-;;; 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))))
+     (define-key local-function-key-map [S-tab] [backtab]))
+  (set-terminal-parameter frame 'x-setup-function-keys t))
 
-;; 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)
-    (x-open-connection ""
-                      x-command-line-resources
-                      ;; Exit Emacs with fatal error if this fails.
-                      t)
-  (x-open-connection ""
-                    x-command-line-resources))
-
-(setq frame-creation-function 'x-create-frame-with-faces)
-
-(setq x-cut-buffer-max (min (- (/ (x-server-max-request-size) 2) 100)
-                           x-cut-buffer-max))
-
-;; W32 expects the menu bar cut and paste commands to use the clipboard.
-;; This has ,? to match both on Sunos and on Solaris.
-(menu-bar-enable-clipboard)
 
 ;; W32 systems have different fonts than commonly found on X, so
 ;; we define our own standard fontset here.
@@ -1103,9 +1072,82 @@
 
 See the documentation of `create-fontset-from-fontset-spec' for the format.")
 
-;; Conditional on new-fontset so bootstrapping works on non-GUI compiles
-(if (fboundp 'new-fontset)
+(defun x-win-suspend-error ()
+  "Report an error when a suspend is attempted."
+  (error "Suspending an Emacs running under W32 makes no sense"))
+
+
+;;; Enable Japanese fonts on Windows to be used by default.
+(set-fontset-font nil (make-char 'katakana-jisx0201) '("*" . "JISX0208-SJIS"))
+(set-fontset-font nil (make-char 'latin-jisx0201) '("*" . "JISX0208-SJIS"))
+(set-fontset-font nil (make-char 'japanese-jisx0208) '("*" . "JISX0208-SJIS"))
+(set-fontset-font nil (make-char 'japanese-jisx0208-1978) '("*" . 
"JISX0208-SJIS"))
+
+(defun mouse-set-font (&rest fonts)
+  "Select an Emacs font from a list of known good fonts and fontsets.
+
+If `w32-use-w32-font-dialog' is non-nil (the default), use the Windows
+font dialog to display the list of possible fonts.  Otherwise use a
+pop-up menu (like Emacs does on other platforms) initialized with
+the fonts in `w32-fixed-font-alist'.
+If `w32-list-proportional-fonts' is non-nil, add proportional fonts
+to the list in the font selection dialog (the fonts listed by the
+pop-up menu are unaffected by `w32-list-proportional-fonts')."
+  (interactive
+   (if w32-use-w32-font-dialog
+       (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)
+       (while fonts
+         (condition-case nil
     (progn
+                (setq font (car fonts))
+               (set-default-font font)
+                (setq fonts nil))
+           (error (setq fonts (cdr fonts)))))
+       (if (null font)
+           (error "Font not found")))))
+
+;;; Set default known names for image libraries
+(setq image-library-alist
+      '((xpm "xpm4.dll" "libXpm-nox4.dll" "libxpm.dll")
+        (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 "giflib4.dll" "libungif4.dll" "libungif.dll")))
+
+;;; multi-tty support
+(defvar w32-initialized nil
+  "Non-nil if the w32 window system has been initialized.")
+
+(defun w32-initialize-window-system ()
+  "Initialize Emacs for W32 GUI frames."
+
+  ;; Do the actual Windows setup here; the above code just defines
+  ;; functions and variables that we use now.
+
+  (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))))
+
+  (x-open-connection "" x-command-line-resources
+                     ;; Exit with a fatal error if this fails and we
+                     ;; are the initial display
+                     (eq initial-window-system 'w32))
+
       ;; Setup the default fontset.
       (setup-default-fontset)
       ;; Create the standard fontset.
@@ -1135,12 +1177,12 @@
               ;; Create a fontset from FONT.  The fontset name is
               ;; generated from FONT.
               (create-fontset-from-ascii-font font
-                                             resolved-name "startup"))))))
+                                          resolved-name "startup"))))
 
-;; Apply a geometry resource to the initial frame.  Put it at the end
-;; of the alist, so that anything specified on the command line takes
-;; precedence.
-(let* ((res-geometry (x-get-resource "geometry" "Geometry"))
+  ;; Apply a geometry resource to the initial frame.  Put it at the end
+  ;; of the alist, so that anything specified on the command line takes
+  ;; precedence.
+  (let* ((res-geometry (x-get-resource "geometry" "Geometry"))
        parsed)
   (if res-geometry
       (progn
@@ -1160,101 +1202,37 @@
            (push (cons 'width (cdr (assq 'width parsed)))
                  default-frame-alist)))))
 
-;; Check the reverseVideo resource.
-(let ((case-fold-search t))
+  ;; 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)
+  ;; Don't let Emacs suspend under w32 gui
+  (add-hook 'suspend-hook 'x-win-suspend-error)
 
-;;; Turn off window-splitting optimization; w32 is usually fast enough
-;;; that this is only annoying.
-(setq split-window-keep-point t)
-
-;; Don't show the frame name; that's redundant.
-(setq-default mode-line-frame-identification "  ")
-
-;;; Set to a system sound if you want a fancy bell.
-(set-message-beep 'ok)
-
-;; Remap some functions to call w32 common dialogs
-
-(defun internal-face-interactive (what &optional bool)
-  (let* ((fn (intern (concat "face-" what)))
-        (prompt (concat "Set " what " of face "))
-        (face (read-face-name prompt))
-        (default (if (fboundp fn)
-                     (or (funcall fn face (selected-frame))
-                         (funcall fn 'default (selected-frame)))))
-        (fn-win (intern (concat (symbol-name window-system) "-select-" what)))
-        value)
-    (setq value
-         (cond ((fboundp fn-win)
-                (funcall fn-win))
-               ((eq bool 'color)
-                (completing-read (concat prompt " " (symbol-name face) " to: ")
-                                 (mapcar (function (lambda (color)
-                                                     (cons color color)))
-                                         x-colors)
-                                 nil nil nil nil default))
-               (bool
-                (y-or-n-p (concat "Should face " (symbol-name face)
-                                  " be " bool "? ")))
-               (t
-                (read-string (concat prompt " " (symbol-name face) " to: ")
-                             nil nil default))))
-    (list face (if (equal value "") nil value))))
+  ;; Turn off window-splitting optimization; w32 is usually fast enough
+  ;; that this is only annoying.
+  (setq split-window-keep-point t)
 
-;;; Enable Japanese fonts on Windows to be used by default.
-(set-fontset-font nil (make-char 'katakana-jisx0201) '("*" . "JISX0208-SJIS"))
-(set-fontset-font nil (make-char 'latin-jisx0201) '("*" . "JISX0208-SJIS"))
-(set-fontset-font nil (make-char 'japanese-jisx0208) '("*" . "JISX0208-SJIS"))
-(set-fontset-font nil (make-char 'japanese-jisx0208-1978) '("*" . 
"JISX0208-SJIS"))
+  ;; Turn on support for mouse wheels
+  (mouse-wheel-mode 1)
 
-(defun mouse-set-font (&rest fonts)
-  "Select an Emacs font from a list of known good fonts and fontsets.
+  ;; W32 expects the menu bar cut and paste commands to use the clipboard.
+  (menu-bar-enable-clipboard)
 
-If `w32-use-w32-font-dialog' is non-nil (the default), use the Windows
-font dialog to display the list of possible fonts.  Otherwise use a
-pop-up menu (like Emacs does on other platforms) initialized with
-the fonts in `w32-fixed-font-alist'.
-If `w32-list-proportional-fonts' is non-nil, add proportional fonts
-to the list in the font selection dialog (the fonts listed by the
-pop-up menu are unaffected by `w32-list-proportional-fonts')."
-  (interactive
-   (if w32-use-w32-font-dialog
-       (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)
-       (while fonts
-         (condition-case nil
-             (progn
-                (setq font (car fonts))
-               (set-default-font font)
-                (setq fonts nil))
-           (error (setq fonts (cdr fonts)))))
-       (if (null font)
-           (error "Font not found")))))
+  ;; Don't show the frame name; that's redundant.
+  (setq-default mode-line-frame-identification "  ")
 
-;;; Set default known names for image libraries
-(setq image-library-alist
-      '((xpm "xpm4.dll" "libXpm-nox4.dll" "libxpm.dll")
-        (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 "giflib4.dll" "libungif4.dll" "libungif.dll")))
+  ;; Set to a system sound if you want a fancy bell.
+  (set-message-beep 'ok)
+  (setq w32-initialized t))
+
+(add-to-list 'handle-args-function-alist '(w32 . x-handle-args))
+(add-to-list 'frame-creation-function-alist '(w32 . x-create-frame-with-faces))
+(add-to-list 'window-system-initialization-alist '(w32 . 
w32-initialize-window-system))
+
+(provide 'w32-win)
 
 ;; arch-tag: 69fb1701-28c2-4890-b351-3d1fe4b4f166
 ;;; w32-win.el ends here