--- /dev/null
+;;; win32-win.el --- parse switches controlling interface with win32
+;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+
+;; Author: Kevin Gallo
+;; Keywords: terminals
+
+;;; This file is part of GNU Emacs.
+;;;
+;;; GNU Emacs is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Emacs; see the file COPYING. If not, write to
+;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;; win32-win.el: this file is loaded from ../lisp/startup.el when it recognizes
+;; that win32 windows are to be used. Command line switches are parsed and those
+;; pertaining to win32 are processed and removed from the command line. The
+;; win32 display is opened and hooks are set for popping up the initial window.
+
+;; startup.el will then examine startup files, and eventually call the hooks
+;; which create the first window (s).
+
+;;; Code:
+\f
+
+;; These are the standard X switches from the Xt Initialize.c file of
+;; Release 4.
+
+;; Command line Resource Manager string
+
+;; +rv *reverseVideo
+;; +synchronous *synchronous
+;; -background *background
+;; -bd *borderColor
+;; -bg *background
+;; -bordercolor *borderColor
+;; -borderwidth .borderWidth
+;; -bw .borderWidth
+;; -display .display
+;; -fg *foreground
+;; -fn *font
+;; -font *font
+;; -foreground *foreground
+;; -geometry .geometry
+;; -i .iconType
+;; -itype .iconType
+;; -iconic .iconic
+;; -name .name
+;; -reverse *reverseVideo
+;; -rv *reverseVideo
+;; -selectionTimeout .selectionTimeout
+;; -synchronous *synchronous
+;; -xrm
+
+;; An alist of X options and the function which handles them. See
+;; ../startup.el.
+
+(if (not (eq window-system 'win32))
+ (error "%s: Loading win32-win.el but not compiled for win32" (invocation-name)))
+
+(require 'frame)
+(require 'mouse)
+(require 'scroll-bar)
+(require 'faces)
+(require 'select)
+(require 'menu-bar)
+
+(defvar x-invocation-args)
+
+(defvar x-command-line-resources nil)
+
+(defconst x-option-alist
+ '(("-bw" . x-handle-numeric-switch)
+ ("-d" . x-handle-display)
+ ("-display" . x-handle-display)
+ ("-name" . x-handle-name-rn-switch)
+ ("-rn" . x-handle-name-rn-switch)
+ ("-T" . x-handle-switch)
+ ("-r" . x-handle-switch)
+ ("-rv" . x-handle-switch)
+ ("-reverse" . x-handle-switch)
+ ("-fn" . x-handle-switch)
+ ("-font" . x-handle-switch)
+ ("-ib" . x-handle-numeric-switch)
+ ("-g" . x-handle-geometry)
+ ("-geometry" . x-handle-geometry)
+ ("-fg" . x-handle-switch)
+ ("-foreground". x-handle-switch)
+ ("-bg" . x-handle-switch)
+ ("-background". x-handle-switch)
+ ("-ms" . x-handle-switch)
+ ("-itype" . x-handle-switch)
+ ("-i" . x-handle-switch)
+ ("-iconic" . x-handle-iconic)
+ ("-xrm" . x-handle-xrm-switch)
+ ("-cr" . x-handle-switch)
+ ("-vb" . x-handle-switch)
+ ("-hb" . x-handle-switch)
+ ("-bd" . x-handle-switch)))
+
+(defconst x-long-option-alist
+ '(("--border-width" . "-bw")
+ ("--display" . "-d")
+ ("--name" . "-name")
+ ("--title" . "-T")
+ ("--reverse-video" . "-reverse")
+ ("--font" . "-font")
+ ("--internal-border" . "-ib")
+ ("--geometry" . "-geometry")
+ ("--foreground-color" . "-fg")
+ ("--background-color" . "-bg")
+ ("--mouse-color" . "-ms")
+ ("--icon-type" . "-itype")
+ ("--iconic" . "-iconic")
+ ("--xrm" . "-xrm")
+ ("--cursor-color" . "-cr")
+ ("--vertical-scroll-bars" . "-vb")
+ ("--border-color" . "-bd")))
+
+(defconst x-switch-definitions
+ '(("-name" name)
+ ("-T" name)
+ ("-r" reverse t)
+ ("-rv" reverse t)
+ ("-reverse" reverse t)
+ ("-fn" font)
+ ("-font" font)
+ ("-ib" internal-border-width)
+ ("-fg" foreground-color)
+ ("-foreground" foreground-color)
+ ("-bg" background-color)
+ ("-background" background-color)
+ ("-ms" mouse-color)
+ ("-cr" cursor-color)
+ ("-itype" icon-type t)
+ ("-i" icon-type t)
+ ("-vb" vertical-scroll-bars t)
+ ("-hb" horizontal-scroll-bars t)
+ ("-bd" border-color)
+ ("-bw" border-width)))
+
+;; Handler for switches of the form "-switch value" or "-switch".
+(defun x-handle-switch (switch)
+ (let ((aelt (assoc switch x-switch-definitions)))
+ (if aelt
+ (if (nth 2 aelt)
+ (setq default-frame-alist
+ (cons (cons (nth 1 aelt) (nth 2 aelt))
+ default-frame-alist))
+ (setq default-frame-alist
+ (cons (cons (nth 1 aelt)
+ (car x-invocation-args))
+ default-frame-alist)
+ x-invocation-args (cdr x-invocation-args))))))
+
+;; Make -iconic apply only to the initial frame!
+(defun x-handle-iconic (switch)
+ (setq initial-frame-alist
+ (cons '(visibility . icon) initial-frame-alist)))
+
+;; Handler for switches of the form "-switch n"
+(defun x-handle-numeric-switch (switch)
+ (let ((aelt (assoc switch x-switch-definitions)))
+ (if aelt
+ (setq default-frame-alist
+ (cons (cons (nth 1 aelt)
+ (string-to-int (car x-invocation-args)))
+ default-frame-alist)
+ x-invocation-args
+ (cdr x-invocation-args)))))
+
+;; Handle the -xrm option.
+(defun x-handle-xrm-switch (switch)
+ (or (consp x-invocation-args)
+ (error "%s: missing argument to `%s' option" (invocation-name) switch))
+ (setq x-command-line-resources (car x-invocation-args))
+ (setq x-invocation-args (cdr x-invocation-args)))
+
+;; Handle the geometry option
+(defun x-handle-geometry (switch)
+ (let ((geo (x-parse-geometry (car x-invocation-args))))
+ (setq initial-frame-alist
+ (append initial-frame-alist
+ (if (or (assq 'left geo) (assq 'top geo))
+ '((user-position . t)))
+ (if (or (assq 'height geo) (assq 'width geo))
+ '((user-size . t)))
+ geo)
+ x-invocation-args (cdr x-invocation-args))))
+
+;; Handle the -name and -rn options. Set the variable x-resource-name
+;; to the option's operand; if the switch was `-name', set the name of
+;; the initial frame, too.
+(defun x-handle-name-rn-switch (switch)
+ (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))
+ (if (string= switch "-name")
+ (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)
+ (setq x-display-name (car x-invocation-args)
+ x-invocation-args (cdr x-invocation-args)))
+
+(defvar x-invocation-args nil)
+
+(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
+the switch (e.g., \"-fg\") in the following code, and possible values
+\(e.g., \"black\") in the option handler code (e.g., x-handle-switch).
+This returns ARGS with the arguments that have been processed removed."
+ (message "%s" args)
+ (setq x-invocation-args args
+ args nil)
+ (while x-invocation-args
+ (let* ((this-switch (car x-invocation-args))
+ (orig-this-switch this-switch)
+ completion argval aelt)
+ (setq x-invocation-args (cdr x-invocation-args))
+ ;; Check for long options with attached arguments
+ ;; and separate out the attached option argument into argval.
+ (if (string-match "^--[^=]*=" this-switch)
+ (setq argval (substring this-switch (match-end 0))
+ this-switch (substring this-switch 0 (1- (match-end 0)))))
+ (setq completion (try-completion this-switch x-long-option-alist))
+ (if (eq completion t)
+ ;; Exact match for long option.
+ (setq this-switch (cdr (assoc this-switch x-long-option-alist)))
+ (if (stringp completion)
+ (let ((elt (assoc completion x-long-option-alist)))
+ ;; Check for abbreviated long option.
+ (or elt
+ (error "Option `%s' is ambiguous" this-switch))
+ (setq this-switch (cdr elt)))
+ ;; Check for a short option.
+ (setq argval nil this-switch orig-this-switch)))
+ (setq aelt (assoc this-switch x-option-alist))
+ (if aelt
+ (if argval
+ (let ((x-invocation-args
+ (cons argval x-invocation-args)))
+ (funcall (cdr aelt) this-switch))
+ (funcall (cdr aelt) this-switch))
+ (setq args (cons this-switch args)))))
+ (setq args (nreverse args)))
+
+
+\f
+;;
+;; Available colors
+;;
+
+(defvar x-colors '("aquamarine"
+ "Aquamarine"
+ "medium aquamarine"
+ "MediumAquamarine"
+ "black"
+ "Black"
+ "blue"
+ "Blue"
+ "cadet blue"
+ "CadetBlue"
+ "cornflower blue"
+ "CornflowerBlue"
+ "dark slate blue"
+ "DarkSlateBlue"
+ "light blue"
+ "LightBlue"
+ "light steel blue"
+ "LightSteelBlue"
+ "medium blue"
+ "MediumBlue"
+ "medium slate blue"
+ "MediumSlateBlue"
+ "midnight blue"
+ "MidnightBlue"
+ "navy blue"
+ "NavyBlue"
+ "navy"
+ "Navy"
+ "sky blue"
+ "SkyBlue"
+ "slate blue"
+ "SlateBlue"
+ "steel blue"
+ "SteelBlue"
+ "coral"
+ "Coral"
+ "cyan"
+ "Cyan"
+ "firebrick"
+ "Firebrick"
+ "brown"
+ "Brown"
+ "gold"
+ "Gold"
+ "goldenrod"
+ "Goldenrod"
+ "green"
+ "Green"
+ "dark green"
+ "DarkGreen"
+ "dark olive green"
+ "DarkOliveGreen"
+ "forest green"
+ "ForestGreen"
+ "lime green"
+ "LimeGreen"
+ "medium sea green"
+ "MediumSeaGreen"
+ "medium spring green"
+ "MediumSpringGreen"
+ "pale green"
+ "PaleGreen"
+ "sea green"
+ "SeaGreen"
+ "spring green"
+ "SpringGreen"
+ "yellow green"
+ "YellowGreen"
+ "dark slate grey"
+ "DarkSlateGrey"
+ "dark slate gray"
+ "DarkSlateGray"
+ "dim grey"
+ "DimGrey"
+ "dim gray"
+ "DimGray"
+ "light grey"
+ "LightGrey"
+ "light gray"
+ "LightGray"
+ "gray"
+ "grey"
+ "Gray"
+ "Grey"
+ "khaki"
+ "Khaki"
+ "magenta"
+ "Magenta"
+ "maroon"
+ "Maroon"
+ "orange"
+ "Orange"
+ "orchid"
+ "Orchid"
+ "dark orchid"
+ "DarkOrchid"
+ "medium orchid"
+ "MediumOrchid"
+ "pink"
+ "Pink"
+ "plum"
+ "Plum"
+ "red"
+ "Red"
+ "indian red"
+ "IndianRed"
+ "medium violet red"
+ "MediumVioletRed"
+ "orange red"
+ "OrangeRed"
+ "violet red"
+ "VioletRed"
+ "salmon"
+ "Salmon"
+ "sienna"
+ "Sienna"
+ "tan"
+ "Tan"
+ "thistle"
+ "Thistle"
+ "turquoise"
+ "Turquoise"
+ "dark turquoise"
+ "DarkTurquoise"
+ "medium turquoise"
+ "MediumTurquoise"
+ "violet"
+ "Violet"
+ "blue violet"
+ "BlueViolet"
+ "wheat"
+ "Wheat"
+ "white"
+ "White"
+ "yellow"
+ "Yellow"
+ "green yellow"
+ "GreenYellow")
+ "The full list of X colors from the `rgb.text' file.")
+
+(defun x-defined-colors (&optional frame)
+ "Return a list of colors supported for a particular frame.
+The argument FRAME specifies which frame to try.
+The value may be different for frames on different X displays."
+ (or frame (setq frame (selected-frame)))
+ (let ((all-colors x-colors)
+ (this-color nil)
+ (defined-colors nil))
+ (while all-colors
+ (setq this-color (car all-colors)
+ all-colors (cdr all-colors))
+ (and (face-color-supported-p frame this-color t)
+ (setq defined-colors (cons this-color defined-colors))))
+ defined-colors))
+\f
+;;;; Function keys
+
+(defun iconify-or-deiconify-frame ()
+ "Iconify the selected frame, or deiconify if it's currently an icon."
+ (interactive)
+ (if (eq (cdr (assq 'visibility (frame-parameters))) t)
+ (iconify-frame)
+ (make-frame-visible)))
+
+(substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame
+ global-map)
+
+;; Map certain keypad keys into ASCII characters
+;; that people usually expect.
+(define-key function-key-map [backspace] [127])
+(define-key function-key-map [delete] [127])
+(define-key function-key-map [tab] [?\t])
+(define-key function-key-map [linefeed] [?\n])
+(define-key function-key-map [clear] [11])
+(define-key function-key-map [return] [13])
+(define-key function-key-map [escape] [?\e])
+(define-key function-key-map [M-backspace] [?\M-\d])
+(define-key function-key-map [M-delete] [?\M-\d])
+(define-key function-key-map [M-tab] [?\M-\t])
+(define-key function-key-map [M-linefeed] [?\M-\n])
+(define-key function-key-map [M-clear] [?\M-\013])
+(define-key function-key-map [M-return] [?\M-\015])
+(define-key function-key-map [M-escape] [?\M-\e])
+
+;; These tell read-char how to convert
+;; these special chars to ASCII.
+(put 'backspace 'ascii-character 127)
+(put 'delete 'ascii-character 127)
+(put 'tab 'ascii-character ?\t)
+(put 'linefeed 'ascii-character ?\n)
+(put 'clear 'ascii-character 12)
+(put 'return 'ascii-character 13)
+(put 'escape 'ascii-character ?\e)
+
+\f
+;;;; Selections and cut buffers
+
+;;; We keep track of the last text selected here, so we can check the
+;;; current selection against it, and avoid passing back our own text
+;;; from x-cut-buffer-or-selection-value.
+(defvar x-last-selected-text nil)
+
+;;; It is said that overlarge strings are slow to put into the cut buffer.
+;;; Note this value is overridden below.
+(defvar x-cut-buffer-max 20000
+ "Max number of characters to put in the cut buffer.")
+
+(defvar x-select-enable-clipboard t
+ "Non-nil means cutting and pasting uses the clipboard.
+This is in addition to the primary selection.")
+
+(defun x-select-text (text &optional push)
+ (if x-select-enable-clipboard
+ (win32-set-clipboard-data text)))
+
+;;; Return the value of the current selection.
+;;; Consult the selection, then the cut buffer. Treat empty strings
+;;; as if they were unset.
+(defun x-get-selection-value ()
+ (if x-select-enable-clipboard
+ (let (text)
+ ;; Don't die if x-get-selection signals an error.
+ (condition-case c
+ (setq text (win32-get-clipboard-data))
+ (error (message "win32-get-clipboard-data:%s" c)))
+ (if (string= text "") (setq text nil))
+ text)))
+\f
+;;; 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)
+ (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)
+ (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))
+
+;; Win32 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)
+
+;; 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
+ (setq parsed (x-parse-geometry res-geometry))
+ ;; If the resource specifies a position,
+ ;; call the position and size "user-specified".
+ (if (or (assq 'top parsed) (assq 'left parsed))
+ (setq parsed (cons '(user-position . t)
+ (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)))))
+
+;; Set x-selection-timeout, measured in milliseconds.
+(let ((res-selection-timeout
+ (x-get-resource "selectionTimeout" "SelectionTimeout")))
+ (setq x-selection-timeout 20000)
+ (if res-selection-timeout
+ (setq x-selection-timeout (string-to-number res-selection-timeout))))
+
+(defun x-win-suspend-error ()
+ (error "Suspending an emacs running under Win32 makes no sense"))
+(add-hook 'suspend-hook 'x-win-suspend-error)
+
+;;; Arrange for the kill and yank functions to set and check the clipboard.
+(setq interprogram-cut-function 'x-select-text)
+(setq interprogram-paste-function 'x-get-selection-value)
+
+;;; Turn off window-splitting optimization; win32 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-buffer-identification '("Emacs: %12b"))
+
+;;; Set to a system sound if you want a fancy bell.
+(set-message-beep 'ok)
+
+;; Remap some functions to call win32 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 (concat 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
+ (if (fboundp fn-win)
+ (funcall fn-win)
+ (if bool
+ (y-or-n-p (concat "Should face " (symbol-name face)
+ " be " bool "? "))
+ (read-string (concat prompt " " (symbol-name face) " to: ")
+ default)))))
+ (list face (if (equal value "") nil value))))
+
+;; Redefine the font selection to use the Win32 dialog
+
+(defun mouse-set-font (&rest fonts)
+ (interactive)
+ (set-default-font (win32-select-font)))
+
+;;; win32-win.el ends here
--- /dev/null
+/* "Face" primitives.
+ Copyright (C) 1993, 1994, 1995 Free Software Foundation.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs; see the file COPYING. If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+/* Ported xfaces.c for win32 - Kevin Gallo */
+
+#include <sys/types.h>
+#include <sys/stat.h>
+
+#include <config.h>
+#include "lisp.h"
+
+#include "w32term.h"
+#include "buffer.h"
+#include "dispextern.h"
+#include "frame.h"
+#include "blockinput.h"
+#include "window.h"
+#include "intervals.h"
+
+\f
+/* An explanation of the face data structures. */
+
+/* ========================= Face Data Structures =========================
+
+ Let FACE-NAME be a symbol naming a face.
+
+ Let FACE-VECTOR be (assq FACE-NAME (frame-face-alist FRAME))
+ FACE-VECTOR is either nil, or a vector of the form
+ [face NAME ID FONT FOREGROUND BACKGROUND BACKGROUND-PIXMAP UNDERLINE-P]
+ where
+ face is the symbol `face',
+ NAME is the symbol with which this vector is associated (a backpointer),
+ ID is the face ID, an integer used internally by the C code to identify
+ the face,
+ FONT, FOREGROUND, and BACKGROUND are strings naming the fonts and colors
+ to use with the face,
+ BACKGROUND-PIXMAP is the name of an x bitmap filename, which we don't
+ use right now, and
+ UNDERLINE-P is non-nil if the face should be underlined.
+ If any of these elements are nil, that parameter is considered
+ unspecified; parameters from faces specified by lower-priority
+ overlays or text properties, or the parameters of the frame itself,
+ can show through. (lisp/faces.el maintains these lists.)
+
+ (assq FACE-NAME global-face-data) returns a vector describing the
+ global parameters for that face.
+
+ Let PARAM-FACE be FRAME->display.x->param_faces[Faref (FACE-VECTOR, 2)].
+ PARAM_FACE is a struct face whose members are the Xlib analogues of
+ the parameters in FACE-VECTOR. If an element of FACE-VECTOR is
+ nil, then the corresponding member of PARAM_FACE is FACE_DEFAULT.
+ These faces are called "parameter faces", because they're the ones
+ lisp manipulates to control what gets displayed. Elements 0 and 1
+ of FRAME->display.x->param_faces are special - they describe the
+ default and mode line faces. None of the faces in param_faces have
+ GC's. (See src/dispextern.h for the definiton of struct face.
+ lisp/faces.el maintains the isomorphism between face_alist and
+ param_faces.)
+
+ The functions compute_char_face and compute_glyph_face find and
+ combine the parameter faces associated with overlays and text
+ properties. The resulting faces are called "computed faces"; none
+ of their members are FACE_DEFAULT; they are completely specified.
+ They then call intern_compute_face to search
+ FRAME->display.x->computed_faces for a matching face, add one if
+ none is found, and return the index into
+ FRAME->display.x->computed_faces. FRAME's glyph matrices use these
+ indices to record the faces of the matrix characters, and the X
+ display hooks consult compute_faces to decide how to display these
+ characters. Elements 0 and 1 of computed_faces always describe the
+ default and mode-line faces.
+
+ Each computed face belongs to a particular frame.
+
+ Computed faces have graphics contexts some of the time.
+ intern_face builds a GC for a specified computed face
+ if it doesn't have one already.
+ clear_face_cache clears out the GCs of all computed faces.
+ This is done from time to time so that we don't hold on to
+ lots of GCs that are no longer needed.
+
+ Constraints:
+
+ Symbols naming faces must have associations on all frames; for any
+ FRAME, for all FACE-NAME, if (assq FACE-NAME (frame-face-alist
+ FRAME)) is non-nil, it must be non-nil for all frames.
+
+ Analogously, indices into param_faces must be valid on all frames;
+ if param_faces[i] is a non-zero face pointer on one frame, then it
+ must be filled in on all frames. Code assumes that face ID's can
+ be used on any frame.
+
+ Some subtleties:
+
+ Why do we keep param_faces and computed_faces separate?
+ computed_faces contains an element for every combination of facial
+ parameters we have ever displayed. indices into param_faces have
+ to be valid on all frames. If they were the same array, then that
+ array would grow very large on all frames, because any facial
+ combination displayed on any frame would need to be a valid entry
+ on all frames. */
+\f
+/* Definitions and declarations. */
+
+/* The number of face-id's in use (same for all frames). */
+static int next_face_id;
+
+/* The number of the face to use to indicate the region. */
+static int region_face;
+
+/* This is what appears in a slot in a face to signify that the face
+ does not specify that display aspect. */
+#define FACE_DEFAULT (~0)
+
+Lisp_Object Qface, Qmouse_face;
+Lisp_Object Qpixmap_spec_p;
+
+int face_name_id_number ( /* FRAME_PTR, Lisp_Object name */ );
+
+struct face *intern_face ( /* FRAME_PTR, struct face * */ );
+static int new_computed_face ( /* FRAME_PTR, struct face * */ );
+static int intern_computed_face ( /* FRAME_PTR, struct face * */ );
+static void ensure_face_ready ( /* FRAME_PTR, int id */ );
+void recompute_basic_faces ( /* FRAME_PTR f */ );
+\f
+/* Allocating, copying, and comparing struct faces. */
+
+/* Allocate a new face */
+static struct face *
+allocate_face ()
+{
+ struct face *result = (struct face *) xmalloc (sizeof (struct face));
+ bzero (result, sizeof (struct face));
+ result->font = (XFontStruct *) FACE_DEFAULT;
+ result->foreground = FACE_DEFAULT;
+ result->background = FACE_DEFAULT;
+ result->stipple = FACE_DEFAULT;
+ return result;
+}
+
+/* Make a new face that's a copy of an existing one. */
+static struct face *
+copy_face (face)
+ struct face *face;
+{
+ struct face *result = allocate_face ();
+
+ result->font = face->font;
+ result->foreground = face->foreground;
+ result->background = face->background;
+ result->stipple = face->stipple;
+ result->underline = face->underline;
+ result->pixmap_h = face->pixmap_h;
+ result->pixmap_w = face->pixmap_w;
+
+ return result;
+}
+
+static int
+face_eql (face1, face2)
+ struct face *face1, *face2;
+{
+ return ( face1->font == face2->font
+ && face1->foreground == face2->foreground
+ && face1->background == face2->background
+ && face1->stipple == face2->stipple
+ && face1->underline == face2->underline);
+}
+\f
+/* Managing graphics contexts of faces. */
+
+/* Given a computed face, construct its graphics context if necessary. */
+
+struct face *
+intern_face (f, face)
+ struct frame *f;
+ struct face *face;
+{
+ face->gc = NULL;
+
+ return face;
+}
+
+/* Clear out all graphics contexts for all computed faces
+ except for the default and mode line faces.
+ This should be done from time to time just to avoid
+ keeping too many graphics contexts that are no longer needed. */
+
+void
+clear_face_cache ()
+{
+/* Nothing extra */
+}
+\f
+/* Allocating, freeing, and duplicating fonts, colors, and pixmaps.
+
+ These functions operate on param faces only.
+ Computed faces get their fonts, colors and pixmaps
+ by merging param faces. */
+
+static XFontStruct *
+load_font (f, name)
+ struct frame *f;
+ Lisp_Object name;
+{
+ XFontStruct *font;
+
+ if (NILP (name))
+ return (XFontStruct *) FACE_DEFAULT;
+
+ CHECK_STRING (name, 0);
+ BLOCK_INPUT;
+ font = win32_load_font (FRAME_WIN32_DISPLAY_INFO (f), (char *) XSTRING (name)->data);
+ UNBLOCK_INPUT;
+
+ if (! font)
+ Fsignal (Qerror, Fcons (build_string ("undefined font"),
+ Fcons (name, Qnil)));
+ return font;
+}
+
+static void
+unload_font (f, font)
+ struct frame *f;
+ XFontStruct *font;
+{
+ if (!font || font == ((XFontStruct *) FACE_DEFAULT))
+ return;
+
+ BLOCK_INPUT;
+ win32_unload_font (FRAME_WIN32_DISPLAY_INFO (f), font);
+ UNBLOCK_INPUT;
+}
+
+static unsigned long
+load_color (f, name)
+ struct frame *f;
+ Lisp_Object name;
+{
+ COLORREF color;
+ int result;
+
+ if (NILP (name))
+ return FACE_DEFAULT;
+
+ CHECK_STRING (name, 0);
+ /* if the colormap is full, defined_color will return a best match
+ to the values in an an existing cell. */
+ result = defined_color(f, (char *) XSTRING (name)->data, &color, 1);
+ if (! result)
+ Fsignal (Qerror, Fcons (build_string ("undefined color"),
+ Fcons (name, Qnil)));
+ return (unsigned long) color;
+}
+
+static void
+unload_color (f, pixel)
+ struct frame *f;
+ unsigned long pixel;
+{
+}
+
+DEFUN ("pixmap-spec-p", Fpixmap_spec_p, Spixmap_spec_p, 1, 1, 0,
+ "Return t if ARG is a valid pixmap specification.")
+ (arg)
+ Lisp_Object arg;
+{
+ Lisp_Object height, width;
+
+ return ((STRINGP (arg)
+ || (CONSP (arg)
+ && CONSP (XCONS (arg)->cdr)
+ && CONSP (XCONS (XCONS (arg)->cdr)->cdr)
+ && NILP (XCONS (XCONS (XCONS (arg)->cdr)->cdr)->cdr)
+ && (width = XCONS (arg)->car, INTEGERP (width))
+ && (height = XCONS (XCONS (arg)->cdr)->car, INTEGERP (height))
+ && STRINGP (XCONS (XCONS (XCONS (arg)->cdr)->cdr)->car)
+ && XINT (width) > 0
+ && XINT (height) > 0
+ /* The string must have enough bits for width * height. */
+ && ((XSTRING (XCONS (XCONS (XCONS (arg)->cdr)->cdr)->car)->size
+ * (BITS_PER_INT / sizeof (int)))
+ >= XFASTINT (width) * XFASTINT (height))))
+ ? Qt : Qnil);
+}
+
+/* Load a bitmap according to NAME (which is either a file name
+ or a pixmap spec). Return the bitmap_id (see xfns.c)
+ or get an error if NAME is invalid.
+
+ Store the bitmap width in *W_PTR and height in *H_PTR. */
+
+static long
+load_pixmap (f, name, w_ptr, h_ptr)
+ FRAME_PTR f;
+ Lisp_Object name;
+ unsigned int *w_ptr, *h_ptr;
+{
+ int bitmap_id;
+ Lisp_Object tem;
+
+ if (NILP (name))
+ return FACE_DEFAULT;
+
+ tem = Fpixmap_spec_p (name);
+ if (NILP (tem))
+ wrong_type_argument (Qpixmap_spec_p, name);
+
+ BLOCK_INPUT;
+
+ if (CONSP (name))
+ {
+ /* Decode a bitmap spec into a bitmap. */
+
+ int h, w;
+ Lisp_Object bits;
+
+ w = XINT (Fcar (name));
+ h = XINT (Fcar (Fcdr (name)));
+ bits = Fcar (Fcdr (Fcdr (name)));
+
+ bitmap_id = x_create_bitmap_from_data (f, XSTRING (bits)->data,
+ w, h);
+ }
+ else
+ {
+ /* It must be a string -- a file name. */
+ bitmap_id = x_create_bitmap_from_file (f, name);
+ }
+ UNBLOCK_INPUT;
+
+ if (bitmap_id < 0)
+ Fsignal (Qerror, Fcons (build_string ("invalid or undefined bitmap"),
+ Fcons (name, Qnil)));
+
+ *w_ptr = x_bitmap_width (f, bitmap_id);
+ *h_ptr = x_bitmap_height (f, bitmap_id);
+
+ return bitmap_id;
+}
+
+\f
+/* Managing parameter face arrays for frames. */
+
+void
+init_frame_faces (f)
+ FRAME_PTR f;
+{
+ ensure_face_ready (f, 0);
+ ensure_face_ready (f, 1);
+
+ FRAME_N_COMPUTED_FACES (f) = 0;
+ FRAME_SIZE_COMPUTED_FACES (f) = 0;
+
+ new_computed_face (f, FRAME_PARAM_FACES (f)[0]);
+ new_computed_face (f, FRAME_PARAM_FACES (f)[1]);
+ recompute_basic_faces (f);
+
+#ifdef MULTI_FRAME
+ /* Find another frame. */
+ {
+ Lisp_Object tail, frame, result;
+
+ result = Qnil;
+ FOR_EACH_FRAME (tail, frame)
+ if (FRAME_WIN32_P (XFRAME (frame))
+ && XFRAME (frame) != f)
+ {
+ result = frame;
+ break;
+ }
+
+ /* If we didn't find any X frames other than f, then we don't need
+ any faces other than 0 and 1, so we're okay. Otherwise, make
+ sure that all faces valid on the selected frame are also valid
+ on this new frame. */
+ if (FRAMEP (result))
+ {
+ int i;
+ int n_faces = FRAME_N_PARAM_FACES (XFRAME (result));
+ struct face **faces = FRAME_PARAM_FACES (XFRAME (result));
+
+ for (i = 2; i < n_faces; i++)
+ if (faces[i])
+ ensure_face_ready (f, i);
+ }
+ }
+#endif /* MULTI_FRAME */
+}
+
+
+/* Called from Fdelete_frame. */
+
+void
+free_frame_faces (f)
+ struct frame *f;
+{
+ int i;
+
+ BLOCK_INPUT;
+
+ for (i = 0; i < FRAME_N_PARAM_FACES (f); i++)
+ {
+ struct face *face = FRAME_PARAM_FACES (f) [i];
+ if (face)
+ {
+ unload_font (f, face->font);
+ unload_color (f, face->foreground);
+ unload_color (f, face->background);
+ x_destroy_bitmap (f, face->stipple);
+ xfree (face);
+ }
+ }
+ xfree (FRAME_PARAM_FACES (f));
+ FRAME_PARAM_FACES (f) = 0;
+ FRAME_N_PARAM_FACES (f) = 0;
+
+ /* All faces in FRAME_COMPUTED_FACES use resources copied from
+ FRAME_PARAM_FACES; we can free them without fuss.
+ But we do free the GCs and the face objects themselves. */
+ for (i = 0; i < FRAME_N_COMPUTED_FACES (f); i++)
+ {
+ struct face *face = FRAME_COMPUTED_FACES (f) [i];
+ if (face)
+ {
+ xfree (face);
+ }
+ }
+ xfree (FRAME_COMPUTED_FACES (f));
+ FRAME_COMPUTED_FACES (f) = 0;
+ FRAME_N_COMPUTED_FACES (f) = 0;
+
+ UNBLOCK_INPUT;
+}
+\f
+/* Interning faces in a frame's face array. */
+
+static int
+new_computed_face (f, new_face)
+ struct frame *f;
+ struct face *new_face;
+{
+ int i = FRAME_N_COMPUTED_FACES (f);
+
+ if (i >= FRAME_SIZE_COMPUTED_FACES (f))
+ {
+ int new_size = i + 32;
+
+ FRAME_COMPUTED_FACES (f)
+ = (struct face **) (FRAME_SIZE_COMPUTED_FACES (f) == 0
+ ? xmalloc (new_size * sizeof (struct face *))
+ : xrealloc (FRAME_COMPUTED_FACES (f),
+ new_size * sizeof (struct face *)));
+ FRAME_SIZE_COMPUTED_FACES (f) = new_size;
+ }
+
+ i = FRAME_N_COMPUTED_FACES (f)++;
+ FRAME_COMPUTED_FACES (f)[i] = copy_face (new_face);
+ return i;
+}
+
+
+/* Find a match for NEW_FACE in a FRAME's computed face array, and add
+ it if we don't find one. */
+static int
+intern_computed_face (f, new_face)
+ struct frame *f;
+ struct face *new_face;
+{
+ int len = FRAME_N_COMPUTED_FACES (f);
+ int i;
+
+ /* Search for a computed face already on F equivalent to FACE. */
+ for (i = 0; i < len; i++)
+ {
+ if (! FRAME_COMPUTED_FACES (f)[i])
+ abort ();
+ if (face_eql (new_face, FRAME_COMPUTED_FACES (f)[i]))
+ return i;
+ }
+
+ /* We didn't find one; add a new one. */
+ return new_computed_face (f, new_face);
+}
+
+/* Make parameter face id ID valid on frame F. */
+
+static void
+ensure_face_ready (f, id)
+ struct frame *f;
+ int id;
+{
+ if (FRAME_N_PARAM_FACES (f) <= id)
+ {
+ int n = id + 10;
+ int i;
+ if (!FRAME_N_PARAM_FACES (f))
+ FRAME_PARAM_FACES (f)
+ = (struct face **) xmalloc (sizeof (struct face *) * n);
+ else
+ FRAME_PARAM_FACES (f)
+ = (struct face **) xrealloc (FRAME_PARAM_FACES (f),
+ sizeof (struct face *) * n);
+
+ bzero (FRAME_PARAM_FACES (f) + FRAME_N_PARAM_FACES (f),
+ (n - FRAME_N_PARAM_FACES (f)) * sizeof (struct face *));
+ FRAME_N_PARAM_FACES (f) = n;
+ }
+
+ if (FRAME_PARAM_FACES (f) [id] == 0)
+ FRAME_PARAM_FACES (f) [id] = allocate_face ();
+}
+\f
+/* Return non-zero if FONT1 and FONT2 have the same width.
+ We do not check the height, because we can now deal with
+ different heights.
+ We assume that they're both character-cell fonts. */
+
+int
+same_size_fonts (font1, font2)
+ XFontStruct *font1, *font2;
+{
+ return (FONT_WIDTH(font1) == FONT_WIDTH(font2));
+}
+
+/* Update the line_height of frame F according to the biggest font in
+ any face. Return nonzero if if line_height changes. */
+
+int
+frame_update_line_height (f)
+ FRAME_PTR f;
+{
+ int i;
+ int biggest = FONT_HEIGHT (f->output_data.win32->font);
+
+ for (i = 0; i < f->output_data.win32->n_param_faces; i++)
+ if (f->output_data.win32->param_faces[i] != 0
+ && f->output_data.win32->param_faces[i]->font != (XFontStruct *) FACE_DEFAULT)
+ {
+ int height = FONT_HEIGHT (f->output_data.win32->param_faces[i]->font);
+ if (height > biggest)
+ biggest = height;
+ }
+
+ if (biggest == f->output_data.win32->line_height)
+ return 0;
+
+ f->output_data.win32->line_height = biggest;
+ return 1;
+}
+\f
+/* Modify face TO by copying from FROM all properties which have
+ nondefault settings. */
+
+static void
+merge_faces (from, to)
+ struct face *from, *to;
+{
+ /* Only merge the font if it's the same width as the base font.
+ Otherwise ignore it, since we can't handle it properly. */
+ if (from->font != (XFontStruct *) FACE_DEFAULT
+ && same_size_fonts (from->font, to->font))
+ to->font = from->font;
+ if (from->foreground != FACE_DEFAULT)
+ to->foreground = from->foreground;
+ if (from->background != FACE_DEFAULT)
+ to->background = from->background;
+ if (from->stipple != FACE_DEFAULT)
+ {
+ to->stipple = from->stipple;
+ to->pixmap_h = from->pixmap_h;
+ to->pixmap_w = from->pixmap_w;
+ }
+ if (from->underline)
+ to->underline = from->underline;
+}
+
+/* Set up the basic set of facial parameters, based on the frame's
+ data; all faces are deltas applied to this. */
+
+static void
+compute_base_face (f, face)
+ FRAME_PTR f;
+ struct face *face;
+{
+ face->gc = 0;
+ face->foreground = FRAME_FOREGROUND_PIXEL (f);
+ face->background = FRAME_BACKGROUND_PIXEL (f);
+ face->font = FRAME_FONT (f);
+ face->stipple = 0;
+ face->underline = 0;
+}
+
+/* Return the face ID to use to display a special glyph which selects
+ FACE_CODE as the face ID, assuming that ordinarily the face would
+ be CURRENT_FACE. F is the frame. */
+
+int
+compute_glyph_face (f, face_code, current_face)
+ struct frame *f;
+ int face_code, current_face;
+{
+ struct face face;
+
+ face = *FRAME_COMPUTED_FACES (f)[current_face];
+
+ if (face_code >= 0 && face_code < FRAME_N_PARAM_FACES (f)
+ && FRAME_PARAM_FACES (f) [face_code] != 0)
+ merge_faces (FRAME_PARAM_FACES (f) [face_code], &face);
+
+ return intern_computed_face (f, &face);
+}
+
+/* Return the face ID to use to display a special glyph which selects
+ FACE_CODE as the face ID, assuming that ordinarily the face would
+ be CURRENT_FACE. F is the frame. */
+
+int
+compute_glyph_face_1 (f, face_name, current_face)
+ struct frame *f;
+ Lisp_Object face_name;
+ int current_face;
+{
+ struct face face;
+
+ face = *FRAME_COMPUTED_FACES (f)[current_face];
+
+ if (!NILP (face_name))
+ {
+ int facecode = face_name_id_number (f, face_name);
+ if (facecode >= 0 && facecode < FRAME_N_PARAM_FACES (f)
+ && FRAME_PARAM_FACES (f) [facecode] != 0)
+ merge_faces (FRAME_PARAM_FACES (f) [facecode], &face);
+ }
+
+ return intern_computed_face (f, &face);
+}
+\f
+/* Return the face ID associated with a buffer position POS.
+ Store into *ENDPTR the position at which a different face is needed.
+ This does not take account of glyphs that specify their own face codes.
+ F is the frame in use for display, and W is a window displaying
+ the current buffer.
+
+ REGION_BEG, REGION_END delimit the region, so it can be highlighted.
+
+ LIMIT is a position not to scan beyond. That is to limit
+ the time this function can take.
+
+ If MOUSE is nonzero, use the character's mouse-face, not its face. */
+
+int
+compute_char_face (f, w, pos, region_beg, region_end, endptr, limit, mouse)
+ struct frame *f;
+ struct window *w;
+ int pos;
+ int region_beg, region_end;
+ int *endptr;
+ int limit;
+ int mouse;
+{
+ struct face face;
+ Lisp_Object prop, position;
+ int i, j, noverlays;
+ int facecode;
+ Lisp_Object *overlay_vec;
+ Lisp_Object frame;
+ int endpos;
+ Lisp_Object propname;
+
+ /* W must display the current buffer. We could write this function
+ to use the frame and buffer of W, but right now it doesn't. */
+ if (XBUFFER (w->buffer) != current_buffer)
+ abort ();
+
+ XSETFRAME (frame, f);
+
+ endpos = ZV;
+ if (pos < region_beg && region_beg < endpos)
+ endpos = region_beg;
+
+ XSETFASTINT (position, pos);
+
+ if (mouse)
+ propname = Qmouse_face;
+ else
+ propname = Qface;
+
+ prop = Fget_text_property (position, propname, w->buffer);
+
+ {
+ Lisp_Object limit1, end;
+
+ XSETFASTINT (limit1, (limit < endpos ? limit : endpos));
+ end = Fnext_single_property_change (position, propname, w->buffer, limit1);
+ if (INTEGERP (end))
+ endpos = XINT (end);
+ }
+
+ {
+ int next_overlay;
+ int len;
+
+ /* First try with room for 40 overlays. */
+ len = 40;
+ overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
+
+ noverlays = overlays_at (pos, 0, &overlay_vec, &len,
+ &next_overlay, (int *) 0);
+
+ /* If there are more than 40,
+ make enough space for all, and try again. */
+ if (noverlays > len)
+ {
+ len = noverlays;
+ overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
+ noverlays = overlays_at (pos, 0, &overlay_vec, &len,
+ &next_overlay, (int *) 0);
+ }
+
+ if (next_overlay < endpos)
+ endpos = next_overlay;
+ }
+
+ *endptr = endpos;
+
+ /* Optimize the default case. */
+ if (noverlays == 0 && NILP (prop)
+ && !(pos >= region_beg && pos < region_end))
+ return 0;
+
+ compute_base_face (f, &face);
+
+ if (CONSP (prop))
+ {
+ /* We have a list of faces, merge them in reverse order */
+ Lisp_Object length = Flength (prop);
+ int len = XINT (length);
+ Lisp_Object *faces;
+
+ /* Put them into an array */
+ faces = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
+ for (j = 0; j < len; j++)
+ {
+ faces[j] = Fcar (prop);
+ prop = Fcdr (prop);
+ }
+ /* So that we can merge them in the reverse order */
+ for (j = len - 1; j >= 0; j--)
+ {
+ facecode = face_name_id_number (f, faces[j]);
+ if (facecode >= 0 && facecode < FRAME_N_PARAM_FACES (f)
+ && FRAME_PARAM_FACES (f) [facecode] != 0)
+ merge_faces (FRAME_PARAM_FACES (f) [facecode], &face);
+ }
+ }
+ else if (!NILP (prop))
+ {
+ facecode = face_name_id_number (f, prop);
+ if (facecode >= 0 && facecode < FRAME_N_PARAM_FACES (f)
+ && FRAME_PARAM_FACES (f) [facecode] != 0)
+ merge_faces (FRAME_PARAM_FACES (f) [facecode], &face);
+ }
+
+ noverlays = sort_overlays (overlay_vec, noverlays, w);
+
+ /* Now merge the overlay data in that order. */
+ for (i = 0; i < noverlays; i++)
+ {
+ prop = Foverlay_get (overlay_vec[i], propname);
+ if (CONSP (prop))
+ {
+ /* We have a list of faces, merge them in reverse order */
+ Lisp_Object length = Flength (prop);
+ int len = XINT (length);
+ Lisp_Object *faces;
+ int i;
+
+ /* Put them into an array */
+ faces = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
+ for (j = 0; j < len; j++)
+ {
+ faces[j] = Fcar (prop);
+ prop = Fcdr (prop);
+ }
+ /* So that we can merge them in the reverse order */
+ for (j = len - 1; j >= 0; j--)
+ {
+ facecode = face_name_id_number (f, faces[j]);
+ if (facecode >= 0 && facecode < FRAME_N_PARAM_FACES (f)
+ && FRAME_PARAM_FACES (f) [facecode] != 0)
+ merge_faces (FRAME_PARAM_FACES (f) [facecode], &face);
+ }
+ }
+ else if (!NILP (prop))
+ {
+ Lisp_Object oend;
+ int oendpos;
+
+ facecode = face_name_id_number (f, prop);
+ if (facecode >= 0 && facecode < FRAME_N_PARAM_FACES (f)
+ && FRAME_PARAM_FACES (f) [facecode] != 0)
+ merge_faces (FRAME_PARAM_FACES (f)[facecode], &face);
+
+ oend = OVERLAY_END (overlay_vec[i]);
+ oendpos = OVERLAY_POSITION (oend);
+ if (oendpos < endpos)
+ endpos = oendpos;
+ }
+ }
+
+ if (pos >= region_beg && pos < region_end)
+ {
+ if (region_end < endpos)
+ endpos = region_end;
+ if (region_face >= 0 && region_face < next_face_id)
+ merge_faces (FRAME_PARAM_FACES (f)[region_face], &face);
+ }
+
+ *endptr = endpos;
+
+ return intern_computed_face (f, &face);
+}
+\f
+/* Recompute the GC's for the default and modeline faces.
+ We call this after changing frame parameters on which those GC's
+ depend. */
+
+void
+recompute_basic_faces (f)
+ FRAME_PTR f;
+{
+ /* If the frame's faces haven't been initialized yet, don't worry about
+ this stuff. */
+ if (FRAME_N_PARAM_FACES (f) < 2)
+ return;
+
+ BLOCK_INPUT;
+
+ compute_base_face (f, FRAME_DEFAULT_FACE (f));
+ compute_base_face (f, FRAME_MODE_LINE_FACE (f));
+
+ merge_faces (FRAME_DEFAULT_PARAM_FACE (f), FRAME_DEFAULT_FACE (f));
+ merge_faces (FRAME_MODE_LINE_PARAM_FACE (f), FRAME_MODE_LINE_FACE (f));
+
+ intern_face (f, FRAME_DEFAULT_FACE (f));
+ intern_face (f, FRAME_MODE_LINE_FACE (f));
+
+ UNBLOCK_INPUT;
+}
+
+
+\f
+/* Lisp interface. */
+
+DEFUN ("frame-face-alist", Fframe_face_alist, Sframe_face_alist, 1, 1, 0,
+ "")
+ (frame)
+ Lisp_Object frame;
+{
+ CHECK_FRAME (frame, 0);
+ return XFRAME (frame)->face_alist;
+}
+
+DEFUN ("set-frame-face-alist", Fset_frame_face_alist, Sset_frame_face_alist,
+ 2, 2, 0, "")
+ (frame, value)
+ Lisp_Object frame, value;
+{
+ CHECK_FRAME (frame, 0);
+ XFRAME (frame)->face_alist = value;
+ return value;
+}
+
+
+DEFUN ("make-face-internal", Fmake_face_internal, Smake_face_internal, 1, 1, 0,
+ "Create face number FACE-ID on all frames.")
+ (face_id)
+ Lisp_Object face_id;
+{
+ Lisp_Object rest, frame;
+ int id = XINT (face_id);
+
+ CHECK_NUMBER (face_id, 0);
+ if (id < 0 || id >= next_face_id)
+ error ("Face id out of range");
+
+ FOR_EACH_FRAME (rest, frame)
+ {
+ if (FRAME_WIN32_P (XFRAME (frame)))
+ ensure_face_ready (XFRAME (frame), id);
+ }
+ return Qnil;
+}
+
+
+DEFUN ("set-face-attribute-internal", Fset_face_attribute_internal,
+ Sset_face_attribute_internal, 4, 4, 0, "")
+ (face_id, attr_name, attr_value, frame)
+ Lisp_Object face_id, attr_name, attr_value, frame;
+{
+ struct face *face;
+ struct frame *f;
+ int magic_p;
+ int id;
+ int garbaged = 0;
+
+ CHECK_FRAME (frame, 0);
+ CHECK_NUMBER (face_id, 0);
+ CHECK_SYMBOL (attr_name, 0);
+
+ f = XFRAME (frame);
+ id = XINT (face_id);
+ if (id < 0 || id >= next_face_id)
+ error ("Face id out of range");
+
+ if (! FRAME_WIN32_P (f))
+ return Qnil;
+
+ ensure_face_ready (f, id);
+ face = FRAME_PARAM_FACES (f) [XFASTINT (face_id)];
+
+ if (EQ (attr_name, intern ("font")))
+ {
+ XFontStruct *font = load_font (f, attr_value);
+ if (face->font != f->output_data.win32->font)
+ unload_font (f, face->font);
+ face->font = font;
+ if (frame_update_line_height (f))
+ x_set_window_size (f, 0, f->width, f->height);
+ /* Must clear cache, since it might contain the font
+ we just got rid of. */
+ garbaged = 1;
+ }
+ else if (EQ (attr_name, intern ("foreground")))
+ {
+ unsigned long new_color = load_color (f, attr_value);
+ unload_color (f, face->foreground);
+ face->foreground = new_color;
+ garbaged = 1;
+ }
+ else if (EQ (attr_name, intern ("background")))
+ {
+ unsigned long new_color = load_color (f, attr_value);
+ unload_color (f, face->background);
+ face->background = new_color;
+ garbaged = 1;
+ }
+ else if (EQ (attr_name, intern ("background-pixmap")))
+ {
+ unsigned int w, h;
+ unsigned long new_pixmap = load_pixmap (f, attr_value, &w, &h);
+ x_destroy_bitmap (f, face->stipple);
+ face->stipple = (Pixmap) new_pixmap;
+ face->pixmap_w = w;
+ face->pixmap_h = h;
+ garbaged = 1;
+ }
+ else if (EQ (attr_name, intern ("underline")))
+ {
+ int new = !NILP (attr_value);
+ face->underline = new;
+ }
+ else
+ error ("unknown face attribute");
+
+ if (id == 0 || id == 1)
+ recompute_basic_faces (f);
+
+ /* We must redraw the frame whenever any face font or color changes,
+ because it's possible that a merged (display) face
+ contains the font or color we just replaced.
+ And we must inhibit any Expose events until the redraw is done,
+ since they would try to use the invalid display faces. */
+ if (garbaged)
+ SET_FRAME_GARBAGED (f);
+
+ return Qnil;
+}
+
+DEFUN ("internal-next-face-id", Finternal_next_face_id, Sinternal_next_face_id,
+ 0, 0, 0, "")
+ ()
+{
+ return make_number (next_face_id++);
+}
+
+/* Return the face id for name NAME on frame FRAME.
+ (It should be the same for all frames,
+ but it's as easy to use the "right" frame to look it up
+ as to use any other one.) */
+
+int
+face_name_id_number (f, name)
+ FRAME_PTR f;
+ Lisp_Object name;
+{
+ Lisp_Object tem;
+
+ tem = Fcdr (assq_no_quit (name, f->face_alist));
+ if (NILP (tem))
+ return 0;
+ CHECK_VECTOR (tem, 0);
+ tem = XVECTOR (tem)->contents[2];
+ CHECK_NUMBER (tem, 0);
+ return XINT (tem);
+}
+\f
+/* Emacs initialization. */
+
+void
+syms_of_win32faces ()
+{
+ Qface = intern ("face");
+ staticpro (&Qface);
+ Qmouse_face = intern ("mouse-face");
+ staticpro (&Qmouse_face);
+ Qpixmap_spec_p = intern ("pixmap-spec-p");
+ staticpro (&Qpixmap_spec_p);
+
+ DEFVAR_INT ("region-face", ®ion_face,
+ "Face number to use to highlight the region\n\
+The region is highlighted with this face\n\
+when Transient Mark mode is enabled and the mark is active.");
+
+ defsubr (&Spixmap_spec_p);
+ defsubr (&Sframe_face_alist);
+ defsubr (&Sset_frame_face_alist);
+ defsubr (&Smake_face_internal);
+ defsubr (&Sset_face_attribute_internal);
+ defsubr (&Sinternal_next_face_id);
+}
--- /dev/null
+/* Functions for the Win32 window system.
+ Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs; see the file COPYING. If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+/* Added by Kevin Gallo */
+
+#include <signal.h>
+#include <config.h>
+#include <stdio.h>
+
+#include "lisp.h"
+#include "w32term.h"
+#include "frame.h"
+#include "window.h"
+#include "buffer.h"
+#include "dispextern.h"
+#include "keyboard.h"
+#include "blockinput.h"
+#include "paths.h"
+#include "ntheap.h"
+#include "termhooks.h"
+
+#include <commdlg.h>
+
+extern void abort ();
+extern void free_frame_menubar ();
+extern struct scroll_bar *x_window_to_scroll_bar ();
+
+/* The colormap for converting color names to RGB values */
+Lisp_Object Vwin32_color_map;
+
+/* The name we're using in resource queries. */
+Lisp_Object Vx_resource_name;
+
+/* Non nil if no window manager is in use. */
+Lisp_Object Vx_no_window_manager;
+
+/* The background and shape of the mouse pointer, and shape when not
+ over text or in the modeline. */
+Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
+/* The shape when over mouse-sensitive text. */
+Lisp_Object Vx_sensitive_text_pointer_shape;
+
+/* Color of chars displayed in cursor box. */
+Lisp_Object Vx_cursor_fore_pixel;
+
+/* Search path for bitmap files. */
+Lisp_Object Vx_bitmap_file_path;
+
+/* Evaluate this expression to rebuild the section of syms_of_w32fns
+ that initializes and staticpros the symbols declared below. Note
+ that Emacs 18 has a bug that keeps C-x C-e from being able to
+ evaluate this expression.
+
+(progn
+ ;; Accumulate a list of the symbols we want to initialize from the
+ ;; declarations at the top of the file.
+ (goto-char (point-min))
+ (search-forward "/\*&&& symbols declared here &&&*\/\n")
+ (let (symbol-list)
+ (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
+ (setq symbol-list
+ (cons (buffer-substring (match-beginning 1) (match-end 1))
+ symbol-list))
+ (forward-line 1))
+ (setq symbol-list (nreverse symbol-list))
+ ;; Delete the section of syms_of_... where we initialize the symbols.
+ (search-forward "\n /\*&&& init symbols here &&&*\/\n")
+ (let ((start (point)))
+ (while (looking-at "^ Q")
+ (forward-line 2))
+ (kill-region start (point)))
+ ;; Write a new symbol initialization section.
+ (while symbol-list
+ (insert (format " %s = intern (\"" (car symbol-list)))
+ (let ((start (point)))
+ (insert (substring (car symbol-list) 1))
+ (subst-char-in-region start (point) ?_ ?-))
+ (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
+ (setq symbol-list (cdr symbol-list)))))
+
+ */
+
+/*&&& symbols declared here &&&*/
+Lisp_Object Qauto_raise;
+Lisp_Object Qauto_lower;
+Lisp_Object Qbackground_color;
+Lisp_Object Qbar;
+Lisp_Object Qborder_color;
+Lisp_Object Qborder_width;
+Lisp_Object Qbox;
+Lisp_Object Qcursor_color;
+Lisp_Object Qcursor_type;
+Lisp_Object Qfont;
+Lisp_Object Qforeground_color;
+Lisp_Object Qgeometry;
+Lisp_Object Qicon_left;
+Lisp_Object Qicon_top;
+Lisp_Object Qicon_type;
+Lisp_Object Qicon_name;
+Lisp_Object Qinternal_border_width;
+Lisp_Object Qleft;
+Lisp_Object Qmouse_color;
+Lisp_Object Qnone;
+Lisp_Object Qparent_id;
+Lisp_Object Qscroll_bar_width;
+Lisp_Object Qsuppress_icon;
+Lisp_Object Qtop;
+Lisp_Object Qundefined_color;
+Lisp_Object Qvertical_scroll_bars;
+Lisp_Object Qvisibility;
+Lisp_Object Qwindow_id;
+Lisp_Object Qx_frame_parameter;
+Lisp_Object Qx_resource_name;
+Lisp_Object Quser_position;
+Lisp_Object Quser_size;
+Lisp_Object Qdisplay;
+
+/* The below are defined in frame.c. */
+extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
+extern Lisp_Object Qunsplittable, Qmenu_bar_lines;
+
+extern Lisp_Object Vwindow_system_version;
+
+extern Lisp_Object last_mouse_scroll_bar;
+extern int last_mouse_scroll_bar_pos;
+Time last_mouse_movement_time;
+
+\f
+/* Extract a frame as a FRAME_PTR, defaulting to the selected frame
+ and checking validity for Win32. */
+
+FRAME_PTR
+check_x_frame (frame)
+ Lisp_Object frame;
+{
+ FRAME_PTR f;
+
+ if (NILP (frame))
+ f = selected_frame;
+ else
+ {
+ CHECK_LIVE_FRAME (frame, 0);
+ f = XFRAME (frame);
+ }
+ if (! FRAME_WIN32_P (f))
+ error ("non-win32 frame used");
+ return f;
+}
+
+/* Let the user specify an display with a frame.
+ nil stands for the selected frame--or, if that is not a win32 frame,
+ the first display on the list. */
+
+static struct win32_display_info *
+check_x_display_info (frame)
+ Lisp_Object frame;
+{
+ if (NILP (frame))
+ {
+ if (FRAME_WIN32_P (selected_frame))
+ return FRAME_WIN32_DISPLAY_INFO (selected_frame);
+ else
+ return &one_win32_display_info;
+ }
+ else if (STRINGP (frame))
+ return x_display_info_for_name (frame);
+ else
+ {
+ FRAME_PTR f;
+
+ CHECK_LIVE_FRAME (frame, 0);
+ f = XFRAME (frame);
+ if (! FRAME_WIN32_P (f))
+ error ("non-win32 frame used");
+ return FRAME_WIN32_DISPLAY_INFO (f);
+ }
+}
+\f
+/* Return the Emacs frame-object corresponding to an win32 window.
+ It could be the frame's main window or an icon window. */
+
+/* This function can be called during GC, so use GC_xxx type test macros. */
+
+struct frame *
+x_window_to_frame (dpyinfo, wdesc)
+ struct win32_display_info *dpyinfo;
+ HWND wdesc;
+{
+ Lisp_Object tail, frame;
+ struct frame *f;
+
+ for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
+ {
+ frame = XCONS (tail)->car;
+ if (!GC_FRAMEP (frame))
+ continue;
+ f = XFRAME (frame);
+ if (f->output_data.nothing == 1
+ || FRAME_WIN32_DISPLAY_INFO (f) != dpyinfo)
+ continue;
+ if (FRAME_WIN32_WINDOW (f) == wdesc)
+ return f;
+ }
+ return 0;
+}
+
+\f
+
+/* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
+ id, which is just an int that this section returns. Bitmaps are
+ reference counted so they can be shared among frames.
+
+ Bitmap indices are guaranteed to be > 0, so a negative number can
+ be used to indicate no bitmap.
+
+ If you use x_create_bitmap_from_data, then you must keep track of
+ the bitmaps yourself. That is, creating a bitmap from the same
+ data more than once will not be caught. */
+
+
+/* Functions to access the contents of a bitmap, given an id. */
+
+int
+x_bitmap_height (f, id)
+ FRAME_PTR f;
+ int id;
+{
+ return FRAME_WIN32_DISPLAY_INFO (f)->bitmaps[id - 1].height;
+}
+
+int
+x_bitmap_width (f, id)
+ FRAME_PTR f;
+ int id;
+{
+ return FRAME_WIN32_DISPLAY_INFO (f)->bitmaps[id - 1].width;
+}
+
+int
+x_bitmap_pixmap (f, id)
+ FRAME_PTR f;
+ int id;
+{
+ return (int) FRAME_WIN32_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
+}
+
+
+/* Allocate a new bitmap record. Returns index of new record. */
+
+static int
+x_allocate_bitmap_record (f)
+ FRAME_PTR f;
+{
+ struct win32_display_info *dpyinfo = FRAME_WIN32_DISPLAY_INFO (f);
+ int i;
+
+ if (dpyinfo->bitmaps == NULL)
+ {
+ dpyinfo->bitmaps_size = 10;
+ dpyinfo->bitmaps
+ = (struct win32_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct win32_bitmap_record));
+ dpyinfo->bitmaps_last = 1;
+ return 1;
+ }
+
+ if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
+ return ++dpyinfo->bitmaps_last;
+
+ for (i = 0; i < dpyinfo->bitmaps_size; ++i)
+ if (dpyinfo->bitmaps[i].refcount == 0)
+ return i + 1;
+
+ dpyinfo->bitmaps_size *= 2;
+ dpyinfo->bitmaps
+ = (struct win32_bitmap_record *) xrealloc (dpyinfo->bitmaps,
+ dpyinfo->bitmaps_size * sizeof (struct win32_bitmap_record));
+ return ++dpyinfo->bitmaps_last;
+}
+
+/* Add one reference to the reference count of the bitmap with id ID. */
+
+void
+x_reference_bitmap (f, id)
+ FRAME_PTR f;
+ int id;
+{
+ ++FRAME_WIN32_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
+}
+
+/* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
+
+int
+x_create_bitmap_from_data (f, bits, width, height)
+ struct frame *f;
+ char *bits;
+ unsigned int width, height;
+{
+ struct win32_display_info *dpyinfo = FRAME_WIN32_DISPLAY_INFO (f);
+ Pixmap bitmap;
+ int id;
+
+ bitmap = CreateBitmap (width, height,
+ FRAME_WIN32_DISPLAY_INFO (XFRAME (frame))->n_planes,
+ FRAME_WIN32_DISPLAY_INFO (XFRAME (frame))->n_cbits,
+ bits);
+
+ if (! bitmap)
+ return -1;
+
+ id = x_allocate_bitmap_record (f);
+ dpyinfo->bitmaps[id - 1].pixmap = bitmap;
+ dpyinfo->bitmaps[id - 1].file = NULL;
+ dpyinfo->bitmaps[id - 1].hinst = NULL;
+ dpyinfo->bitmaps[id - 1].refcount = 1;
+ dpyinfo->bitmaps[id - 1].depth = 1;
+ dpyinfo->bitmaps[id - 1].height = height;
+ dpyinfo->bitmaps[id - 1].width = width;
+
+ return id;
+}
+
+/* Create bitmap from file FILE for frame F. */
+
+int
+x_create_bitmap_from_file (f, file)
+ struct frame *f;
+ Lisp_Object file;
+{
+ return -1;
+#if 0
+ struct win32_display_info *dpyinfo = FRAME_WIN32_DISPLAY_INFO (f);
+ unsigned int width, height;
+ Pixmap bitmap;
+ int xhot, yhot, result, id;
+ Lisp_Object found;
+ int fd;
+ char *filename;
+ HINSTANCE hinst;
+
+ /* Look for an existing bitmap with the same name. */
+ for (id = 0; id < dpyinfo->bitmaps_last; ++id)
+ {
+ if (dpyinfo->bitmaps[id].refcount
+ && dpyinfo->bitmaps[id].file
+ && !strcmp (dpyinfo->bitmaps[id].file, (char *) XSTRING (file)->data))
+ {
+ ++dpyinfo->bitmaps[id].refcount;
+ return id + 1;
+ }
+ }
+
+ /* Search bitmap-file-path for the file, if appropriate. */
+ fd = openp (Vx_bitmap_file_path, file, "", &found, 0);
+ if (fd < 0)
+ return -1;
+ close (fd);
+
+ filename = (char *) XSTRING (found)->data;
+
+ hinst = LoadLibraryEx (filename, NULL, LOAD_LIBRARY_AS_DATAFILE);
+
+ if (hinst == NULL)
+ return -1;
+
+
+ result = XReadBitmapFile (FRAME_WIN32_DISPLAY (f), FRAME_WIN32_WINDOW (f),
+ filename, &width, &height, &bitmap, &xhot, &yhot);
+ if (result != BitmapSuccess)
+ return -1;
+
+ id = x_allocate_bitmap_record (f);
+ dpyinfo->bitmaps[id - 1].pixmap = bitmap;
+ dpyinfo->bitmaps[id - 1].refcount = 1;
+ dpyinfo->bitmaps[id - 1].file = (char *) xmalloc (XSTRING (file)->size + 1);
+ dpyinfo->bitmaps[id - 1].depth = 1;
+ dpyinfo->bitmaps[id - 1].height = height;
+ dpyinfo->bitmaps[id - 1].width = width;
+ strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data);
+
+ return id;
+#endif
+}
+
+/* Remove reference to bitmap with id number ID. */
+
+int
+x_destroy_bitmap (f, id)
+ FRAME_PTR f;
+ int id;
+{
+ struct win32_display_info *dpyinfo = FRAME_WIN32_DISPLAY_INFO (f);
+
+ if (id > 0)
+ {
+ --dpyinfo->bitmaps[id - 1].refcount;
+ if (dpyinfo->bitmaps[id - 1].refcount == 0)
+ {
+ BLOCK_INPUT;
+ DeleteObject (dpyinfo->bitmaps[id - 1].pixmap);
+ if (dpyinfo->bitmaps[id - 1].file)
+ {
+ free (dpyinfo->bitmaps[id - 1].file);
+ dpyinfo->bitmaps[id - 1].file = NULL;
+ }
+ UNBLOCK_INPUT;
+ }
+ }
+}
+
+/* Free all the bitmaps for the display specified by DPYINFO. */
+
+static void
+x_destroy_all_bitmaps (dpyinfo)
+ struct win32_display_info *dpyinfo;
+{
+ int i;
+ for (i = 0; i < dpyinfo->bitmaps_last; i++)
+ if (dpyinfo->bitmaps[i].refcount > 0)
+ {
+ DeleteObject (dpyinfo->bitmaps[i].pixmap);
+ if (dpyinfo->bitmaps[i].file)
+ free (dpyinfo->bitmaps[i].file);
+ }
+ dpyinfo->bitmaps_last = 0;
+}
+\f
+/* Connect the frame-parameter names for Win32 frames
+ to the ways of passing the parameter values to the window system.
+
+ The name of a parameter, as a Lisp symbol,
+ has an `x-frame-parameter' property which is an integer in Lisp
+ but can be interpreted as an `enum x_frame_parm' in C. */
+
+enum x_frame_parm
+{
+ X_PARM_FOREGROUND_COLOR,
+ X_PARM_BACKGROUND_COLOR,
+ X_PARM_MOUSE_COLOR,
+ X_PARM_CURSOR_COLOR,
+ X_PARM_BORDER_COLOR,
+ X_PARM_ICON_TYPE,
+ X_PARM_FONT,
+ X_PARM_BORDER_WIDTH,
+ X_PARM_INTERNAL_BORDER_WIDTH,
+ X_PARM_NAME,
+ X_PARM_AUTORAISE,
+ X_PARM_AUTOLOWER,
+ X_PARM_VERT_SCROLL_BAR,
+ X_PARM_VISIBILITY,
+ X_PARM_MENU_BAR_LINES
+};
+
+
+struct x_frame_parm_table
+{
+ char *name;
+ void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ );
+};
+
+void x_set_foreground_color ();
+void x_set_background_color ();
+void x_set_mouse_color ();
+void x_set_cursor_color ();
+void x_set_border_color ();
+void x_set_cursor_type ();
+void x_set_icon_type ();
+void x_set_icon_name ();
+void x_set_font ();
+void x_set_border_width ();
+void x_set_internal_border_width ();
+void x_explicitly_set_name ();
+void x_set_autoraise ();
+void x_set_autolower ();
+void x_set_vertical_scroll_bars ();
+void x_set_visibility ();
+void x_set_menu_bar_lines ();
+void x_set_scroll_bar_width ();
+void x_set_unsplittable ();
+
+static struct x_frame_parm_table x_frame_parms[] =
+{
+ "foreground-color", x_set_foreground_color,
+ "background-color", x_set_background_color,
+ "mouse-color", x_set_mouse_color,
+ "cursor-color", x_set_cursor_color,
+ "border-color", x_set_border_color,
+ "cursor-type", x_set_cursor_type,
+ "icon-type", x_set_icon_type,
+ "icon-name", x_set_icon_name,
+ "font", x_set_font,
+ "border-width", x_set_border_width,
+ "internal-border-width", x_set_internal_border_width,
+ "name", x_explicitly_set_name,
+ "auto-raise", x_set_autoraise,
+ "auto-lower", x_set_autolower,
+ "vertical-scroll-bars", x_set_vertical_scroll_bars,
+ "visibility", x_set_visibility,
+ "menu-bar-lines", x_set_menu_bar_lines,
+ "scroll-bar-width", x_set_scroll_bar_width,
+ "unsplittable", x_set_unsplittable,
+};
+
+/* Attach the `x-frame-parameter' properties to
+ the Lisp symbol names of parameters relevant to Win32. */
+
+init_x_parm_symbols ()
+{
+ int i;
+
+ for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
+ Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
+ make_number (i));
+}
+\f
+/* Change the parameters of FRAME as specified by ALIST.
+ If a parameter is not specially recognized, do nothing;
+ otherwise call the `x_set_...' function for that parameter. */
+
+void
+x_set_frame_parameters (f, alist)
+ FRAME_PTR f;
+ Lisp_Object alist;
+{
+ Lisp_Object tail;
+
+ /* If both of these parameters are present, it's more efficient to
+ set them both at once. So we wait until we've looked at the
+ entire list before we set them. */
+ Lisp_Object width, height;
+
+ /* Same here. */
+ Lisp_Object left, top;
+
+ /* Same with these. */
+ Lisp_Object icon_left, icon_top;
+
+ /* Record in these vectors all the parms specified. */
+ Lisp_Object *parms;
+ Lisp_Object *values;
+ int i;
+ int left_no_change = 0, top_no_change = 0;
+ int icon_left_no_change = 0, icon_top_no_change = 0;
+
+ i = 0;
+ for (tail = alist; CONSP (tail); tail = Fcdr (tail))
+ i++;
+
+ parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
+ values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
+
+ /* Extract parm names and values into those vectors. */
+
+ i = 0;
+ for (tail = alist; CONSP (tail); tail = Fcdr (tail))
+ {
+ Lisp_Object elt, prop, val;
+
+ elt = Fcar (tail);
+ parms[i] = Fcar (elt);
+ values[i] = Fcdr (elt);
+ i++;
+ }
+
+ width = height = top = left = Qunbound;
+ icon_left = icon_top = Qunbound;
+
+ /* Now process them in reverse of specified order. */
+ for (i--; i >= 0; i--)
+ {
+ Lisp_Object prop, val;
+
+ prop = parms[i];
+ val = values[i];
+
+ if (EQ (prop, Qwidth))
+ width = val;
+ else if (EQ (prop, Qheight))
+ height = val;
+ else if (EQ (prop, Qtop))
+ top = val;
+ else if (EQ (prop, Qleft))
+ left = val;
+ else if (EQ (prop, Qicon_top))
+ icon_top = val;
+ else if (EQ (prop, Qicon_left))
+ icon_left = val;
+ else
+ {
+ register Lisp_Object param_index, old_value;
+
+ param_index = Fget (prop, Qx_frame_parameter);
+ old_value = get_frame_param (f, prop);
+ store_frame_param (f, prop, val);
+ if (NATNUMP (param_index)
+ && (XFASTINT (param_index)
+ < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
+ (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
+ }
+ }
+
+ /* Don't die if just one of these was set. */
+ if (EQ (left, Qunbound))
+ {
+ left_no_change = 1;
+ if (f->output_data.win32->left_pos < 0)
+ left = Fcons (Qplus, Fcons (make_number (f->output_data.win32->left_pos), Qnil));
+ else
+ XSETINT (left, f->output_data.win32->left_pos);
+ }
+ if (EQ (top, Qunbound))
+ {
+ top_no_change = 1;
+ if (f->output_data.win32->top_pos < 0)
+ top = Fcons (Qplus, Fcons (make_number (f->output_data.win32->top_pos), Qnil));
+ else
+ XSETINT (top, f->output_data.win32->top_pos);
+ }
+
+ /* If one of the icon positions was not set, preserve or default it. */
+ if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
+ {
+ icon_left_no_change = 1;
+ icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
+ if (NILP (icon_left))
+ XSETINT (icon_left, 0);
+ }
+ if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
+ {
+ icon_top_no_change = 1;
+ icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
+ if (NILP (icon_top))
+ XSETINT (icon_top, 0);
+ }
+
+ /* Don't die if just one of these was set. */
+ if (EQ (width, Qunbound))
+ XSETINT (width, FRAME_WIDTH (f));
+ if (EQ (height, Qunbound))
+ XSETINT (height, FRAME_HEIGHT (f));
+
+ /* Don't set these parameters unless they've been explicitly
+ specified. The window might be mapped or resized while we're in
+ this function, and we don't want to override that unless the lisp
+ code has asked for it.
+
+ Don't set these parameters unless they actually differ from the
+ window's current parameters; the window may not actually exist
+ yet. */
+ {
+ Lisp_Object frame;
+
+ check_frame_size (f, &height, &width);
+
+ XSETFRAME (frame, f);
+
+ if ((NUMBERP (width) && XINT (width) != FRAME_WIDTH (f))
+ || (NUMBERP (height) && XINT (height) != FRAME_HEIGHT (f)))
+ Fset_frame_size (frame, width, height);
+
+ if ((!NILP (left) || !NILP (top))
+ && ! (left_no_change && top_no_change)
+ && ! (NUMBERP (left) && XINT (left) == f->output_data.win32->left_pos
+ && NUMBERP (top) && XINT (top) == f->output_data.win32->top_pos))
+ {
+ int leftpos = 0;
+ int toppos = 0;
+
+ /* Record the signs. */
+ f->output_data.win32->size_hint_flags &= ~ (XNegative | YNegative);
+ if (EQ (left, Qminus))
+ f->output_data.win32->size_hint_flags |= XNegative;
+ else if (INTEGERP (left))
+ {
+ leftpos = XINT (left);
+ if (leftpos < 0)
+ f->output_data.win32->size_hint_flags |= XNegative;
+ }
+ else if (CONSP (left) && EQ (XCONS (left)->car, Qminus)
+ && CONSP (XCONS (left)->cdr)
+ && INTEGERP (XCONS (XCONS (left)->cdr)->car))
+ {
+ leftpos = - XINT (XCONS (XCONS (left)->cdr)->car);
+ f->output_data.win32->size_hint_flags |= XNegative;
+ }
+ else if (CONSP (left) && EQ (XCONS (left)->car, Qplus)
+ && CONSP (XCONS (left)->cdr)
+ && INTEGERP (XCONS (XCONS (left)->cdr)->car))
+ {
+ leftpos = XINT (XCONS (XCONS (left)->cdr)->car);
+ }
+
+ if (EQ (top, Qminus))
+ f->output_data.win32->size_hint_flags |= YNegative;
+ else if (INTEGERP (top))
+ {
+ toppos = XINT (top);
+ if (toppos < 0)
+ f->output_data.win32->size_hint_flags |= YNegative;
+ }
+ else if (CONSP (top) && EQ (XCONS (top)->car, Qminus)
+ && CONSP (XCONS (top)->cdr)
+ && INTEGERP (XCONS (XCONS (top)->cdr)->car))
+ {
+ toppos = - XINT (XCONS (XCONS (top)->cdr)->car);
+ f->output_data.win32->size_hint_flags |= YNegative;
+ }
+ else if (CONSP (top) && EQ (XCONS (top)->car, Qplus)
+ && CONSP (XCONS (top)->cdr)
+ && INTEGERP (XCONS (XCONS (top)->cdr)->car))
+ {
+ toppos = XINT (XCONS (XCONS (top)->cdr)->car);
+ }
+
+
+ /* Store the numeric value of the position. */
+ f->output_data.win32->top_pos = toppos;
+ f->output_data.win32->left_pos = leftpos;
+
+ f->output_data.win32->win_gravity = NorthWestGravity;
+
+ /* Actually set that position, and convert to absolute. */
+ x_set_offset (f, leftpos, toppos, -1);
+ }
+
+ if ((!NILP (icon_left) || !NILP (icon_top))
+ && ! (icon_left_no_change && icon_top_no_change))
+ x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
+ }
+}
+
+/* Store the screen positions of frame F into XPTR and YPTR.
+ These are the positions of the containing window manager window,
+ not Emacs's own window. */
+
+void
+x_real_positions (f, xptr, yptr)
+ FRAME_PTR f;
+ int *xptr, *yptr;
+{
+ POINT pt;
+
+ {
+ RECT rect;
+
+ GetClientRect(FRAME_WIN32_WINDOW(f), &rect);
+ AdjustWindowRect(&rect, f->output_data.win32->dwStyle, FRAME_EXTERNAL_MENU_BAR(f));
+
+ pt.x = rect.left;
+ pt.y = rect.top;
+ }
+
+ ClientToScreen (FRAME_WIN32_WINDOW(f), &pt);
+
+ *xptr = pt.x;
+ *yptr = pt.y;
+}
+
+/* Insert a description of internally-recorded parameters of frame X
+ into the parameter alist *ALISTPTR that is to be given to the user.
+ Only parameters that are specific to Win32
+ and whose values are not correctly recorded in the frame's
+ param_alist need to be considered here. */
+
+x_report_frame_params (f, alistptr)
+ struct frame *f;
+ Lisp_Object *alistptr;
+{
+ char buf[16];
+ Lisp_Object tem;
+
+ /* Represent negative positions (off the top or left screen edge)
+ in a way that Fmodify_frame_parameters will understand correctly. */
+ XSETINT (tem, f->output_data.win32->left_pos);
+ if (f->output_data.win32->left_pos >= 0)
+ store_in_alist (alistptr, Qleft, tem);
+ else
+ store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
+
+ XSETINT (tem, f->output_data.win32->top_pos);
+ if (f->output_data.win32->top_pos >= 0)
+ store_in_alist (alistptr, Qtop, tem);
+ else
+ store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
+
+ store_in_alist (alistptr, Qborder_width,
+ make_number (f->output_data.win32->border_width));
+ store_in_alist (alistptr, Qinternal_border_width,
+ make_number (f->output_data.win32->internal_border_width));
+ sprintf (buf, "%ld", (long) FRAME_WIN32_WINDOW (f));
+ store_in_alist (alistptr, Qwindow_id,
+ build_string (buf));
+ store_in_alist (alistptr, Qicon_name, f->icon_name);
+ FRAME_SAMPLE_VISIBILITY (f);
+ store_in_alist (alistptr, Qvisibility,
+ (FRAME_VISIBLE_P (f) ? Qt
+ : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
+ store_in_alist (alistptr, Qdisplay,
+ XCONS (FRAME_WIN32_DISPLAY_INFO (f)->name_list_element)->car);
+}
+\f
+
+#if 0
+DEFUN ("win32-rgb", Fwin32_rgb, Swin32_rgb, 3, 3, 0,
+ "Convert RGB numbers to a windows color reference.")
+ (red, green, blue)
+ Lisp_Object red, green, blue;
+{
+ Lisp_Object rgb;
+
+ CHECK_NUMBER (red, 0);
+ CHECK_NUMBER (green, 0);
+ CHECK_NUMBER (blue, 0);
+
+ XSET (rgb, Lisp_Int, RGB(XUINT(red), XUINT(green), XUINT(blue)));
+
+ return (rgb);
+}
+
+
+#else
+/* The default colors for the win32 color map */
+typedef struct colormap_t
+{
+ char *name;
+ COLORREF colorref;
+} colormap_t;
+
+colormap_t win32_color_map[] =
+{
+ {"snow" , RGB (255,250,250)},
+ {"ghost white" , RGB (248,248,255)},
+ {"GhostWhite" , RGB (248,248,255)},
+ {"white smoke" , RGB (245,245,245)},
+ {"WhiteSmoke" , RGB (245,245,245)},
+ {"gainsboro" , RGB (220,220,220)},
+ {"floral white" , RGB (255,250,240)},
+ {"FloralWhite" , RGB (255,250,240)},
+ {"old lace" , RGB (253,245,230)},
+ {"OldLace" , RGB (253,245,230)},
+ {"linen" , RGB (250,240,230)},
+ {"antique white" , RGB (250,235,215)},
+ {"AntiqueWhite" , RGB (250,235,215)},
+ {"papaya whip" , RGB (255,239,213)},
+ {"PapayaWhip" , RGB (255,239,213)},
+ {"blanched almond" , RGB (255,235,205)},
+ {"BlanchedAlmond" , RGB (255,235,205)},
+ {"bisque" , RGB (255,228,196)},
+ {"peach puff" , RGB (255,218,185)},
+ {"PeachPuff" , RGB (255,218,185)},
+ {"navajo white" , RGB (255,222,173)},
+ {"NavajoWhite" , RGB (255,222,173)},
+ {"moccasin" , RGB (255,228,181)},
+ {"cornsilk" , RGB (255,248,220)},
+ {"ivory" , RGB (255,255,240)},
+ {"lemon chiffon" , RGB (255,250,205)},
+ {"LemonChiffon" , RGB (255,250,205)},
+ {"seashell" , RGB (255,245,238)},
+ {"honeydew" , RGB (240,255,240)},
+ {"mint cream" , RGB (245,255,250)},
+ {"MintCream" , RGB (245,255,250)},
+ {"azure" , RGB (240,255,255)},
+ {"alice blue" , RGB (240,248,255)},
+ {"AliceBlue" , RGB (240,248,255)},
+ {"lavender" , RGB (230,230,250)},
+ {"lavender blush" , RGB (255,240,245)},
+ {"LavenderBlush" , RGB (255,240,245)},
+ {"misty rose" , RGB (255,228,225)},
+ {"MistyRose" , RGB (255,228,225)},
+ {"white" , RGB (255,255,255)},
+ {"black" , RGB ( 0, 0, 0)},
+ {"dark slate gray" , RGB ( 47, 79, 79)},
+ {"DarkSlateGray" , RGB ( 47, 79, 79)},
+ {"dark slate grey" , RGB ( 47, 79, 79)},
+ {"DarkSlateGrey" , RGB ( 47, 79, 79)},
+ {"dim gray" , RGB (105,105,105)},
+ {"DimGray" , RGB (105,105,105)},
+ {"dim grey" , RGB (105,105,105)},
+ {"DimGrey" , RGB (105,105,105)},
+ {"slate gray" , RGB (112,128,144)},
+ {"SlateGray" , RGB (112,128,144)},
+ {"slate grey" , RGB (112,128,144)},
+ {"SlateGrey" , RGB (112,128,144)},
+ {"light slate gray" , RGB (119,136,153)},
+ {"LightSlateGray" , RGB (119,136,153)},
+ {"light slate grey" , RGB (119,136,153)},
+ {"LightSlateGrey" , RGB (119,136,153)},
+ {"gray" , RGB (190,190,190)},
+ {"grey" , RGB (190,190,190)},
+ {"light grey" , RGB (211,211,211)},
+ {"LightGrey" , RGB (211,211,211)},
+ {"light gray" , RGB (211,211,211)},
+ {"LightGray" , RGB (211,211,211)},
+ {"midnight blue" , RGB ( 25, 25,112)},
+ {"MidnightBlue" , RGB ( 25, 25,112)},
+ {"navy" , RGB ( 0, 0,128)},
+ {"navy blue" , RGB ( 0, 0,128)},
+ {"NavyBlue" , RGB ( 0, 0,128)},
+ {"cornflower blue" , RGB (100,149,237)},
+ {"CornflowerBlue" , RGB (100,149,237)},
+ {"dark slate blue" , RGB ( 72, 61,139)},
+ {"DarkSlateBlue" , RGB ( 72, 61,139)},
+ {"slate blue" , RGB (106, 90,205)},
+ {"SlateBlue" , RGB (106, 90,205)},
+ {"medium slate blue" , RGB (123,104,238)},
+ {"MediumSlateBlue" , RGB (123,104,238)},
+ {"light slate blue" , RGB (132,112,255)},
+ {"LightSlateBlue" , RGB (132,112,255)},
+ {"medium blue" , RGB ( 0, 0,205)},
+ {"MediumBlue" , RGB ( 0, 0,205)},
+ {"royal blue" , RGB ( 65,105,225)},
+ {"RoyalBlue" , RGB ( 65,105,225)},
+ {"blue" , RGB ( 0, 0,255)},
+ {"dodger blue" , RGB ( 30,144,255)},
+ {"DodgerBlue" , RGB ( 30,144,255)},
+ {"deep sky blue" , RGB ( 0,191,255)},
+ {"DeepSkyBlue" , RGB ( 0,191,255)},
+ {"sky blue" , RGB (135,206,235)},
+ {"SkyBlue" , RGB (135,206,235)},
+ {"light sky blue" , RGB (135,206,250)},
+ {"LightSkyBlue" , RGB (135,206,250)},
+ {"steel blue" , RGB ( 70,130,180)},
+ {"SteelBlue" , RGB ( 70,130,180)},
+ {"light steel blue" , RGB (176,196,222)},
+ {"LightSteelBlue" , RGB (176,196,222)},
+ {"light blue" , RGB (173,216,230)},
+ {"LightBlue" , RGB (173,216,230)},
+ {"powder blue" , RGB (176,224,230)},
+ {"PowderBlue" , RGB (176,224,230)},
+ {"pale turquoise" , RGB (175,238,238)},
+ {"PaleTurquoise" , RGB (175,238,238)},
+ {"dark turquoise" , RGB ( 0,206,209)},
+ {"DarkTurquoise" , RGB ( 0,206,209)},
+ {"medium turquoise" , RGB ( 72,209,204)},
+ {"MediumTurquoise" , RGB ( 72,209,204)},
+ {"turquoise" , RGB ( 64,224,208)},
+ {"cyan" , RGB ( 0,255,255)},
+ {"light cyan" , RGB (224,255,255)},
+ {"LightCyan" , RGB (224,255,255)},
+ {"cadet blue" , RGB ( 95,158,160)},
+ {"CadetBlue" , RGB ( 95,158,160)},
+ {"medium aquamarine" , RGB (102,205,170)},
+ {"MediumAquamarine" , RGB (102,205,170)},
+ {"aquamarine" , RGB (127,255,212)},
+ {"dark green" , RGB ( 0,100, 0)},
+ {"DarkGreen" , RGB ( 0,100, 0)},
+ {"dark olive green" , RGB ( 85,107, 47)},
+ {"DarkOliveGreen" , RGB ( 85,107, 47)},
+ {"dark sea green" , RGB (143,188,143)},
+ {"DarkSeaGreen" , RGB (143,188,143)},
+ {"sea green" , RGB ( 46,139, 87)},
+ {"SeaGreen" , RGB ( 46,139, 87)},
+ {"medium sea green" , RGB ( 60,179,113)},
+ {"MediumSeaGreen" , RGB ( 60,179,113)},
+ {"light sea green" , RGB ( 32,178,170)},
+ {"LightSeaGreen" , RGB ( 32,178,170)},
+ {"pale green" , RGB (152,251,152)},
+ {"PaleGreen" , RGB (152,251,152)},
+ {"spring green" , RGB ( 0,255,127)},
+ {"SpringGreen" , RGB ( 0,255,127)},
+ {"lawn green" , RGB (124,252, 0)},
+ {"LawnGreen" , RGB (124,252, 0)},
+ {"green" , RGB ( 0,255, 0)},
+ {"chartreuse" , RGB (127,255, 0)},
+ {"medium spring green" , RGB ( 0,250,154)},
+ {"MediumSpringGreen" , RGB ( 0,250,154)},
+ {"green yellow" , RGB (173,255, 47)},
+ {"GreenYellow" , RGB (173,255, 47)},
+ {"lime green" , RGB ( 50,205, 50)},
+ {"LimeGreen" , RGB ( 50,205, 50)},
+ {"yellow green" , RGB (154,205, 50)},
+ {"YellowGreen" , RGB (154,205, 50)},
+ {"forest green" , RGB ( 34,139, 34)},
+ {"ForestGreen" , RGB ( 34,139, 34)},
+ {"olive drab" , RGB (107,142, 35)},
+ {"OliveDrab" , RGB (107,142, 35)},
+ {"dark khaki" , RGB (189,183,107)},
+ {"DarkKhaki" , RGB (189,183,107)},
+ {"khaki" , RGB (240,230,140)},
+ {"pale goldenrod" , RGB (238,232,170)},
+ {"PaleGoldenrod" , RGB (238,232,170)},
+ {"light goldenrod yellow" , RGB (250,250,210)},
+ {"LightGoldenrodYellow" , RGB (250,250,210)},
+ {"light yellow" , RGB (255,255,224)},
+ {"LightYellow" , RGB (255,255,224)},
+ {"yellow" , RGB (255,255, 0)},
+ {"gold" , RGB (255,215, 0)},
+ {"light goldenrod" , RGB (238,221,130)},
+ {"LightGoldenrod" , RGB (238,221,130)},
+ {"goldenrod" , RGB (218,165, 32)},
+ {"dark goldenrod" , RGB (184,134, 11)},
+ {"DarkGoldenrod" , RGB (184,134, 11)},
+ {"rosy brown" , RGB (188,143,143)},
+ {"RosyBrown" , RGB (188,143,143)},
+ {"indian red" , RGB (205, 92, 92)},
+ {"IndianRed" , RGB (205, 92, 92)},
+ {"saddle brown" , RGB (139, 69, 19)},
+ {"SaddleBrown" , RGB (139, 69, 19)},
+ {"sienna" , RGB (160, 82, 45)},
+ {"peru" , RGB (205,133, 63)},
+ {"burlywood" , RGB (222,184,135)},
+ {"beige" , RGB (245,245,220)},
+ {"wheat" , RGB (245,222,179)},
+ {"sandy brown" , RGB (244,164, 96)},
+ {"SandyBrown" , RGB (244,164, 96)},
+ {"tan" , RGB (210,180,140)},
+ {"chocolate" , RGB (210,105, 30)},
+ {"firebrick" , RGB (178,34, 34)},
+ {"brown" , RGB (165,42, 42)},
+ {"dark salmon" , RGB (233,150,122)},
+ {"DarkSalmon" , RGB (233,150,122)},
+ {"salmon" , RGB (250,128,114)},
+ {"light salmon" , RGB (255,160,122)},
+ {"LightSalmon" , RGB (255,160,122)},
+ {"orange" , RGB (255,165, 0)},
+ {"dark orange" , RGB (255,140, 0)},
+ {"DarkOrange" , RGB (255,140, 0)},
+ {"coral" , RGB (255,127, 80)},
+ {"light coral" , RGB (240,128,128)},
+ {"LightCoral" , RGB (240,128,128)},
+ {"tomato" , RGB (255, 99, 71)},
+ {"orange red" , RGB (255, 69, 0)},
+ {"OrangeRed" , RGB (255, 69, 0)},
+ {"red" , RGB (255, 0, 0)},
+ {"hot pink" , RGB (255,105,180)},
+ {"HotPink" , RGB (255,105,180)},
+ {"deep pink" , RGB (255, 20,147)},
+ {"DeepPink" , RGB (255, 20,147)},
+ {"pink" , RGB (255,192,203)},
+ {"light pink" , RGB (255,182,193)},
+ {"LightPink" , RGB (255,182,193)},
+ {"pale violet red" , RGB (219,112,147)},
+ {"PaleVioletRed" , RGB (219,112,147)},
+ {"maroon" , RGB (176, 48, 96)},
+ {"medium violet red" , RGB (199, 21,133)},
+ {"MediumVioletRed" , RGB (199, 21,133)},
+ {"violet red" , RGB (208, 32,144)},
+ {"VioletRed" , RGB (208, 32,144)},
+ {"magenta" , RGB (255, 0,255)},
+ {"violet" , RGB (238,130,238)},
+ {"plum" , RGB (221,160,221)},
+ {"orchid" , RGB (218,112,214)},
+ {"medium orchid" , RGB (186, 85,211)},
+ {"MediumOrchid" , RGB (186, 85,211)},
+ {"dark orchid" , RGB (153, 50,204)},
+ {"DarkOrchid" , RGB (153, 50,204)},
+ {"dark violet" , RGB (148, 0,211)},
+ {"DarkViolet" , RGB (148, 0,211)},
+ {"blue violet" , RGB (138, 43,226)},
+ {"BlueViolet" , RGB (138, 43,226)},
+ {"purple" , RGB (160, 32,240)},
+ {"medium purple" , RGB (147,112,219)},
+ {"MediumPurple" , RGB (147,112,219)},
+ {"thistle" , RGB (216,191,216)},
+ {"gray0" , RGB ( 0, 0, 0)},
+ {"grey0" , RGB ( 0, 0, 0)},
+ {"dark grey" , RGB (169,169,169)},
+ {"DarkGrey" , RGB (169,169,169)},
+ {"dark gray" , RGB (169,169,169)},
+ {"DarkGray" , RGB (169,169,169)},
+ {"dark blue" , RGB ( 0, 0,139)},
+ {"DarkBlue" , RGB ( 0, 0,139)},
+ {"dark cyan" , RGB ( 0,139,139)},
+ {"DarkCyan" , RGB ( 0,139,139)},
+ {"dark magenta" , RGB (139, 0,139)},
+ {"DarkMagenta" , RGB (139, 0,139)},
+ {"dark red" , RGB (139, 0, 0)},
+ {"DarkRed" , RGB (139, 0, 0)},
+ {"light green" , RGB (144,238,144)},
+ {"LightGreen" , RGB (144,238,144)},
+};
+
+DEFUN ("win32-default-color-map", Fwin32_default_color_map, Swin32_default_color_map,
+ 0, 0, 0, "Return the default color map.")
+ ()
+{
+ int i;
+ colormap_t *pc = win32_color_map;
+ Lisp_Object cmap;
+
+ BLOCK_INPUT;
+
+ cmap = Qnil;
+
+ for (i = 0; i < sizeof (win32_color_map) / sizeof (win32_color_map[0]);
+ pc++, i++)
+ cmap = Fcons (Fcons (build_string (pc->name),
+ make_number (pc->colorref)),
+ cmap);
+
+ UNBLOCK_INPUT;
+
+ return (cmap);
+}
+#endif
+
+Lisp_Object
+win32_to_x_color (rgb)
+ Lisp_Object rgb;
+{
+ Lisp_Object color;
+
+ CHECK_NUMBER (rgb, 0);
+
+ BLOCK_INPUT;
+
+ color = Frassq (rgb, Vwin32_color_map);
+
+ UNBLOCK_INPUT;
+
+ if (!NILP (color))
+ return (Fcar (color));
+ else
+ return Qnil;
+}
+
+COLORREF
+x_to_win32_color (colorname)
+ char * colorname;
+{
+ register Lisp_Object tail, ret = Qnil;
+
+ BLOCK_INPUT;
+
+ for (tail = Vwin32_color_map; !NILP (tail); tail = Fcdr (tail))
+ {
+ register Lisp_Object elt, tem;
+
+ elt = Fcar (tail);
+ if (!CONSP (elt)) continue;
+
+ tem = Fcar (elt);
+
+ if (lstrcmpi (XSTRING (tem)->data, colorname) == 0)
+ {
+ ret = XUINT(Fcdr (elt));
+ break;
+ }
+
+ QUIT;
+ }
+
+ UNBLOCK_INPUT;
+
+ return ret;
+}
+
+/* Decide if color named COLOR is valid for the display associated with
+ the selected frame; if so, return the rgb values in COLOR_DEF.
+ If ALLOC is nonzero, allocate a new colormap cell. */
+
+int
+defined_color (f, color, color_def, alloc)
+ FRAME_PTR f;
+ char *color;
+ COLORREF *color_def;
+ int alloc;
+{
+ register Lisp_Object tem;
+
+ tem = x_to_win32_color (color);
+
+ if (!NILP (tem))
+ {
+ *color_def = XUINT (tem);
+ return 1;
+ }
+ else
+ {
+ return 0;
+ }
+}
+
+/* Given a string ARG naming a color, compute a pixel value from it
+ suitable for screen F.
+ If F is not a color screen, return DEF (default) regardless of what
+ ARG says. */
+
+int
+x_decode_color (f, arg, def)
+ FRAME_PTR f;
+ Lisp_Object arg;
+ int def;
+{
+ COLORREF cdef;
+
+ CHECK_STRING (arg, 0);
+
+ if (strcmp (XSTRING (arg)->data, "black") == 0)
+ return BLACK_PIX_DEFAULT (f);
+ else if (strcmp (XSTRING (arg)->data, "white") == 0)
+ return WHITE_PIX_DEFAULT (f);
+
+ if ((FRAME_WIN32_DISPLAY_INFO (f)->n_planes * FRAME_WIN32_DISPLAY_INFO (f)->n_cbits) == 1)
+ return def;
+
+ /* defined_color is responsible for coping with failures
+ by looking for a near-miss. */
+ if (defined_color (f, XSTRING (arg)->data, &cdef, 1))
+ return cdef;
+
+ /* defined_color failed; return an ultimate default. */
+ return def;
+}
+\f
+/* Functions called only from `x_set_frame_param'
+ to set individual parameters.
+
+ If FRAME_WIN32_WINDOW (f) is 0,
+ the frame is being created and its window does not exist yet.
+ In that case, just record the parameter's new value
+ in the standard place; do not attempt to change the window. */
+
+void
+x_set_foreground_color (f, arg, oldval)
+ struct frame *f;
+ Lisp_Object arg, oldval;
+{
+ f->output_data.win32->foreground_pixel
+ = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
+ if (FRAME_WIN32_WINDOW (f) != 0)
+ {
+ recompute_basic_faces (f);
+ if (FRAME_VISIBLE_P (f))
+ redraw_frame (f);
+ }
+}
+
+void
+x_set_background_color (f, arg, oldval)
+ struct frame *f;
+ Lisp_Object arg, oldval;
+{
+ Pixmap temp;
+ int mask;
+
+ f->output_data.win32->background_pixel
+ = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
+
+ if (FRAME_WIN32_WINDOW (f) != 0)
+ {
+ SetWindowLong (FRAME_WIN32_WINDOW (f), WND_BACKGROUND_INDEX, f->output_data.win32->background_pixel);
+
+ recompute_basic_faces (f);
+
+ if (FRAME_VISIBLE_P (f))
+ redraw_frame (f);
+ }
+}
+
+void
+x_set_mouse_color (f, arg, oldval)
+ struct frame *f;
+ Lisp_Object arg, oldval;
+{
+#if 0
+ Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
+#endif
+ int mask_color;
+
+ if (!EQ (Qnil, arg))
+ f->output_data.win32->mouse_pixel
+ = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
+ mask_color = f->output_data.win32->background_pixel;
+ /* No invisible pointers. */
+ if (mask_color == f->output_data.win32->mouse_pixel
+ && mask_color == f->output_data.win32->background_pixel)
+ f->output_data.win32->mouse_pixel = f->output_data.win32->foreground_pixel;
+
+#if 0
+ BLOCK_INPUT;
+
+ /* It's not okay to crash if the user selects a screwy cursor. */
+ x_catch_errors (FRAME_WIN32_DISPLAY (f));
+
+ if (!EQ (Qnil, Vx_pointer_shape))
+ {
+ CHECK_NUMBER (Vx_pointer_shape, 0);
+ cursor = XCreateFontCursor (FRAME_WIN32_DISPLAY (f), XINT (Vx_pointer_shape));
+ }
+ else
+ cursor = XCreateFontCursor (FRAME_WIN32_DISPLAY (f), XC_xterm);
+ x_check_errors (FRAME_WIN32_DISPLAY (f), "bad text pointer cursor: %s");
+
+ if (!EQ (Qnil, Vx_nontext_pointer_shape))
+ {
+ CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
+ nontext_cursor = XCreateFontCursor (FRAME_WIN32_DISPLAY (f),
+ XINT (Vx_nontext_pointer_shape));
+ }
+ else
+ nontext_cursor = XCreateFontCursor (FRAME_WIN32_DISPLAY (f), XC_left_ptr);
+ x_check_errors (FRAME_WIN32_DISPLAY (f), "bad nontext pointer cursor: %s");
+
+ if (!EQ (Qnil, Vx_mode_pointer_shape))
+ {
+ CHECK_NUMBER (Vx_mode_pointer_shape, 0);
+ mode_cursor = XCreateFontCursor (FRAME_WIN32_DISPLAY (f),
+ XINT (Vx_mode_pointer_shape));
+ }
+ else
+ mode_cursor = XCreateFontCursor (FRAME_WIN32_DISPLAY (f), XC_xterm);
+ x_check_errors (FRAME_WIN32_DISPLAY (f), "bad modeline pointer cursor: %s");
+
+ if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
+ {
+ CHECK_NUMBER (Vx_sensitive_text_pointer_shape, 0);
+ cross_cursor
+ = XCreateFontCursor (FRAME_WIN32_DISPLAY (f),
+ XINT (Vx_sensitive_text_pointer_shape));
+ }
+ else
+ cross_cursor = XCreateFontCursor (FRAME_WIN32_DISPLAY (f), XC_crosshair);
+
+ /* Check and report errors with the above calls. */
+ x_check_errors (FRAME_WIN32_DISPLAY (f), "can't set cursor shape: %s");
+ x_uncatch_errors (FRAME_WIN32_DISPLAY (f));
+
+ {
+ XColor fore_color, back_color;
+
+ fore_color.pixel = f->output_data.win32->mouse_pixel;
+ back_color.pixel = mask_color;
+ XQueryColor (FRAME_WIN32_DISPLAY (f),
+ DefaultColormap (FRAME_WIN32_DISPLAY (f),
+ DefaultScreen (FRAME_WIN32_DISPLAY (f))),
+ &fore_color);
+ XQueryColor (FRAME_WIN32_DISPLAY (f),
+ DefaultColormap (FRAME_WIN32_DISPLAY (f),
+ DefaultScreen (FRAME_WIN32_DISPLAY (f))),
+ &back_color);
+ XRecolorCursor (FRAME_WIN32_DISPLAY (f), cursor,
+ &fore_color, &back_color);
+ XRecolorCursor (FRAME_WIN32_DISPLAY (f), nontext_cursor,
+ &fore_color, &back_color);
+ XRecolorCursor (FRAME_WIN32_DISPLAY (f), mode_cursor,
+ &fore_color, &back_color);
+ XRecolorCursor (FRAME_WIN32_DISPLAY (f), cross_cursor,
+ &fore_color, &back_color);
+ }
+
+ if (FRAME_WIN32_WINDOW (f) != 0)
+ {
+ XDefineCursor (FRAME_WIN32_DISPLAY (f), FRAME_WIN32_WINDOW (f), cursor);
+ }
+
+ if (cursor != f->output_data.win32->text_cursor && f->output_data.win32->text_cursor != 0)
+ XFreeCursor (FRAME_WIN32_DISPLAY (f), f->output_data.win32->text_cursor);
+ f->output_data.win32->text_cursor = cursor;
+
+ if (nontext_cursor != f->output_data.win32->nontext_cursor
+ && f->output_data.win32->nontext_cursor != 0)
+ XFreeCursor (FRAME_WIN32_DISPLAY (f), f->output_data.win32->nontext_cursor);
+ f->output_data.win32->nontext_cursor = nontext_cursor;
+
+ if (mode_cursor != f->output_data.win32->modeline_cursor
+ && f->output_data.win32->modeline_cursor != 0)
+ XFreeCursor (FRAME_WIN32_DISPLAY (f), f->output_data.win32->modeline_cursor);
+ f->output_data.win32->modeline_cursor = mode_cursor;
+ if (cross_cursor != f->output_data.win32->cross_cursor
+ && f->output_data.win32->cross_cursor != 0)
+ XFreeCursor (FRAME_WIN32_DISPLAY (f), f->output_data.win32->cross_cursor);
+ f->output_data.win32->cross_cursor = cross_cursor;
+
+ XFlush (FRAME_WIN32_DISPLAY (f));
+ UNBLOCK_INPUT;
+#endif
+}
+
+void
+x_set_cursor_color (f, arg, oldval)
+ struct frame *f;
+ Lisp_Object arg, oldval;
+{
+ unsigned long fore_pixel;
+
+ if (!EQ (Vx_cursor_fore_pixel, Qnil))
+ fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
+ WHITE_PIX_DEFAULT (f));
+ else
+ fore_pixel = f->output_data.win32->background_pixel;
+ f->output_data.win32->cursor_pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
+
+ /* Make sure that the cursor color differs from the background color. */
+ if (f->output_data.win32->cursor_pixel == f->output_data.win32->background_pixel)
+ {
+ f->output_data.win32->cursor_pixel = f->output_data.win32->mouse_pixel;
+ if (f->output_data.win32->cursor_pixel == fore_pixel)
+ fore_pixel = f->output_data.win32->background_pixel;
+ }
+ f->output_data.win32->cursor_foreground_pixel = fore_pixel;
+
+ if (FRAME_WIN32_WINDOW (f) != 0)
+ {
+ if (FRAME_VISIBLE_P (f))
+ {
+ x_display_cursor (f, 0);
+ x_display_cursor (f, 1);
+ }
+ }
+}
+
+/* Set the border-color of frame F to value described by ARG.
+ ARG can be a string naming a color.
+ The border-color is used for the border that is drawn by the server.
+ Note that this does not fully take effect if done before
+ F has a window; it must be redone when the window is created. */
+
+void
+x_set_border_color (f, arg, oldval)
+ struct frame *f;
+ Lisp_Object arg, oldval;
+{
+ unsigned char *str;
+ int pix;
+
+ CHECK_STRING (arg, 0);
+ str = XSTRING (arg)->data;
+
+ pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
+
+ x_set_border_pixel (f, pix);
+}
+
+/* Set the border-color of frame F to pixel value PIX.
+ Note that this does not fully take effect if done before
+ F has an window. */
+
+x_set_border_pixel (f, pix)
+ struct frame *f;
+ int pix;
+{
+ f->output_data.win32->border_pixel = pix;
+
+ if (FRAME_WIN32_WINDOW (f) != 0 && f->output_data.win32->border_width > 0)
+ {
+ if (FRAME_VISIBLE_P (f))
+ redraw_frame (f);
+ }
+}
+
+void
+x_set_cursor_type (f, arg, oldval)
+ FRAME_PTR f;
+ Lisp_Object arg, oldval;
+{
+ if (EQ (arg, Qbar))
+ {
+ FRAME_DESIRED_CURSOR (f) = bar_cursor;
+ f->output_data.win32->cursor_width = 2;
+ }
+ else if (CONSP (arg) && EQ (XCONS (arg)->car, Qbar)
+ && INTEGERP (XCONS (arg)->cdr))
+ {
+ FRAME_DESIRED_CURSOR (f) = bar_cursor;
+ f->output_data.win32->cursor_width = XINT (XCONS (arg)->cdr);
+ }
+ else
+ /* Treat anything unknown as "box cursor".
+ It was bad to signal an error; people have trouble fixing
+ .Xdefaults with Emacs, when it has something bad in it. */
+ FRAME_DESIRED_CURSOR (f) = filled_box_cursor;
+
+ /* Make sure the cursor gets redrawn. This is overkill, but how
+ often do people change cursor types? */
+ update_mode_lines++;
+}
+
+void
+x_set_icon_type (f, arg, oldval)
+ struct frame *f;
+ Lisp_Object arg, oldval;
+{
+#if 0
+ Lisp_Object tem;
+ int result;
+
+ if (STRINGP (arg))
+ {
+ if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
+ return;
+ }
+ else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
+ return;
+
+ BLOCK_INPUT;
+ if (NILP (arg))
+ result = x_text_icon (f,
+ (char *) XSTRING ((!NILP (f->icon_name)
+ ? f->icon_name
+ : f->name))->data);
+ else
+ result = x_bitmap_icon (f, arg);
+
+ if (result)
+ {
+ UNBLOCK_INPUT;
+ error ("No icon window available");
+ }
+
+ /* If the window was unmapped (and its icon was mapped),
+ the new icon is not mapped, so map the window in its stead. */
+ if (FRAME_VISIBLE_P (f))
+ {
+#ifdef USE_X_TOOLKIT
+ XtPopup (f->output_data.win32->widget, XtGrabNone);
+#endif
+ XMapWindow (FRAME_WIN32_DISPLAY (f), FRAME_WIN32_WINDOW (f));
+ }
+
+ XFlush (FRAME_WIN32_DISPLAY (f));
+ UNBLOCK_INPUT;
+#endif
+}
+
+/* Return non-nil if frame F wants a bitmap icon. */
+
+Lisp_Object
+x_icon_type (f)
+ FRAME_PTR f;
+{
+ Lisp_Object tem;
+
+ tem = assq_no_quit (Qicon_type, f->param_alist);
+ if (CONSP (tem))
+ return XCONS (tem)->cdr;
+ else
+ return Qnil;
+}
+
+void
+x_set_icon_name (f, arg, oldval)
+ struct frame *f;
+ Lisp_Object arg, oldval;
+{
+ Lisp_Object tem;
+ int result;
+
+ if (STRINGP (arg))
+ {
+ if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
+ return;
+ }
+ else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
+ return;
+
+ f->icon_name = arg;
+
+#if 0
+ if (f->output_data.win32->icon_bitmap != 0)
+ return;
+
+ BLOCK_INPUT;
+
+ result = x_text_icon (f,
+ (char *) XSTRING ((!NILP (f->icon_name)
+ ? f->icon_name
+ : f->name))->data);
+
+ if (result)
+ {
+ UNBLOCK_INPUT;
+ error ("No icon window available");
+ }
+
+ /* If the window was unmapped (and its icon was mapped),
+ the new icon is not mapped, so map the window in its stead. */
+ if (FRAME_VISIBLE_P (f))
+ {
+#ifdef USE_X_TOOLKIT
+ XtPopup (f->output_data.win32->widget, XtGrabNone);
+#endif
+ XMapWindow (FRAME_WIN32_DISPLAY (f), FRAME_WIN32_WINDOW (f));
+ }
+
+ XFlush (FRAME_WIN32_DISPLAY (f));
+ UNBLOCK_INPUT;
+#endif
+}
+
+extern Lisp_Object x_new_font ();
+
+void
+x_set_font (f, arg, oldval)
+ struct frame *f;
+ Lisp_Object arg, oldval;
+{
+ Lisp_Object result;
+
+ CHECK_STRING (arg, 1);
+
+ BLOCK_INPUT;
+ result = x_new_font (f, XSTRING (arg)->data);
+ UNBLOCK_INPUT;
+
+ if (EQ (result, Qnil))
+ error ("Font \"%s\" is not defined", XSTRING (arg)->data);
+ else if (EQ (result, Qt))
+ error ("the characters of the given font have varying widths");
+ else if (STRINGP (result))
+ {
+ recompute_basic_faces (f);
+ store_frame_param (f, Qfont, result);
+ }
+ else
+ abort ();
+}
+
+void
+x_set_border_width (f, arg, oldval)
+ struct frame *f;
+ Lisp_Object arg, oldval;
+{
+ CHECK_NUMBER (arg, 0);
+
+ if (XINT (arg) == f->output_data.win32->border_width)
+ return;
+
+ if (FRAME_WIN32_WINDOW (f) != 0)
+ error ("Cannot change the border width of a window");
+
+ f->output_data.win32->border_width = XINT (arg);
+}
+
+void
+x_set_internal_border_width (f, arg, oldval)
+ struct frame *f;
+ Lisp_Object arg, oldval;
+{
+ int mask;
+ int old = f->output_data.win32->internal_border_width;
+
+ CHECK_NUMBER (arg, 0);
+ f->output_data.win32->internal_border_width = XINT (arg);
+ if (f->output_data.win32->internal_border_width < 0)
+ f->output_data.win32->internal_border_width = 0;
+
+ if (f->output_data.win32->internal_border_width == old)
+ return;
+
+ if (FRAME_WIN32_WINDOW (f) != 0)
+ {
+ BLOCK_INPUT;
+ x_set_window_size (f, 0, f->width, f->height);
+ UNBLOCK_INPUT;
+ SET_FRAME_GARBAGED (f);
+ }
+}
+
+void
+x_set_visibility (f, value, oldval)
+ struct frame *f;
+ Lisp_Object value, oldval;
+{
+ Lisp_Object frame;
+ XSETFRAME (frame, f);
+
+ if (NILP (value))
+ Fmake_frame_invisible (frame, Qt);
+ else if (EQ (value, Qicon))
+ Ficonify_frame (frame);
+ else
+ Fmake_frame_visible (frame);
+}
+
+void
+x_set_menu_bar_lines (f, value, oldval)
+ struct frame *f;
+ Lisp_Object value, oldval;
+{
+ int nlines;
+ int olines = FRAME_MENU_BAR_LINES (f);
+
+ /* Right now, menu bars don't work properly in minibuf-only frames;
+ most of the commands try to apply themselves to the minibuffer
+ frame itslef, and get an error because you can't switch buffers
+ in or split the minibuffer window. */
+ if (FRAME_MINIBUF_ONLY_P (f))
+ return;
+
+ if (INTEGERP (value))
+ nlines = XINT (value);
+ else
+ nlines = 0;
+
+ FRAME_MENU_BAR_LINES (f) = 0;
+ if (nlines)
+ FRAME_EXTERNAL_MENU_BAR (f) = 1;
+ else
+ {
+ if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
+ free_frame_menubar (f);
+ FRAME_EXTERNAL_MENU_BAR (f) = 0;
+ }
+}
+
+/* Change the name of frame F to NAME. If NAME is nil, set F's name to
+ win32_id_name.
+
+ If EXPLICIT is non-zero, that indicates that lisp code is setting the
+ name; if NAME is a string, set F's name to NAME and set
+ F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
+
+ If EXPLICIT is zero, that indicates that Emacs redisplay code is
+ suggesting a new name, which lisp code should override; if
+ F->explicit_name is set, ignore the new name; otherwise, set it. */
+
+void
+x_set_name (f, name, explicit)
+ struct frame *f;
+ Lisp_Object name;
+ int explicit;
+{
+ /* Make sure that requests from lisp code override requests from
+ Emacs redisplay code. */
+ if (explicit)
+ {
+ /* If we're switching from explicit to implicit, we had better
+ update the mode lines and thereby update the title. */
+ if (f->explicit_name && NILP (name))
+ update_mode_lines = 1;
+
+ f->explicit_name = ! NILP (name);
+ }
+ else if (f->explicit_name)
+ return;
+
+ /* If NAME is nil, set the name to the win32_id_name. */
+ if (NILP (name))
+ {
+ /* Check for no change needed in this very common case
+ before we do any consing. */
+ if (!strcmp (FRAME_WIN32_DISPLAY_INFO (f)->win32_id_name,
+ XSTRING (f->name)->data))
+ return;
+ name = build_string (FRAME_WIN32_DISPLAY_INFO (f)->win32_id_name);
+ }
+ else
+ CHECK_STRING (name, 0);
+
+ /* Don't change the name if it's already NAME. */
+ if (! NILP (Fstring_equal (name, f->name)))
+ return;
+
+ if (FRAME_WIN32_WINDOW (f))
+ {
+ BLOCK_INPUT;
+ SetWindowText(FRAME_WIN32_WINDOW (f), XSTRING (name)->data);
+ UNBLOCK_INPUT;
+ }
+
+ f->name = name;
+}
+
+/* This function should be called when the user's lisp code has
+ specified a name for the frame; the name will override any set by the
+ redisplay code. */
+void
+x_explicitly_set_name (f, arg, oldval)
+ FRAME_PTR f;
+ Lisp_Object arg, oldval;
+{
+ x_set_name (f, arg, 1);
+}
+
+/* This function should be called by Emacs redisplay code to set the
+ name; names set this way will never override names set by the user's
+ lisp code. */
+void
+x_implicitly_set_name (f, arg, oldval)
+ FRAME_PTR f;
+ Lisp_Object arg, oldval;
+{
+ x_set_name (f, arg, 0);
+}
+
+void
+x_set_autoraise (f, arg, oldval)
+ struct frame *f;
+ Lisp_Object arg, oldval;
+{
+ f->auto_raise = !EQ (Qnil, arg);
+}
+
+void
+x_set_autolower (f, arg, oldval)
+ struct frame *f;
+ Lisp_Object arg, oldval;
+{
+ f->auto_lower = !EQ (Qnil, arg);
+}
+
+void
+x_set_unsplittable (f, arg, oldval)
+ struct frame *f;
+ Lisp_Object arg, oldval;
+{
+ f->no_split = !NILP (arg);
+}
+
+void
+x_set_vertical_scroll_bars (f, arg, oldval)
+ struct frame *f;
+ Lisp_Object arg, oldval;
+{
+ if (NILP (arg) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f))
+ {
+ FRAME_HAS_VERTICAL_SCROLL_BARS (f) = ! NILP (arg);
+
+ /* We set this parameter before creating the window for the
+ frame, so we can get the geometry right from the start.
+ However, if the window hasn't been created yet, we shouldn't
+ call x_set_window_size. */
+ if (FRAME_WIN32_WINDOW (f))
+ x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
+ }
+}
+
+void
+x_set_scroll_bar_width (f, arg, oldval)
+ struct frame *f;
+ Lisp_Object arg, oldval;
+{
+ if (NILP (arg))
+ {
+ FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0;
+ FRAME_SCROLL_BAR_COLS (f) = 2;
+ }
+ else if (INTEGERP (arg) && XINT (arg) > 0
+ && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
+ {
+ int wid = FONT_WIDTH (f->output_data.win32->font);
+ FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
+ FRAME_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
+ if (FRAME_WIN32_WINDOW (f))
+ x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
+ }
+}
+\f
+/* Subroutines of creating an frame. */
+
+/* Make sure that Vx_resource_name is set to a reasonable value.
+ Fix it up, or set it to `emacs' if it is too hopeless. */
+
+static void
+validate_x_resource_name ()
+{
+ int len;
+ /* Number of valid characters in the resource name. */
+ int good_count = 0;
+ /* Number of invalid characters in the resource name. */
+ int bad_count = 0;
+ Lisp_Object new;
+ int i;
+
+ if (STRINGP (Vx_resource_name))
+ {
+ unsigned char *p = XSTRING (Vx_resource_name)->data;
+ int i;
+
+ len = XSTRING (Vx_resource_name)->size;
+
+ /* Only letters, digits, - and _ are valid in resource names.
+ Count the valid characters and count the invalid ones. */
+ for (i = 0; i < len; i++)
+ {
+ int c = p[i];
+ if (! ((c >= 'a' && c <= 'z')
+ || (c >= 'A' && c <= 'Z')
+ || (c >= '0' && c <= '9')
+ || c == '-' || c == '_'))
+ bad_count++;
+ else
+ good_count++;
+ }
+ }
+ else
+ /* Not a string => completely invalid. */
+ bad_count = 5, good_count = 0;
+
+ /* If name is valid already, return. */
+ if (bad_count == 0)
+ return;
+
+ /* If name is entirely invalid, or nearly so, use `emacs'. */
+ if (good_count == 0
+ || (good_count == 1 && bad_count > 0))
+ {
+ Vx_resource_name = build_string ("emacs");
+ return;
+ }
+
+ /* Name is partly valid. Copy it and replace the invalid characters
+ with underscores. */
+
+ Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
+
+ for (i = 0; i < len; i++)
+ {
+ int c = XSTRING (new)->data[i];
+ if (! ((c >= 'a' && c <= 'z')
+ || (c >= 'A' && c <= 'Z')
+ || (c >= '0' && c <= '9')
+ || c == '-' || c == '_'))
+ XSTRING (new)->data[i] = '_';
+ }
+}
+
+
+extern char *x_get_string_resource ();
+
+DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
+ "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
+This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
+class, where INSTANCE is the name under which Emacs was invoked, or\n\
+the name specified by the `-name' or `-rn' command-line arguments.\n\
+\n\
+The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
+class, respectively. You must specify both of them or neither.\n\
+If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
+and the class is `Emacs.CLASS.SUBCLASS'.")
+ (attribute, class, component, subclass)
+ Lisp_Object attribute, class, component, subclass;
+{
+ register char *value;
+ char *name_key;
+ char *class_key;
+
+ CHECK_STRING (attribute, 0);
+ CHECK_STRING (class, 0);
+
+ if (!NILP (component))
+ CHECK_STRING (component, 1);
+ if (!NILP (subclass))
+ CHECK_STRING (subclass, 2);
+ if (NILP (component) != NILP (subclass))
+ error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
+
+ validate_x_resource_name ();
+
+ /* Allocate space for the components, the dots which separate them,
+ and the final '\0'. Make them big enough for the worst case. */
+ name_key = (char *) alloca (XSTRING (Vx_resource_name)->size
+ + (STRINGP (component)
+ ? XSTRING (component)->size : 0)
+ + XSTRING (attribute)->size
+ + 3);
+
+ class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
+ + XSTRING (class)->size
+ + (STRINGP (subclass)
+ ? XSTRING (subclass)->size : 0)
+ + 3);
+
+ /* Start with emacs.FRAMENAME for the name (the specific one)
+ and with `Emacs' for the class key (the general one). */
+ strcpy (name_key, XSTRING (Vx_resource_name)->data);
+ strcpy (class_key, EMACS_CLASS);
+
+ strcat (class_key, ".");
+ strcat (class_key, XSTRING (class)->data);
+
+ if (!NILP (component))
+ {
+ strcat (class_key, ".");
+ strcat (class_key, XSTRING (subclass)->data);
+
+ strcat (name_key, ".");
+ strcat (name_key, XSTRING (component)->data);
+ }
+
+ strcat (name_key, ".");
+ strcat (name_key, XSTRING (attribute)->data);
+
+ value = x_get_string_resource (Qnil,
+ name_key, class_key);
+
+ if (value != (char *) 0)
+ return build_string (value);
+ else
+ return Qnil;
+}
+
+/* Used when C code wants a resource value. */
+
+char *
+x_get_resource_string (attribute, class)
+ char *attribute, *class;
+{
+ register char *value;
+ char *name_key;
+ char *class_key;
+
+ /* Allocate space for the components, the dots which separate them,
+ and the final '\0'. */
+ name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
+ + strlen (attribute) + 2);
+ class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
+ + strlen (class) + 2);
+
+ sprintf (name_key, "%s.%s",
+ XSTRING (Vinvocation_name)->data,
+ attribute);
+ sprintf (class_key, "%s.%s", EMACS_CLASS, class);
+
+ return x_get_string_resource (selected_frame,
+ name_key, class_key);
+}
+
+/* Types we might convert a resource string into. */
+enum resource_types
+ {
+ number, boolean, string, symbol
+ };
+
+/* Return the value of parameter PARAM.
+
+ First search ALIST, then Vdefault_frame_alist, then the X defaults
+ database, using ATTRIBUTE as the attribute name and CLASS as its class.
+
+ Convert the resource to the type specified by desired_type.
+
+ If no default is specified, return Qunbound. If you call
+ x_get_arg, make sure you deal with Qunbound in a reasonable way,
+ and don't let it get stored in any Lisp-visible variables! */
+
+static Lisp_Object
+x_get_arg (alist, param, attribute, class, type)
+ Lisp_Object alist, param;
+ char *attribute;
+ char *class;
+ enum resource_types type;
+{
+ register Lisp_Object tem;
+
+ tem = Fassq (param, alist);
+ if (EQ (tem, Qnil))
+ tem = Fassq (param, Vdefault_frame_alist);
+ if (EQ (tem, Qnil))
+ {
+
+ if (attribute)
+ {
+ tem = Fx_get_resource (build_string (attribute),
+ build_string (class),
+ Qnil, Qnil);
+
+ if (NILP (tem))
+ return Qunbound;
+
+ switch (type)
+ {
+ case number:
+ return make_number (atoi (XSTRING (tem)->data));
+
+ case boolean:
+ tem = Fdowncase (tem);
+ if (!strcmp (XSTRING (tem)->data, "on")
+ || !strcmp (XSTRING (tem)->data, "true"))
+ return Qt;
+ else
+ return Qnil;
+
+ case string:
+ return tem;
+
+ case symbol:
+ /* As a special case, we map the values `true' and `on'
+ to Qt, and `false' and `off' to Qnil. */
+ {
+ Lisp_Object lower;
+ lower = Fdowncase (tem);
+ if (!strcmp (XSTRING (lower)->data, "on")
+ || !strcmp (XSTRING (lower)->data, "true"))
+ return Qt;
+ else if (!strcmp (XSTRING (lower)->data, "off")
+ || !strcmp (XSTRING (lower)->data, "false"))
+ return Qnil;
+ else
+ return Fintern (tem, Qnil);
+ }
+
+ default:
+ abort ();
+ }
+ }
+ else
+ return Qunbound;
+ }
+ return Fcdr (tem);
+}
+
+/* Record in frame F the specified or default value according to ALIST
+ of the parameter named PARAM (a Lisp symbol).
+ If no value is specified for PARAM, look for an X default for XPROP
+ on the frame named NAME.
+ If that is not found either, use the value DEFLT. */
+
+static Lisp_Object
+x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
+ struct frame *f;
+ Lisp_Object alist;
+ Lisp_Object prop;
+ Lisp_Object deflt;
+ char *xprop;
+ char *xclass;
+ enum resource_types type;
+{
+ Lisp_Object tem;
+
+ tem = x_get_arg (alist, prop, xprop, xclass, type);
+ if (EQ (tem, Qunbound))
+ tem = deflt;
+ x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
+ return tem;
+}
+\f
+DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
+ "Parse an X-style geometry string STRING.\n\
+Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
+The properties returned may include `top', `left', `height', and `width'.\n\
+The value of `left' or `top' may be an integer,\n\
+or a list (+ N) meaning N pixels relative to top/left corner,\n\
+or a list (- N) meaning -N pixels relative to bottom/right corner.")
+ (string)
+ Lisp_Object string;
+{
+ int geometry, x, y;
+ unsigned int width, height;
+ Lisp_Object result;
+
+ CHECK_STRING (string, 0);
+
+ geometry = XParseGeometry ((char *) XSTRING (string)->data,
+ &x, &y, &width, &height);
+
+ result = Qnil;
+ if (geometry & XValue)
+ {
+ Lisp_Object element;
+
+ if (x >= 0 && (geometry & XNegative))
+ element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
+ else if (x < 0 && ! (geometry & XNegative))
+ element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
+ else
+ element = Fcons (Qleft, make_number (x));
+ result = Fcons (element, result);
+ }
+
+ if (geometry & YValue)
+ {
+ Lisp_Object element;
+
+ if (y >= 0 && (geometry & YNegative))
+ element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
+ else if (y < 0 && ! (geometry & YNegative))
+ element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
+ else
+ element = Fcons (Qtop, make_number (y));
+ result = Fcons (element, result);
+ }
+
+ if (geometry & WidthValue)
+ result = Fcons (Fcons (Qwidth, make_number (width)), result);
+ if (geometry & HeightValue)
+ result = Fcons (Fcons (Qheight, make_number (height)), result);
+
+ return result;
+}
+
+/* Calculate the desired size and position of this window,
+ and return the flags saying which aspects were specified.
+
+ This function does not make the coordinates positive. */
+
+#define DEFAULT_ROWS 40
+#define DEFAULT_COLS 80
+
+static int
+x_figure_window_size (f, parms)
+ struct frame *f;
+ Lisp_Object parms;
+{
+ register Lisp_Object tem0, tem1, tem2;
+ int height, width, left, top;
+ register int geometry;
+ long window_prompting = 0;
+
+ /* Default values if we fall through.
+ Actually, if that happens we should get
+ window manager prompting. */
+ f->width = DEFAULT_COLS;
+ f->height = DEFAULT_ROWS;
+ /* Window managers expect that if program-specified
+ positions are not (0,0), they're intentional, not defaults. */
+ f->output_data.win32->top_pos = 0;
+ f->output_data.win32->left_pos = 0;
+
+ tem0 = x_get_arg (parms, Qheight, 0, 0, number);
+ tem1 = x_get_arg (parms, Qwidth, 0, 0, number);
+ tem2 = x_get_arg (parms, Quser_size, 0, 0, number);
+ if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
+ {
+ if (!EQ (tem0, Qunbound))
+ {
+ CHECK_NUMBER (tem0, 0);
+ f->height = XINT (tem0);
+ }
+ if (!EQ (tem1, Qunbound))
+ {
+ CHECK_NUMBER (tem1, 0);
+ f->width = XINT (tem1);
+ }
+ if (!NILP (tem2) && !EQ (tem2, Qunbound))
+ window_prompting |= USSize;
+ else
+ window_prompting |= PSize;
+ }
+
+ f->output_data.win32->vertical_scroll_bar_extra
+ = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
+ ? 0
+ : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0
+ ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
+ : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.win32->font)));
+ f->output_data.win32->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
+ f->output_data.win32->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
+
+ tem0 = x_get_arg (parms, Qtop, 0, 0, number);
+ tem1 = x_get_arg (parms, Qleft, 0, 0, number);
+ tem2 = x_get_arg (parms, Quser_position, 0, 0, number);
+ if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
+ {
+ if (EQ (tem0, Qminus))
+ {
+ f->output_data.win32->top_pos = 0;
+ window_prompting |= YNegative;
+ }
+ else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qminus)
+ && CONSP (XCONS (tem0)->cdr)
+ && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
+ {
+ f->output_data.win32->top_pos = - XINT (XCONS (XCONS (tem0)->cdr)->car);
+ window_prompting |= YNegative;
+ }
+ else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qplus)
+ && CONSP (XCONS (tem0)->cdr)
+ && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
+ {
+ f->output_data.win32->top_pos = XINT (XCONS (XCONS (tem0)->cdr)->car);
+ }
+ else if (EQ (tem0, Qunbound))
+ f->output_data.win32->top_pos = 0;
+ else
+ {
+ CHECK_NUMBER (tem0, 0);
+ f->output_data.win32->top_pos = XINT (tem0);
+ if (f->output_data.win32->top_pos < 0)
+ window_prompting |= YNegative;
+ }
+
+ if (EQ (tem1, Qminus))
+ {
+ f->output_data.win32->left_pos = 0;
+ window_prompting |= XNegative;
+ }
+ else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qminus)
+ && CONSP (XCONS (tem1)->cdr)
+ && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
+ {
+ f->output_data.win32->left_pos = - XINT (XCONS (XCONS (tem1)->cdr)->car);
+ window_prompting |= XNegative;
+ }
+ else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qplus)
+ && CONSP (XCONS (tem1)->cdr)
+ && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
+ {
+ f->output_data.win32->left_pos = XINT (XCONS (XCONS (tem1)->cdr)->car);
+ }
+ else if (EQ (tem1, Qunbound))
+ f->output_data.win32->left_pos = 0;
+ else
+ {
+ CHECK_NUMBER (tem1, 0);
+ f->output_data.win32->left_pos = XINT (tem1);
+ if (f->output_data.win32->left_pos < 0)
+ window_prompting |= XNegative;
+ }
+
+ if (!NILP (tem2) && ! EQ (tem2, Qunbound))
+ window_prompting |= USPosition;
+ else
+ window_prompting |= PPosition;
+ }
+
+ return window_prompting;
+}
+
+\f
+
+extern LRESULT CALLBACK win32_wnd_proc ();
+
+BOOL
+win32_init_class (hinst)
+ HINSTANCE hinst;
+{
+ WNDCLASS wc;
+
+ wc.style = CS_HREDRAW | CS_VREDRAW | CS_OWNDC;
+ wc.lpfnWndProc = (WNDPROC) win32_wnd_proc;
+ wc.cbClsExtra = 0;
+ wc.cbWndExtra = WND_EXTRA_BYTES;
+ wc.hInstance = hinst;
+ wc.hIcon = LoadIcon (hinst, EMACS_CLASS);
+ wc.hCursor = LoadCursor (NULL, IDC_ARROW);
+ wc.hbrBackground = NULL; // GetStockObject (WHITE_BRUSH);
+ wc.lpszMenuName = NULL;
+ wc.lpszClassName = EMACS_CLASS;
+
+ return (RegisterClass (&wc));
+}
+
+HWND
+win32_createscrollbar (f, bar)
+ struct frame *f;
+ struct scroll_bar * bar;
+{
+ return (CreateWindow ("SCROLLBAR", "", SBS_VERT | WS_CHILD | WS_VISIBLE,
+ /* Position and size of scroll bar. */
+ XINT(bar->left), XINT(bar->top),
+ XINT(bar->width), XINT(bar->height),
+ FRAME_WIN32_WINDOW (f),
+ NULL,
+ hinst,
+ NULL));
+}
+
+void
+win32_createwindow (f)
+ struct frame *f;
+{
+ HWND hwnd;
+
+ /* Do first time app init */
+
+ if (!hprevinst)
+ {
+ win32_init_class (hinst);
+ }
+
+ FRAME_WIN32_WINDOW (f) = hwnd = CreateWindow (EMACS_CLASS,
+ f->namebuf,
+ f->output_data.win32->dwStyle | WS_CLIPCHILDREN,
+ f->output_data.win32->left_pos,
+ f->output_data.win32->top_pos,
+ PIXEL_WIDTH (f),
+ PIXEL_HEIGHT (f),
+ NULL,
+ NULL,
+ hinst,
+ NULL);
+
+ if (hwnd)
+ {
+ SetWindowLong (hwnd, WND_X_UNITS_INDEX, FONT_WIDTH (f->output_data.win32->font));
+ SetWindowLong (hwnd, WND_Y_UNITS_INDEX, f->output_data.win32->line_height);
+ SetWindowLong (hwnd, WND_BACKGROUND_INDEX, f->output_data.win32->background_pixel);
+ }
+}
+
+DWORD
+win_msg_worker (dw)
+ DWORD dw;
+{
+ MSG msg;
+
+ /* Ensure our message queue is created */
+
+ PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE);
+
+ PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0);
+
+ while (GetMessage (&msg, NULL, 0, 0))
+ {
+ if (msg.hwnd == NULL)
+ {
+ switch (msg.message)
+ {
+ case WM_EMACS_CREATEWINDOW:
+ win32_createwindow ((struct frame *) msg.wParam);
+ PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0);
+ break;
+ case WM_EMACS_CREATESCROLLBAR:
+ {
+ HWND hwnd = win32_createscrollbar ((struct frame *) msg.wParam,
+ (struct scroll_bar *) msg.lParam);
+ PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, (WPARAM)hwnd, 0);
+ }
+ break;
+ case WM_EMACS_KILL:
+ return (0);
+ }
+ }
+ else
+ {
+ DispatchMessage (&msg);
+ }
+ }
+
+ return (0);
+}
+
+HDC
+map_mode (hdc)
+ HDC hdc;
+{
+ if (hdc)
+ {
+#if 0
+ /* Make mapping mode be in 1/20 of point */
+
+ SetMapMode (hdc, MM_ANISOTROPIC);
+ SetWindowExtEx (hdc, 1440, 1440, NULL);
+ SetViewportExtEx (hdc,
+ GetDeviceCaps (hdc, LOGPIXELSX),
+ GetDeviceCaps (hdc, LOGPIXELSY),
+ NULL);
+#endif
+ }
+ return (hdc);
+}
+
+/* Convert between the modifier bits Win32 uses and the modifier bits
+ Emacs uses. */
+unsigned int
+win32_get_modifiers ()
+{
+ return (((GetKeyState (VK_SHIFT)&0x8000) ? shift_modifier : 0) |
+ ((GetKeyState (VK_CONTROL)&0x8000) ? ctrl_modifier : 0) |
+ ((GetKeyState (VK_MENU)&0x8000) ? meta_modifier : 0));
+}
+
+void
+my_post_msg (wmsg, hwnd, msg, wParam, lParam)
+ Win32Msg * wmsg;
+ HWND hwnd;
+ UINT msg;
+ WPARAM wParam;
+ LPARAM lParam;
+{
+ wmsg->msg.hwnd = hwnd;
+ wmsg->msg.message = msg;
+ wmsg->msg.wParam = wParam;
+ wmsg->msg.lParam = lParam;
+ wmsg->msg.time = GetMessageTime ();
+
+ post_msg (wmsg);
+}
+
+/* Main window procedure */
+
+extern char *lispy_function_keys[];
+
+LRESULT CALLBACK
+win32_wnd_proc (hwnd, msg, wParam, lParam)
+ HWND hwnd;
+ UINT msg;
+ WPARAM wParam;
+ LPARAM lParam;
+{
+ struct frame *f;
+ LRESULT ret = 1;
+ struct win32_display_info *dpyinfo = &one_win32_display_info;
+ Win32Msg wmsg;
+
+ switch (msg)
+ {
+ case WM_ERASEBKGND:
+ {
+ HBRUSH hb;
+ HANDLE oldobj;
+ RECT rect;
+
+ GetClientRect (hwnd, &rect);
+
+ hb = CreateSolidBrush (GetWindowLong (hwnd, WND_BACKGROUND_INDEX));
+
+ oldobj = SelectObject ((HDC)wParam, hb);
+
+ FillRect((HDC)wParam, &rect, hb);
+
+ SelectObject((HDC)wParam, oldobj);
+
+ DeleteObject (hb);
+
+ return (0);
+ }
+ case WM_PAINT:
+ {
+ PAINTSTRUCT paintStruct;
+
+ BeginPaint (hwnd, &paintStruct);
+ wmsg.rect = paintStruct.rcPaint;
+ EndPaint (hwnd, &paintStruct);
+
+ my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
+
+ return (0);
+ }
+
+ case WM_CREATE:
+ {
+ HDC hdc = my_get_dc (hwnd);
+
+ /* Make mapping mode be in 1/20 of point */
+
+ map_mode (hdc);
+
+ ReleaseDC (hwnd, hdc);
+ }
+
+ return (0);
+ case WM_KEYDOWN:
+ case WM_SYSKEYDOWN:
+#if 0
+ if (! ((wParam >= VK_BACK && wParam <= VK_TAB)
+ || (wParam >= VK_CLEAR && wParam <= VK_RETURN)
+ || (wParam == VK_ESCAPE)
+ || (wParam >= VK_PRIOR && wParam <= VK_HELP)
+ || (wParam >= VK_LWIN && wParam <= VK_APPS)
+ || (wParam >= VK_NUMPAD0 && wParam <= VK_F24)
+ || (wParam >= VK_NUMLOCK && wParam <= VK_SCROLL)
+ || (wParam >= VK_ATTN && wParam <= VK_OEM_CLEAR)
+ || !TranslateMessage (&msg1)))
+ {
+ goto dflt;
+ }
+#endif
+
+ /* Check for special characters since translate message
+ seems to always indicate true. */
+
+ if (wParam == VK_MENU
+ || wParam == VK_SHIFT
+ || wParam == VK_CONTROL
+ || wParam == VK_CAPITAL)
+ break;
+
+ /* Anything we do not have a name for needs to be translated or
+ returned as ascii keystroke. */
+
+ if (lispy_function_keys[wParam] == 0)
+ {
+ MSG msg1;
+
+ msg1.hwnd = hwnd;
+ msg1.message = msg;
+ msg1.wParam = wParam;
+ msg1.lParam = lParam;
+
+ if (TranslateMessage (&msg1))
+ break;
+ else
+ msg = WM_CHAR;
+ }
+
+ /* Fall through */
+
+ case WM_SYSCHAR:
+ case WM_CHAR:
+ wmsg.dwModifiers = win32_get_modifiers ();
+
+ my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
+ break;
+ case WM_LBUTTONDOWN:
+ case WM_LBUTTONUP:
+ case WM_MBUTTONDOWN:
+ case WM_MBUTTONUP:
+ case WM_RBUTTONDOWN:
+ case WM_RBUTTONUP:
+ {
+ BOOL up;
+
+ if (parse_button (msg, NULL, &up))
+ {
+ if (up) ReleaseCapture ();
+ else SetCapture (hwnd);
+ }
+ }
+
+ wmsg.dwModifiers = win32_get_modifiers ();
+
+ my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
+ goto dflt;
+ case WM_MOUSEMOVE:
+ case WM_MOVE:
+ case WM_SIZE:
+ case WM_SETFOCUS:
+ case WM_KILLFOCUS:
+ case WM_CLOSE:
+ case WM_VSCROLL:
+ case WM_SYSCOMMAND:
+ case WM_COMMAND:
+ my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
+ goto dflt;
+ case WM_WINDOWPOSCHANGING:
+ {
+ WINDOWPLACEMENT wp;
+ LPWINDOWPOS lppos = (WINDOWPOS *) lParam;
+
+ GetWindowPlacement (hwnd, &wp);
+
+ if (wp.showCmd != SW_SHOWMINIMIZED && ! (lppos->flags & SWP_NOSIZE))
+ {
+ RECT rect;
+ int wdiff;
+ int hdiff;
+ DWORD dwXUnits;
+ DWORD dwYUnits;
+ RECT wr;
+
+ GetWindowRect (hwnd, &wr);
+
+ enter_crit ();
+
+ dwXUnits = GetWindowLong (hwnd, WND_X_UNITS_INDEX);
+ dwYUnits = GetWindowLong (hwnd, WND_Y_UNITS_INDEX);
+
+ leave_crit ();
+
+ memset (&rect, 0, sizeof (rect));
+ AdjustWindowRect (&rect, GetWindowLong (hwnd, GWL_STYLE),
+ GetMenu (hwnd) != NULL);
+
+ /* All windows have an extra pixel so subtract 1 */
+
+ wdiff = (lppos->cx - (rect.right - rect.left) - 0) % dwXUnits;
+ hdiff = (lppos->cy - (rect.bottom - rect.top) - 0) % dwYUnits;
+
+ if (wdiff || hdiff)
+ {
+ /* For right/bottom sizing we can just fix the sizes.
+ However for top/left sizing we will need to fix the X
+ and Y positions as well. */
+
+ lppos->cx -= wdiff;
+ lppos->cy -= hdiff;
+
+ if (wp.showCmd != SW_SHOWMAXIMIZED
+ && ! (lppos->flags & SWP_NOMOVE))
+ {
+ if (lppos->x != wr.left || lppos->y != wr.top)
+ {
+ lppos->x += wdiff;
+ lppos->y += hdiff;
+ }
+ else
+ {
+ lppos->flags |= SWP_NOMOVE;
+ }
+ }
+
+ ret = 0;
+ }
+ }
+ }
+
+ if (ret == 0) return (0);
+
+ goto dflt;
+ case WM_EMACS_DESTROYWINDOW:
+ DestroyWindow ((HWND) wParam);
+ break;
+ default:
+ dflt:
+ return DefWindowProc (hwnd, msg, wParam, lParam);
+ }
+
+ return (1);
+}
+
+void
+my_create_window (f)
+ struct frame * f;
+{
+ MSG msg;
+
+ PostThreadMessage (dwWinThreadId, WM_EMACS_CREATEWINDOW, (WPARAM)f, 0);
+ GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
+}
+
+/* Create and set up the win32 window for frame F. */
+
+static void
+win32_window (f, window_prompting, minibuffer_only)
+ struct frame *f;
+ long window_prompting;
+ int minibuffer_only;
+{
+ BLOCK_INPUT;
+
+ /* Use the resource name as the top-level window name
+ for looking up resources. Make a non-Lisp copy
+ for the window manager, so GC relocation won't bother it.
+
+ Elsewhere we specify the window name for the window manager. */
+
+ {
+ char *str = (char *) XSTRING (Vx_resource_name)->data;
+ f->namebuf = (char *) xmalloc (strlen (str) + 1);
+ strcpy (f->namebuf, str);
+ }
+
+ my_create_window (f);
+
+ validate_x_resource_name ();
+
+ /* x_set_name normally ignores requests to set the name if the
+ requested name is the same as the current name. This is the one
+ place where that assumption isn't correct; f->name is set, but
+ the server hasn't been told. */
+ {
+ Lisp_Object name;
+ int explicit = f->explicit_name;
+
+ f->explicit_name = 0;
+ name = f->name;
+ f->name = Qnil;
+ x_set_name (f, name, explicit);
+ }
+
+ UNBLOCK_INPUT;
+
+ if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
+ initialize_frame_menubar (f);
+
+ if (FRAME_WIN32_WINDOW (f) == 0)
+ error ("Unable to create window");
+}
+
+/* Handle the icon stuff for this window. Perhaps later we might
+ want an x_set_icon_position which can be called interactively as
+ well. */
+
+static void
+x_icon (f, parms)
+ struct frame *f;
+ Lisp_Object parms;
+{
+ Lisp_Object icon_x, icon_y;
+
+ /* Set the position of the icon. Note that win95 groups all
+ icons in the tray. */
+ icon_x = x_get_arg (parms, Qicon_left, 0, 0, number);
+ icon_y = x_get_arg (parms, Qicon_top, 0, 0, number);
+ if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
+ {
+ CHECK_NUMBER (icon_x, 0);
+ CHECK_NUMBER (icon_y, 0);
+ }
+ else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
+ error ("Both left and top icon corners of icon must be specified");
+
+ BLOCK_INPUT;
+
+ if (! EQ (icon_x, Qunbound))
+ x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
+
+ UNBLOCK_INPUT;
+}
+
+DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
+ 1, 1, 0,
+ "Make a new window, which is called a \"frame\" in Emacs terms.\n\
+Returns an Emacs frame object.\n\
+ALIST is an alist of frame parameters.\n\
+If the parameters specify that the frame should not have a minibuffer,\n\
+and do not specify a specific minibuffer window to use,\n\
+then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
+be shared by the new frame.\n\
+\n\
+This function is an internal primitive--use `make-frame' instead.")
+ (parms)
+ Lisp_Object parms;
+{
+ struct frame *f;
+ Lisp_Object frame, tem;
+ Lisp_Object name;
+ int minibuffer_only = 0;
+ long window_prompting = 0;
+ int width, height;
+ int count = specpdl_ptr - specpdl;
+ struct gcpro gcpro1;
+ Lisp_Object display;
+ struct win32_display_info *dpyinfo;
+ Lisp_Object parent;
+ struct kboard *kb;
+
+ /* Use this general default value to start with
+ until we know if this frame has a specified name. */
+ Vx_resource_name = Vinvocation_name;
+
+ display = x_get_arg (parms, Qdisplay, 0, 0, string);
+ if (EQ (display, Qunbound))
+ display = Qnil;
+ dpyinfo = check_x_display_info (display);
+#ifdef MULTI_KBOARD
+ kb = dpyinfo->kboard;
+#else
+ kb = &the_only_kboard;
+#endif
+
+ name = x_get_arg (parms, Qname, "title", "Title", string);
+ if (!STRINGP (name)
+ && ! EQ (name, Qunbound)
+ && ! NILP (name))
+ error ("Invalid frame name--not a string or nil");
+
+ if (STRINGP (name))
+ Vx_resource_name = name;
+
+ /* See if parent window is specified. */
+ parent = x_get_arg (parms, Qparent_id, NULL, NULL, number);
+ if (EQ (parent, Qunbound))
+ parent = Qnil;
+ if (! NILP (parent))
+ CHECK_NUMBER (parent, 0);
+
+ tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
+ if (EQ (tem, Qnone) || NILP (tem))
+ f = make_frame_without_minibuffer (Qnil, kb, display);
+ else if (EQ (tem, Qonly))
+ {
+ f = make_minibuffer_frame ();
+ minibuffer_only = 1;
+ }
+ else if (WINDOWP (tem))
+ f = make_frame_without_minibuffer (tem, kb, display);
+ else
+ f = make_frame (1);
+
+ /* Note that Windows does support scroll bars. */
+ FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
+
+ XSETFRAME (frame, f);
+ GCPRO1 (frame);
+
+ f->output_method = output_win32;
+ f->output_data.win32 = (struct win32_output *) xmalloc (sizeof (struct win32_output));
+ bzero (f->output_data.win32, sizeof (struct win32_output));
+
+/* FRAME_WIN32_DISPLAY_INFO (f) = dpyinfo; */
+#ifdef MULTI_KBOARD
+ FRAME_KBOARD (f) = kb;
+#endif
+
+ /* Specify the parent under which to make this window. */
+
+ if (!NILP (parent))
+ {
+ f->output_data.win32->parent_desc = (Window) parent;
+ f->output_data.win32->explicit_parent = 1;
+ }
+ else
+ {
+ f->output_data.win32->parent_desc = FRAME_WIN32_DISPLAY_INFO (f)->root_window;
+ f->output_data.win32->explicit_parent = 0;
+ }
+
+ /* Note that the frame has no physical cursor right now. */
+ f->phys_cursor_x = -1;
+
+ /* Set the name; the functions to which we pass f expect the name to
+ be set. */
+ if (EQ (name, Qunbound) || NILP (name))
+ {
+ f->name = build_string (dpyinfo->win32_id_name);
+ f->explicit_name = 0;
+ }
+ else
+ {
+ f->name = name;
+ f->explicit_name = 1;
+ /* use the frame's title when getting resources for this frame. */
+ specbind (Qx_resource_name, name);
+ }
+
+ /* Extract the window parameters from the supplied values
+ that are needed to determine window geometry. */
+ {
+ Lisp_Object font;
+
+ font = x_get_arg (parms, Qfont, "font", "Font", string);
+ BLOCK_INPUT;
+ /* First, try whatever font the caller has specified. */
+ if (STRINGP (font))
+ font = x_new_font (f, XSTRING (font)->data);
+#if 0
+ /* Try out a font which we hope has bold and italic variations. */
+ if (!STRINGP (font))
+ font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
+ if (! STRINGP (font))
+ font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
+ if (! STRINGP (font))
+ /* This was formerly the first thing tried, but it finds too many fonts
+ and takes too long. */
+ font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
+ /* If those didn't work, look for something which will at least work. */
+ if (! STRINGP (font))
+ font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
+ if (! STRINGP (font))
+ font = x_new_font (f, "-*-system-medium-r-normal-*-*-200-*-*-c-120-*-*");
+#endif
+ if (! STRINGP (font))
+ font = x_new_font (f, "-*-terminal-medium-r-normal-*-*-180-*-*-c-120-*-*");
+ UNBLOCK_INPUT;
+ if (! STRINGP (font))
+ font = build_string ("-*-system");
+
+ x_default_parameter (f, parms, Qfont, font,
+ "font", "Font", string);
+ }
+
+ x_default_parameter (f, parms, Qborder_width, make_number (2),
+ "borderwidth", "BorderWidth", number);
+ /* This defaults to 2 in order to match xterm. We recognize either
+ internalBorderWidth or internalBorder (which is what xterm calls
+ it). */
+ if (NILP (Fassq (Qinternal_border_width, parms)))
+ {
+ Lisp_Object value;
+
+ value = x_get_arg (parms, Qinternal_border_width,
+ "internalBorder", "BorderWidth", number);
+ if (! EQ (value, Qunbound))
+ parms = Fcons (Fcons (Qinternal_border_width, value),
+ parms);
+ }
+ x_default_parameter (f, parms, Qinternal_border_width, make_number (0),
+ "internalBorderWidth", "BorderWidth", number);
+ x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
+ "verticalScrollBars", "ScrollBars", boolean);
+
+ /* Also do the stuff which must be set before the window exists. */
+ x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
+ "foreground", "Foreground", string);
+ x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
+ "background", "Background", string);
+ x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
+ "pointerColor", "Foreground", string);
+ x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
+ "cursorColor", "Foreground", string);
+ x_default_parameter (f, parms, Qborder_color, build_string ("black"),
+ "borderColor", "BorderColor", string);
+
+ x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
+ "menuBar", "MenuBar", number);
+ x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
+ "scrollBarWidth", "ScrollBarWidth", number);
+
+ f->output_data.win32->dwStyle = WS_OVERLAPPEDWINDOW;
+ f->output_data.win32->parent_desc = FRAME_WIN32_DISPLAY_INFO (f)->root_window;
+ window_prompting = x_figure_window_size (f, parms);
+
+ if (window_prompting & XNegative)
+ {
+ if (window_prompting & YNegative)
+ f->output_data.win32->win_gravity = SouthEastGravity;
+ else
+ f->output_data.win32->win_gravity = NorthEastGravity;
+ }
+ else
+ {
+ if (window_prompting & YNegative)
+ f->output_data.win32->win_gravity = SouthWestGravity;
+ else
+ f->output_data.win32->win_gravity = NorthWestGravity;
+ }
+
+ f->output_data.win32->size_hint_flags = window_prompting;
+
+ win32_window (f, window_prompting, minibuffer_only);
+ x_icon (f, parms);
+ init_frame_faces (f);
+
+ /* We need to do this after creating the window, so that the
+ icon-creation functions can say whose icon they're describing. */
+ x_default_parameter (f, parms, Qicon_type, Qnil,
+ "bitmapIcon", "BitmapIcon", symbol);
+
+ x_default_parameter (f, parms, Qauto_raise, Qnil,
+ "autoRaise", "AutoRaiseLower", boolean);
+ x_default_parameter (f, parms, Qauto_lower, Qnil,
+ "autoLower", "AutoRaiseLower", boolean);
+ x_default_parameter (f, parms, Qcursor_type, Qbox,
+ "cursorType", "CursorType", symbol);
+
+ /* Dimensions, especially f->height, must be done via change_frame_size.
+ Change will not be effected unless different from the current
+ f->height. */
+ width = f->width;
+ height = f->height;
+ f->height = f->width = 0;
+ change_frame_size (f, height, width, 1, 0);
+
+ /* Tell the server what size and position, etc, we want,
+ and how badly we want them. */
+ BLOCK_INPUT;
+ x_wm_set_size_hint (f, window_prompting, 0);
+ UNBLOCK_INPUT;
+
+ tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
+ f->no_split = minibuffer_only || EQ (tem, Qt);
+
+ UNGCPRO;
+
+ /* It is now ok to make the frame official
+ even if we get an error below.
+ And the frame needs to be on Vframe_list
+ or making it visible won't work. */
+ Vframe_list = Fcons (frame, Vframe_list);
+
+ /* Now that the frame is official, it counts as a reference to
+ its display. */
+ FRAME_WIN32_DISPLAY_INFO (f)->reference_count++;
+
+ /* Make the window appear on the frame and enable display,
+ unless the caller says not to. However, with explicit parent,
+ Emacs cannot control visibility, so don't try. */
+ if (! f->output_data.win32->explicit_parent)
+ {
+ Lisp_Object visibility;
+
+ visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
+ if (EQ (visibility, Qunbound))
+ visibility = Qt;
+
+ if (EQ (visibility, Qicon))
+ x_iconify_frame (f);
+ else if (! NILP (visibility))
+ x_make_frame_visible (f);
+ else
+ /* Must have been Qnil. */
+ ;
+ }
+
+ return unbind_to (count, frame);
+}
+
+/* FRAME is used only to get a handle on the X display. We don't pass the
+ display info directly because we're called from frame.c, which doesn't
+ know about that structure. */
+Lisp_Object
+x_get_focus_frame (frame)
+ struct frame *frame;
+{
+ struct win32_display_info *dpyinfo = FRAME_WIN32_DISPLAY_INFO (frame);
+ Lisp_Object xfocus;
+ if (! dpyinfo->win32_focus_frame)
+ return Qnil;
+
+ XSETFRAME (xfocus, dpyinfo->win32_focus_frame);
+ return xfocus;
+}
+
+DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0,
+ "Set the focus on FRAME.")
+ (frame)
+ Lisp_Object frame;
+{
+ CHECK_LIVE_FRAME (frame, 0);
+
+ if (FRAME_WIN32_P (XFRAME (frame)))
+ {
+ BLOCK_INPUT;
+ x_focus_on_frame (XFRAME (frame));
+ UNBLOCK_INPUT;
+ return frame;
+ }
+
+ return Qnil;
+}
+
+DEFUN ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0,
+ "If a frame has been focused, release it.")
+ ()
+{
+ if (FRAME_WIN32_P (selected_frame))
+ {
+ struct win32_display_info *dpyinfo = FRAME_WIN32_DISPLAY_INFO (selected_frame);
+
+ if (dpyinfo->win32_focus_frame)
+ {
+ BLOCK_INPUT;
+ x_unfocus_frame (dpyinfo->win32_focus_frame);
+ UNBLOCK_INPUT;
+ }
+ }
+
+ return Qnil;
+}
+\f
+XFontStruct
+*win32_load_font (dpyinfo,name)
+struct win32_display_info *dpyinfo;
+char * name;
+{
+ XFontStruct * font = NULL;
+ BOOL ok;
+
+ {
+ LOGFONT lf;
+
+ if (!name || !x_to_win32_font(name, &lf))
+ return (NULL);
+
+ font = (XFontStruct *) xmalloc (sizeof (XFontStruct));
+
+ if (!font) return (NULL);
+
+ BLOCK_INPUT;
+
+ font->hfont = CreateFontIndirect(&lf);
+ }
+
+ if (font->hfont == NULL)
+ {
+ ok = FALSE;
+ }
+ else
+ {
+ HDC hdc;
+ HANDLE oldobj;
+
+ hdc = my_get_dc (dpyinfo->root_window);
+
+ oldobj = SelectObject (hdc, font->hfont);
+
+ ok = GetTextMetrics (hdc, &font->tm);
+
+ SelectObject (hdc, oldobj);
+
+ ReleaseDC (dpyinfo->root_window, hdc);
+ }
+
+ UNBLOCK_INPUT;
+
+ if (ok) return (font);
+
+ win32_unload_font(dpyinfo, font);
+ return (NULL);
+}
+
+void
+win32_unload_font (dpyinfo, font)
+ struct win32_display_info *dpyinfo;
+ XFontStruct * font;
+{
+ if (font)
+ {
+ if (font->hfont) DeleteObject(font->hfont);
+ xfree (font);
+ }
+}
+
+/* The font conversion stuff between x and win32 */
+
+/* X font string is as follows (from faces.el)
+ * (let ((- "[-?]")
+ * (foundry "[^-]+")
+ * (family "[^-]+")
+ * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
+ * (weight\? "\\([^-]*\\)") ; 1
+ * (slant "\\([ior]\\)") ; 2
+ * (slant\? "\\([^-]?\\)") ; 2
+ * (swidth "\\([^-]*\\)") ; 3
+ * (adstyle "[^-]*") ; 4
+ * (pixelsize "[0-9]+")
+ * (pointsize "[0-9][0-9]+")
+ * (resx "[0-9][0-9]+")
+ * (resy "[0-9][0-9]+")
+ * (spacing "[cmp?*]")
+ * (avgwidth "[0-9]+")
+ * (registry "[^-]+")
+ * (encoding "[^-]+")
+ * )
+ * (setq x-font-regexp
+ * (concat "\\`\\*?[-?*]"
+ * foundry - family - weight\? - slant\? - swidth - adstyle -
+ * pixelsize - pointsize - resx - resy - spacing - registry -
+ * encoding "[-?*]\\*?\\'"
+ * ))
+ * (setq x-font-regexp-head
+ * (concat "\\`[-?*]" foundry - family - weight\? - slant\?
+ * "\\([-*?]\\|\\'\\)"))
+ * (setq x-font-regexp-slant (concat - slant -))
+ * (setq x-font-regexp-weight (concat - weight -))
+ * nil)
+ */
+
+#define FONT_START "[-?]"
+#define FONT_FOUNDRY "[^-]+"
+#define FONT_FAMILY "\\([^-]+\\)" /* 1 */
+#define FONT_WEIGHT "\\(bold\\|demibold\\|medium\\)" /* 2 */
+#define FONT_WEIGHT_Q "\\([^-]*\\)" /* 2 */
+#define FONT_SLANT "\\([ior]\\)" /* 3 */
+#define FONT_SLANT_Q "\\([^-]?\\)" /* 3 */
+#define FONT_SWIDTH "\\([^-]*\\)" /* 4 */
+#define FONT_ADSTYLE "[^-]*"
+#define FONT_PIXELSIZE "[^-]*"
+#define FONT_POINTSIZE "\\([0-9][0-9]+\\|\\*\\)" /* 5 */
+#define FONT_RESX "[0-9][0-9]+"
+#define FONT_RESY "[0-9][0-9]+"
+#define FONT_SPACING "[cmp?*]"
+#define FONT_AVGWIDTH "[0-9]+"
+#define FONT_REGISTRY "[^-]+"
+#define FONT_ENCODING "[^-]+"
+
+#define FONT_REGEXP ("\\`\\*?[-?*]" \
+ FONT_FOUNDRY "-" \
+ FONT_FAMILY "-" \
+ FONT_WEIGHT_Q "-" \
+ FONT_SLANT_Q "-" \
+ FONT_SWIDTH "-" \
+ FONT_ADSTYLE "-" \
+ FONT_PIXELSIZE "-" \
+ FONT_POINTSIZE "-" \
+ "[-?*]\\|\\'")
+
+#define FONT_REGEXP_HEAD ("\\`[-?*]" \
+ FONT_FOUNDRY "-" \
+ FONT_FAMILY "-" \
+ FONT_WEIGHT_Q "-" \
+ FONT_SLANT_Q \
+ "\\([-*?]\\|\\'\\)")
+
+#define FONT_REGEXP_SLANT "-" FONT_SLANT "-"
+#define FONT_REGEXP_WEIGHT "-" FONT_WEIGHT "-"
+
+LONG
+x_to_win32_weight (lpw)
+ char * lpw;
+{
+ if (!lpw) return (FW_DONTCARE);
+
+ if (stricmp (lpw, "bold") == 0)
+ return (FW_BOLD);
+ else if (stricmp (lpw, "demibold") == 0)
+ return (FW_SEMIBOLD);
+ else if (stricmp (lpw, "medium") == 0)
+ return (FW_MEDIUM);
+ else if (stricmp (lpw, "normal") == 0)
+ return (FW_NORMAL);
+ else
+ return (FW_DONTCARE);
+}
+
+char *
+win32_to_x_weight (fnweight)
+ int fnweight;
+{
+ if (fnweight >= FW_BOLD)
+ return ("bold");
+ else if (fnweight >= FW_SEMIBOLD)
+ return ("demibold");
+ else if (fnweight >= FW_MEDIUM)
+ return ("medium");
+ else
+ return ("normal");
+}
+
+BOOL
+win32_to_x_font (lplogfont, lpxstr, len)
+ LOGFONT * lplogfont;
+ char * lpxstr;
+ int len;
+{
+ if (!lpxstr) return (FALSE);
+
+ if (lplogfont)
+ {
+ int height = (lplogfont->lfHeight * 1440)
+ / one_win32_display_info.height_in;
+ int width = (lplogfont->lfWidth * 1440)
+ / one_win32_display_info.width_in;
+
+ height = abs (height);
+ _snprintf (lpxstr, len - 1,
+ "-*-%s-%s-%c-%s-%s-*-%d-*-*-%c-%d-*-*-",
+ lplogfont->lfFaceName,
+ win32_to_x_weight (lplogfont->lfWeight),
+ lplogfont->lfItalic ? 'i' : 'r',
+ "*", "*",
+ height,
+ ((lplogfont->lfPitchAndFamily & 0x3) == VARIABLE_PITCH) ? 'p' : 'c',
+ width);
+ }
+ else
+ {
+ strncpy (lpxstr, "-*-*-*-*-*-*-*-*-*-*-*-*-*-*-", len - 1);
+ }
+
+ lpxstr[len - 1] = 0; /* just to be sure */
+ return (TRUE);
+}
+
+BOOL
+x_to_win32_font (lpxstr, lplogfont)
+ char * lpxstr;
+ LOGFONT * lplogfont;
+{
+ if (!lplogfont) return (FALSE);
+
+ memset (lplogfont, 0, sizeof (*lplogfont));
+
+ lplogfont->lfCharSet = OEM_CHARSET;
+ lplogfont->lfOutPrecision = OUT_DEFAULT_PRECIS;
+ lplogfont->lfClipPrecision = CLIP_DEFAULT_PRECIS;
+ lplogfont->lfQuality = DEFAULT_QUALITY;
+
+ if (lpxstr && *lpxstr == '-') lpxstr++;
+
+ {
+ int fields;
+ char name[50], weight[20], slant, pitch, height[10], width[10];
+
+ fields = (lpxstr
+ ? sscanf (lpxstr,
+ "%*[^-]-%[^-]-%[^-]-%c-%*[^-]-%*[^-]-%*[^-]-%[^-]-%*[^-]-%*[^-]-%c-%[^-]",
+ name, weight, &slant, height, &pitch, width)
+ : 0);
+
+ if (fields == EOF) return (FALSE);
+
+ if (fields > 0 && name[0] != '*')
+ {
+ strncpy (lplogfont->lfFaceName, name, LF_FACESIZE);
+ }
+ else
+ {
+ lplogfont->lfFaceName[0] = 0;
+ }
+
+ fields--;
+
+ lplogfont->lfWeight = x_to_win32_weight((fields > 0 ? weight : ""));
+
+ fields--;
+
+ lplogfont->lfItalic = (fields > 0 && slant == 'i');
+
+ fields--;
+
+ if (fields > 0 && height[0] != '*')
+ lplogfont->lfHeight = (atoi (height) * one_win32_display_info.height_in) / 1440;
+
+ fields--;
+
+ lplogfont->lfPitchAndFamily = (fields > 0 && pitch == 'p') ? VARIABLE_PITCH : FIXED_PITCH;
+
+ fields--;
+
+ if (fields > 0 && width[0] != '*')
+ lplogfont->lfWidth = (atoi (width) * one_win32_display_info.width_in) / 1440;
+ }
+
+ return (TRUE);
+}
+
+BOOL
+win32_font_match (lpszfont1, lpszfont2)
+ char * lpszfont1;
+ char * lpszfont2;
+{
+ char * s1 = lpszfont1, *e1;
+ char * s2 = lpszfont2, *e2;
+
+ if (s1 == NULL || s2 == NULL) return (FALSE);
+
+ if (*s1 == '-') s1++;
+ if (*s2 == '-') s2++;
+
+ while (1)
+ {
+ int len1, len2;
+
+ e1 = strchr (s1, '-');
+ e2 = strchr (s2, '-');
+
+ if (e1 == NULL || e2 == NULL) return (TRUE);
+
+ len1 = e1 - s1;
+ len2 = e2 - s2;
+
+ if (*s1 != '*' && *s2 != '*'
+ && (len1 != len2 || strnicmp (s1, s2, len1) != 0))
+ return (FALSE);
+
+ s1 = e1 + 1;
+ s2 = e2 + 1;
+ }
+}
+
+typedef struct enumfont_t
+{
+ HDC hdc;
+ int numFonts;
+ XFontStruct *size_ref;
+ Lisp_Object *pattern;
+ Lisp_Object *head;
+ Lisp_Object *tail;
+} enumfont_t;
+
+int CALLBACK
+enum_font_cb2 (lplf, lptm, FontType, lpef)
+ ENUMLOGFONT * lplf;
+ NEWTEXTMETRIC * lptm;
+ int FontType;
+ enumfont_t * lpef;
+{
+ if (lplf->elfLogFont.lfStrikeOut || lplf->elfLogFont.lfUnderline
+ || (lplf->elfLogFont.lfCharSet != ANSI_CHARSET && lplf->elfLogFont.lfCharSet != OEM_CHARSET))
+ return (1);
+
+ /* if (!lpef->size_ref || lptm->tmMaxCharWidth == FONT_WIDTH (lpef->size_ref)) */
+ {
+ char buf[100];
+
+ if (!win32_to_x_font (lplf, buf, 100)) return (0);
+
+ if (NILP (*(lpef->pattern)) || win32_font_match (buf, XSTRING (*(lpef->pattern))->data))
+ {
+ *lpef->tail = Fcons (build_string (buf), Qnil);
+ lpef->tail = &XCONS (*lpef->tail)->cdr;
+ lpef->numFonts++;
+ }
+ }
+
+ return (1);
+}
+
+int CALLBACK
+enum_font_cb1 (lplf, lptm, FontType, lpef)
+ ENUMLOGFONT * lplf;
+ NEWTEXTMETRIC * lptm;
+ int FontType;
+ enumfont_t * lpef;
+{
+ return EnumFontFamilies (lpef->hdc,
+ lplf->elfLogFont.lfFaceName,
+ (FONTENUMPROC) enum_font_cb2,
+ (LPARAM) lpef);
+}
+
+
+DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 3, 0,
+ "Return a list of the names of available fonts matching PATTERN.\n\
+If optional arguments FACE and FRAME are specified, return only fonts\n\
+the same size as FACE on FRAME.\n\
+\n\
+PATTERN is a string, perhaps with wildcard characters;\n\
+ the * character matches any substring, and\n\
+ the ? character matches any single character.\n\
+ PATTERN is case-insensitive.\n\
+FACE is a face name--a symbol.\n\
+\n\
+The return value is a list of strings, suitable as arguments to\n\
+set-face-font.\n\
+\n\
+Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
+even if they match PATTERN and FACE.")
+ (pattern, face, frame)
+ Lisp_Object pattern, face, frame;
+{
+ int num_fonts;
+ char **names;
+ XFontStruct *info;
+ XFontStruct *size_ref;
+ Lisp_Object namelist;
+ Lisp_Object list;
+ FRAME_PTR f;
+ enumfont_t ef;
+
+ CHECK_STRING (pattern, 0);
+ if (!NILP (face))
+ CHECK_SYMBOL (face, 1);
+
+ f = check_x_frame (frame);
+
+ /* Determine the width standard for comparison with the fonts we find. */
+
+ if (NILP (face))
+ size_ref = 0;
+ else
+ {
+ int face_id;
+
+ /* Don't die if we get called with a terminal frame. */
+ if (! FRAME_WIN32_P (f))
+ error ("non-win32 frame used in `x-list-fonts'");
+
+ face_id = face_name_id_number (f, face);
+
+ if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
+ || FRAME_PARAM_FACES (f) [face_id] == 0)
+ size_ref = f->output_data.win32->font;
+ else
+ {
+ size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
+ if (size_ref == (XFontStruct *) (~0))
+ size_ref = f->output_data.win32->font;
+ }
+ }
+
+ /* See if we cached the result for this particular query. */
+ list = Fassoc (pattern,
+ XCONS (FRAME_WIN32_DISPLAY_INFO (f)->name_list_element)->cdr);
+
+ /* We have info in the cache for this PATTERN. */
+ if (!NILP (list))
+ {
+ Lisp_Object tem, newlist;
+
+ /* We have info about this pattern. */
+ list = XCONS (list)->cdr;
+
+ if (size_ref == 0)
+ return list;
+
+ BLOCK_INPUT;
+
+ /* Filter the cached info and return just the fonts that match FACE. */
+ newlist = Qnil;
+ for (tem = list; CONSP (tem); tem = XCONS (tem)->cdr)
+ {
+ XFontStruct *thisinfo;
+
+ thisinfo = win32_load_font (FRAME_WIN32_DISPLAY_INFO (f), XSTRING (XCONS (tem)->car)->data);
+
+ if (thisinfo && same_size_fonts (thisinfo, size_ref))
+ newlist = Fcons (XCONS (tem)->car, newlist);
+
+ win32_unload_font (FRAME_WIN32_DISPLAY_INFO (f), thisinfo);
+ }
+
+ UNBLOCK_INPUT;
+
+ return newlist;
+ }
+
+ BLOCK_INPUT;
+
+ namelist = Qnil;
+ ef.pattern = &pattern;
+ ef.tail = ef.head = &namelist;
+ ef.numFonts = 0;
+
+ {
+ ef.hdc = my_get_dc (FRAME_WIN32_WINDOW (f));
+
+ EnumFontFamilies (ef.hdc, NULL, (FONTENUMPROC) enum_font_cb1, (LPARAM)&ef);
+
+ ReleaseDC (FRAME_WIN32_WINDOW (f), ef.hdc);
+ }
+
+ UNBLOCK_INPUT;
+
+ if (ef.numFonts)
+ {
+ int i;
+ Lisp_Object cur;
+
+ /* Make a list of all the fonts we got back.
+ Store that in the font cache for the display. */
+ XCONS (FRAME_WIN32_DISPLAY_INFO (f)->name_list_element)->cdr
+ = Fcons (Fcons (pattern, namelist),
+ XCONS (FRAME_WIN32_DISPLAY_INFO (f)->name_list_element)->cdr);
+
+ /* Make a list of the fonts that have the right width. */
+ list = Qnil;
+ cur=namelist;
+ for (i = 0; i < ef.numFonts; i++)
+ {
+ int keeper;
+
+ if (!size_ref)
+ keeper = 1;
+ else
+ {
+ XFontStruct *thisinfo;
+
+ BLOCK_INPUT;
+ thisinfo = win32_load_font (FRAME_WIN32_DISPLAY_INFO (f), XSTRING (Fcar (cur))->data);
+
+ keeper = thisinfo && same_size_fonts (thisinfo, size_ref);
+
+ win32_unload_font (FRAME_WIN32_DISPLAY_INFO (f), thisinfo);
+
+ UNBLOCK_INPUT;
+ }
+ if (keeper)
+ list = Fcons (build_string (XSTRING (Fcar (cur))->data), list);
+
+ cur = Fcdr (cur);
+ }
+ list = Fnreverse (list);
+ }
+
+ return list;
+}
+\f
+DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 2, 0,
+ "Return non-nil if color COLOR is supported on frame FRAME.\n\
+If FRAME is omitted or nil, use the selected frame.")
+ (color, frame)
+ Lisp_Object color, frame;
+{
+ COLORREF foo;
+ FRAME_PTR f = check_x_frame (frame);
+
+ CHECK_STRING (color, 1);
+
+ if (defined_color (f, XSTRING (color)->data, &foo, 0))
+ return Qt;
+ else
+ return Qnil;
+}
+
+DEFUN ("x-color-values", Fx_color_values, Sx_color_values, 1, 2, 0,
+ "Return a description of the color named COLOR on frame FRAME.\n\
+The value is a list of integer RGB values--(RED GREEN BLUE).\n\
+These values appear to range from 0 to 65280 or 65535, depending\n\
+on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
+If FRAME is omitted or nil, use the selected frame.")
+ (color, frame)
+ Lisp_Object color, frame;
+{
+ COLORREF foo;
+ FRAME_PTR f = check_x_frame (frame);
+
+ CHECK_STRING (color, 1);
+
+ if (defined_color (f, XSTRING (color)->data, &foo, 0))
+ {
+ Lisp_Object rgb[3];
+
+ rgb[0] = make_number (GetRValue (foo));
+ rgb[1] = make_number (GetGValue (foo));
+ rgb[2] = make_number (GetBValue (foo));
+ return Flist (3, rgb);
+ }
+ else
+ return Qnil;
+}
+
+DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 1, 0,
+ "Return t if the X display supports color.\n\
+The optional argument DISPLAY specifies which display to ask about.\n\
+DISPLAY should be either a frame or a display name (a string).\n\
+If omitted or nil, that stands for the selected frame's display.")
+ (display)
+ Lisp_Object display;
+{
+ struct win32_display_info *dpyinfo = check_x_display_info (display);
+
+ if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2)
+ return Qnil;
+
+ return Qt;
+}
+
+DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
+ 0, 1, 0,
+ "Return t if the X display supports shades of gray.\n\
+Note that color displays do support shades of gray.\n\
+The optional argument DISPLAY specifies which display to ask about.\n\
+DISPLAY should be either a frame or a display name (a string).\n\
+If omitted or nil, that stands for the selected frame's display.")
+ (display)
+ Lisp_Object display;
+{
+ struct win32_display_info *dpyinfo = check_x_display_info (display);
+
+ if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1)
+ return Qnil;
+
+ return Qt;
+}
+
+DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
+ 0, 1, 0,
+ "Returns the width in pixels of the X display DISPLAY.\n\
+The optional argument DISPLAY specifies which display to ask about.\n\
+DISPLAY should be either a frame or a display name (a string).\n\
+If omitted or nil, that stands for the selected frame's display.")
+ (display)
+ Lisp_Object display;
+{
+ struct win32_display_info *dpyinfo = check_x_display_info (display);
+
+ return make_number (dpyinfo->width);
+}
+
+DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
+ Sx_display_pixel_height, 0, 1, 0,
+ "Returns the height in pixels of the X display DISPLAY.\n\
+The optional argument DISPLAY specifies which display to ask about.\n\
+DISPLAY should be either a frame or a display name (a string).\n\
+If omitted or nil, that stands for the selected frame's display.")
+ (display)
+ Lisp_Object display;
+{
+ struct win32_display_info *dpyinfo = check_x_display_info (display);
+
+ return make_number (dpyinfo->height);
+}
+
+DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
+ 0, 1, 0,
+ "Returns the number of bitplanes of the display DISPLAY.\n\
+The optional argument DISPLAY specifies which display to ask about.\n\
+DISPLAY should be either a frame or a display name (a string).\n\
+If omitted or nil, that stands for the selected frame's display.")
+ (display)
+ Lisp_Object display;
+{
+ struct win32_display_info *dpyinfo = check_x_display_info (display);
+
+ return make_number (dpyinfo->n_planes * dpyinfo->n_cbits);
+}
+
+DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
+ 0, 1, 0,
+ "Returns the number of color cells of the display DISPLAY.\n\
+The optional argument DISPLAY specifies which display to ask about.\n\
+DISPLAY should be either a frame or a display name (a string).\n\
+If omitted or nil, that stands for the selected frame's display.")
+ (display)
+ Lisp_Object display;
+{
+ struct win32_display_info *dpyinfo = check_x_display_info (display);
+ HDC hdc;
+ int cap;
+
+ hdc = my_get_dc (dpyinfo->root_window);
+
+ cap = GetDeviceCaps (hdc,NUMCOLORS);
+
+ ReleaseDC (dpyinfo->root_window, hdc);
+
+ return make_number (cap);
+}
+
+DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
+ Sx_server_max_request_size,
+ 0, 1, 0,
+ "Returns the maximum request size of the server of display DISPLAY.\n\
+The optional argument DISPLAY specifies which display to ask about.\n\
+DISPLAY should be either a frame or a display name (a string).\n\
+If omitted or nil, that stands for the selected frame's display.")
+ (display)
+ Lisp_Object display;
+{
+ struct win32_display_info *dpyinfo = check_x_display_info (display);
+
+ return make_number (1);
+}
+
+DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
+ "Returns the vendor ID string of the Win32 system (Microsoft).\n\
+The optional argument DISPLAY specifies which display to ask about.\n\
+DISPLAY should be either a frame or a display name (a string).\n\
+If omitted or nil, that stands for the selected frame's display.")
+ (display)
+ Lisp_Object display;
+{
+ struct win32_display_info *dpyinfo = check_x_display_info (display);
+ char *vendor = "Microsoft Corp.";
+
+ if (! vendor) vendor = "";
+ return build_string (vendor);
+}
+
+DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
+ "Returns the version numbers of the server of display DISPLAY.\n\
+The value is a list of three integers: the major and minor\n\
+version numbers, and the vendor-specific release\n\
+number. See also the function `x-server-vendor'.\n\n\
+The optional argument DISPLAY specifies which display to ask about.\n\
+DISPLAY should be either a frame or a display name (a string).\n\
+If omitted or nil, that stands for the selected frame's display.")
+ (display)
+ Lisp_Object display;
+{
+ struct win32_display_info *dpyinfo = check_x_display_info (display);
+
+ return Fcons (make_number (nt_major_version),
+ Fcons (make_number (nt_minor_version), Qnil));
+}
+
+DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
+ "Returns the number of screens on the server of display DISPLAY.\n\
+The optional argument DISPLAY specifies which display to ask about.\n\
+DISPLAY should be either a frame or a display name (a string).\n\
+If omitted or nil, that stands for the selected frame's display.")
+ (display)
+ Lisp_Object display;
+{
+ struct win32_display_info *dpyinfo = check_x_display_info (display);
+
+ return make_number (1);
+}
+
+DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
+ "Returns the height in millimeters of the X display DISPLAY.\n\
+The optional argument DISPLAY specifies which display to ask about.\n\
+DISPLAY should be either a frame or a display name (a string).\n\
+If omitted or nil, that stands for the selected frame's display.")
+ (display)
+ Lisp_Object display;
+{
+ struct win32_display_info *dpyinfo = check_x_display_info (display);
+ HDC hdc;
+ int cap;
+
+ hdc = my_get_dc (dpyinfo->root_window);
+
+ cap = GetDeviceCaps (hdc, VERTSIZE);
+
+ ReleaseDC (dpyinfo->root_window, hdc);
+
+ return make_number (cap);
+}
+
+DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
+ "Returns the width in millimeters of the X display DISPLAY.\n\
+The optional argument DISPLAY specifies which display to ask about.\n\
+DISPLAY should be either a frame or a display name (a string).\n\
+If omitted or nil, that stands for the selected frame's display.")
+ (display)
+ Lisp_Object display;
+{
+ struct win32_display_info *dpyinfo = check_x_display_info (display);
+
+ HDC hdc;
+ int cap;
+
+ hdc = my_get_dc (dpyinfo->root_window);
+
+ cap = GetDeviceCaps (hdc, HORZSIZE);
+
+ ReleaseDC (dpyinfo->root_window, hdc);
+
+ return make_number (cap);
+}
+
+DEFUN ("x-display-backing-store", Fx_display_backing_store,
+ Sx_display_backing_store, 0, 1, 0,
+ "Returns an indication of whether display DISPLAY does backing store.\n\
+The value may be `always', `when-mapped', or `not-useful'.\n\
+The optional argument DISPLAY specifies which display to ask about.\n\
+DISPLAY should be either a frame or a display name (a string).\n\
+If omitted or nil, that stands for the selected frame's display.")
+ (display)
+ Lisp_Object display;
+{
+ return intern ("not-useful");
+}
+
+DEFUN ("x-display-visual-class", Fx_display_visual_class,
+ Sx_display_visual_class, 0, 1, 0,
+ "Returns the visual class of the display DISPLAY.\n\
+The value is one of the symbols `static-gray', `gray-scale',\n\
+`static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
+The optional argument DISPLAY specifies which display to ask about.\n\
+DISPLAY should be either a frame or a display name (a string).\n\
+If omitted or nil, that stands for the selected frame's display.")
+ (display)
+ Lisp_Object display;
+{
+ struct win32_display_info *dpyinfo = check_x_display_info (display);
+
+#if 0
+ switch (dpyinfo->visual->class)
+ {
+ case StaticGray: return (intern ("static-gray"));
+ case GrayScale: return (intern ("gray-scale"));
+ case StaticColor: return (intern ("static-color"));
+ case PseudoColor: return (intern ("pseudo-color"));
+ case TrueColor: return (intern ("true-color"));
+ case DirectColor: return (intern ("direct-color"));
+ default:
+ error ("Display has an unknown visual class");
+ }
+#endif
+
+ error ("Display has an unknown visual class");
+}
+
+DEFUN ("x-display-save-under", Fx_display_save_under,
+ Sx_display_save_under, 0, 1, 0,
+ "Returns t if the display DISPLAY supports the save-under feature.\n\
+The optional argument DISPLAY specifies which display to ask about.\n\
+DISPLAY should be either a frame or a display name (a string).\n\
+If omitted or nil, that stands for the selected frame's display.")
+ (display)
+ Lisp_Object display;
+{
+ struct win32_display_info *dpyinfo = check_x_display_info (display);
+
+ return Qnil;
+}
+\f
+int
+x_pixel_width (f)
+ register struct frame *f;
+{
+ return PIXEL_WIDTH (f);
+}
+
+int
+x_pixel_height (f)
+ register struct frame *f;
+{
+ return PIXEL_HEIGHT (f);
+}
+
+int
+x_char_width (f)
+ register struct frame *f;
+{
+ return FONT_WIDTH (f->output_data.win32->font);
+}
+
+int
+x_char_height (f)
+ register struct frame *f;
+{
+ return f->output_data.win32->line_height;
+}
+
+int
+x_screen_planes (frame)
+ Lisp_Object frame;
+{
+ return (FRAME_WIN32_DISPLAY_INFO (XFRAME (frame))->n_planes *
+ FRAME_WIN32_DISPLAY_INFO (XFRAME (frame))->n_cbits);
+}
+\f
+/* Return the display structure for the display named NAME.
+ Open a new connection if necessary. */
+
+struct win32_display_info *
+x_display_info_for_name (name)
+ Lisp_Object name;
+{
+ Lisp_Object names;
+ struct win32_display_info *dpyinfo;
+
+ CHECK_STRING (name, 0);
+
+ for (dpyinfo = &one_win32_display_info, names = win32_display_name_list;
+ dpyinfo;
+ dpyinfo = dpyinfo->next, names = XCONS (names)->cdr)
+ {
+ Lisp_Object tem;
+ tem = Fstring_equal (XCONS (XCONS (names)->car)->car, name);
+ if (!NILP (tem))
+ return dpyinfo;
+ }
+
+ /* Use this general default value to start with. */
+ Vx_resource_name = Vinvocation_name;
+
+ validate_x_resource_name ();
+
+ dpyinfo = win32_term_init (name, (unsigned char *)0,
+ (char *) XSTRING (Vx_resource_name)->data);
+
+ if (dpyinfo == 0)
+ error ("Cannot connect to server %s", XSTRING (name)->data);
+
+ XSETFASTINT (Vwindow_system_version, 3);
+
+ return dpyinfo;
+}
+
+DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
+ 1, 3, 0, "Open a connection to a server.\n\
+DISPLAY is the name of the display to connect to.\n\
+Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
+If the optional third arg MUST-SUCCEED is non-nil,\n\
+terminate Emacs if we can't open the connection.")
+ (display, xrm_string, must_succeed)
+ Lisp_Object display, xrm_string, must_succeed;
+{
+ unsigned int n_planes;
+ unsigned char *xrm_option;
+ struct win32_display_info *dpyinfo;
+
+ CHECK_STRING (display, 0);
+ if (! NILP (xrm_string))
+ CHECK_STRING (xrm_string, 1);
+
+ Vwin32_color_map = Fwin32_default_color_map ();
+
+ if (! NILP (xrm_string))
+ xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
+ else
+ xrm_option = (unsigned char *) 0;
+
+ /* Use this general default value to start with. */
+ Vx_resource_name = Vinvocation_name;
+
+ validate_x_resource_name ();
+
+ /* This is what opens the connection and sets x_current_display.
+ This also initializes many symbols, such as those used for input. */
+ dpyinfo = win32_term_init (display, xrm_option,
+ (char *) XSTRING (Vx_resource_name)->data);
+
+ if (dpyinfo == 0)
+ {
+ if (!NILP (must_succeed))
+ fatal ("Cannot connect to server %s.\n",
+ XSTRING (display)->data);
+ else
+ error ("Cannot connect to server %s", XSTRING (display)->data);
+ }
+
+ XSETFASTINT (Vwindow_system_version, 3);
+ return Qnil;
+}
+
+DEFUN ("x-close-connection", Fx_close_connection,
+ Sx_close_connection, 1, 1, 0,
+ "Close the connection to DISPLAY's server.\n\
+For DISPLAY, specify either a frame or a display name (a string).\n\
+If DISPLAY is nil, that stands for the selected frame's display.")
+ (display)
+ Lisp_Object display;
+{
+ struct win32_display_info *dpyinfo = check_x_display_info (display);
+ struct win32_display_info *tail;
+ int i;
+
+ if (dpyinfo->reference_count > 0)
+ error ("Display still has frames on it");
+
+ BLOCK_INPUT;
+ /* Free the fonts in the font table. */
+ for (i = 0; i < dpyinfo->n_fonts; i++)
+ {
+ if (dpyinfo->font_table[i].name)
+ free (dpyinfo->font_table[i].name);
+ /* Don't free the full_name string;
+ it is always shared with something else. */
+ win32_unload_font (dpyinfo, dpyinfo->font_table[i].font);
+ }
+ x_destroy_all_bitmaps (dpyinfo);
+
+ x_delete_display (dpyinfo);
+ UNBLOCK_INPUT;
+
+ return Qnil;
+}
+
+DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
+ "Return the list of display names that Emacs has connections to.")
+ ()
+{
+ Lisp_Object tail, result;
+
+ result = Qnil;
+ for (tail = win32_display_name_list; ! NILP (tail); tail = XCONS (tail)->cdr)
+ result = Fcons (XCONS (XCONS (tail)->car)->car, result);
+
+ return result;
+}
+
+DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
+ "If ON is non-nil, report errors as soon as the erring request is made.\n\
+If ON is nil, allow buffering of requests.\n\
+This is a noop on Win32 systems.\n\
+The optional second argument DISPLAY specifies which display to act on.\n\
+DISPLAY should be either a frame or a display name (a string).\n\
+If DISPLAY is omitted or nil, that stands for the selected frame's display.")
+ (on, display)
+ Lisp_Object display, on;
+{
+ struct win32_display_info *dpyinfo = check_x_display_info (display);
+
+ return Qnil;
+}
+
+\f
+/* These are the win32 specialized functions */
+
+DEFUN ("win32-select-font", Fwin32_select_font, Swin32_select_font, 0, 1, 0,
+ "This will display the Win32 font dialog and return an X font string corresponding to the selection.")
+ (frame)
+ Lisp_Object frame;
+{
+ FRAME_PTR f = check_x_frame (frame);
+ CHOOSEFONT cf;
+ LOGFONT lf;
+ char buf[100];
+
+ bzero (&cf, sizeof (cf));
+
+ cf.lStructSize = sizeof (cf);
+ cf.hwndOwner = FRAME_WIN32_WINDOW (f);
+ cf.Flags = CF_FIXEDPITCHONLY | CF_FORCEFONTEXIST | CF_SCREENFONTS;
+ cf.lpLogFont = &lf;
+
+ if (!ChooseFont (&cf) || !win32_to_x_font (&lf, buf, 100))
+ return Qnil;
+
+ return build_string (buf);
+}
+
+\f
+syms_of_win32fns ()
+{
+ /* The section below is built by the lisp expression at the top of the file,
+ just above where these variables are declared. */
+ /*&&& init symbols here &&&*/
+ Qauto_raise = intern ("auto-raise");
+ staticpro (&Qauto_raise);
+ Qauto_lower = intern ("auto-lower");
+ staticpro (&Qauto_lower);
+ Qbackground_color = intern ("background-color");
+ staticpro (&Qbackground_color);
+ Qbar = intern ("bar");
+ staticpro (&Qbar);
+ Qborder_color = intern ("border-color");
+ staticpro (&Qborder_color);
+ Qborder_width = intern ("border-width");
+ staticpro (&Qborder_width);
+ Qbox = intern ("box");
+ staticpro (&Qbox);
+ Qcursor_color = intern ("cursor-color");
+ staticpro (&Qcursor_color);
+ Qcursor_type = intern ("cursor-type");
+ staticpro (&Qcursor_type);
+ Qfont = intern ("font");
+ staticpro (&Qfont);
+ Qforeground_color = intern ("foreground-color");
+ staticpro (&Qforeground_color);
+ Qgeometry = intern ("geometry");
+ staticpro (&Qgeometry);
+ Qicon_left = intern ("icon-left");
+ staticpro (&Qicon_left);
+ Qicon_top = intern ("icon-top");
+ staticpro (&Qicon_top);
+ Qicon_type = intern ("icon-type");
+ staticpro (&Qicon_type);
+ Qicon_name = intern ("icon-name");
+ staticpro (&Qicon_name);
+ Qinternal_border_width = intern ("internal-border-width");
+ staticpro (&Qinternal_border_width);
+ Qleft = intern ("left");
+ staticpro (&Qleft);
+ Qmouse_color = intern ("mouse-color");
+ staticpro (&Qmouse_color);
+ Qnone = intern ("none");
+ staticpro (&Qnone);
+ Qparent_id = intern ("parent-id");
+ staticpro (&Qparent_id);
+ Qscroll_bar_width = intern ("scroll-bar-width");
+ staticpro (&Qscroll_bar_width);
+ Qsuppress_icon = intern ("suppress-icon");
+ staticpro (&Qsuppress_icon);
+ Qtop = intern ("top");
+ staticpro (&Qtop);
+ Qundefined_color = intern ("undefined-color");
+ staticpro (&Qundefined_color);
+ Qvertical_scroll_bars = intern ("vertical-scroll-bars");
+ staticpro (&Qvertical_scroll_bars);
+ Qvisibility = intern ("visibility");
+ staticpro (&Qvisibility);
+ Qwindow_id = intern ("window-id");
+ staticpro (&Qwindow_id);
+ Qx_frame_parameter = intern ("x-frame-parameter");
+ staticpro (&Qx_frame_parameter);
+ Qx_resource_name = intern ("x-resource-name");
+ staticpro (&Qx_resource_name);
+ Quser_position = intern ("user-position");
+ staticpro (&Quser_position);
+ Quser_size = intern ("user-size");
+ staticpro (&Quser_size);
+ Qdisplay = intern ("display");
+ staticpro (&Qdisplay);
+ /* This is the end of symbol initialization. */
+
+ Fput (Qundefined_color, Qerror_conditions,
+ Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
+ Fput (Qundefined_color, Qerror_message,
+ build_string ("Undefined color"));
+
+ DEFVAR_LISP ("win32-color-map", &Vwin32_color_map,
+ "A array of color name mappings for windows.");
+ Vwin32_color_map = Qnil;
+
+ init_x_parm_symbols ();
+
+ DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
+ "List of directories to search for bitmap files for win32.");
+ Vx_bitmap_file_path = decode_env_path ((char *) 0, "PATH");
+
+ DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
+ "The shape of the pointer when over text.\n\
+Changing the value does not affect existing frames\n\
+unless you set the mouse color.");
+ Vx_pointer_shape = Qnil;
+
+ DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
+ "The name Emacs uses to look up resources; for internal use only.\n\
+`x-get-resource' uses this as the first component of the instance name\n\
+when requesting resource values.\n\
+Emacs initially sets `x-resource-name' to the name under which Emacs\n\
+was invoked, or to the value specified with the `-name' or `-rn'\n\
+switches, if present.");
+ Vx_resource_name = Qnil;
+
+ Vx_nontext_pointer_shape = Qnil;
+
+ Vx_mode_pointer_shape = Qnil;
+
+ DEFVAR_INT ("x-sensitive-text-pointer-shape",
+ &Vx_sensitive_text_pointer_shape,
+ "The shape of the pointer when over mouse-sensitive text.\n\
+This variable takes effect when you create a new frame\n\
+or when you set the mouse color.");
+ Vx_sensitive_text_pointer_shape = Qnil;
+
+ DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
+ "A string indicating the foreground color of the cursor box.");
+ Vx_cursor_fore_pixel = Qnil;
+
+ DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
+ "Non-nil if no window manager is in use.\n\
+Emacs doesn't try to figure this out; this is always nil\n\
+unless you set it to something else.");
+ /* We don't have any way to find this out, so set it to nil
+ and maybe the user would like to set it to t. */
+ Vx_no_window_manager = Qnil;
+
+ defsubr (&Sx_get_resource);
+ defsubr (&Sx_list_fonts);
+ defsubr (&Sx_display_color_p);
+ defsubr (&Sx_display_grayscale_p);
+ defsubr (&Sx_color_defined_p);
+ defsubr (&Sx_color_values);
+ defsubr (&Sx_server_max_request_size);
+ defsubr (&Sx_server_vendor);
+ defsubr (&Sx_server_version);
+ defsubr (&Sx_display_pixel_width);
+ defsubr (&Sx_display_pixel_height);
+ defsubr (&Sx_display_mm_width);
+ defsubr (&Sx_display_mm_height);
+ defsubr (&Sx_display_screens);
+ defsubr (&Sx_display_planes);
+ defsubr (&Sx_display_color_cells);
+ defsubr (&Sx_display_visual_class);
+ defsubr (&Sx_display_backing_store);
+ defsubr (&Sx_display_save_under);
+ defsubr (&Sx_parse_geometry);
+ defsubr (&Sx_create_frame);
+ defsubr (&Sfocus_frame);
+ defsubr (&Sunfocus_frame);
+ defsubr (&Sx_open_connection);
+ defsubr (&Sx_close_connection);
+ defsubr (&Sx_display_list);
+ defsubr (&Sx_synchronize);
+
+ /* Win32 specific functions */
+
+ defsubr (&Swin32_select_font);
+}
+
+#undef abort
+
+void
+win32_abort()
+{
+ MessageBox (NULL,
+ "A fatal error has occurred - aborting!",
+ "Emacs Abort Dialog",
+ MB_OK|MB_ICONEXCLAMATION);
+ abort();
+}
--- /dev/null
+/* Definitions and headers for communication with Win32 GUI.
+ Copyright (C) 1995 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs; see the file COPYING. If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#ifndef __WIN32_H__
+#define __WIN32_H__
+
+#include <windows.h>
+
+typedef struct W32FontStruct {
+ TEXTMETRIC tm;
+ HFONT hfont;
+} W32FontStruct;
+
+typedef HBITMAP Pixmap;
+typedef HBITMAP Bitmap;
+typedef struct W32FontStruct XFontStruct;
+typedef HDC GC;
+typedef COLORREF Color;
+typedef DWORD Time;
+typedef HWND Window;
+typedef HCURSOR Cursor;
+
+#define FACE_DEFAULT (~0)
+
+extern HINSTANCE hinst;
+extern HINSTANCE hprevinst;
+extern LPSTR lpCmdLine;
+extern int nCmdShow;
+
+/* Bit Gravity */
+
+#define ForgetGravity 0
+#define NorthWestGravity 1
+#define NorthGravity 2
+#define NorthEastGravity 3
+#define WestGravity 4
+#define CenterGravity 5
+#define EastGravity 6
+#define SouthWestGravity 7
+#define SouthGravity 8
+#define SouthEastGravity 9
+#define StaticGravity 10
+
+#define NoValue 0x0000
+#define XValue 0x0001
+#define YValue 0x0002
+#define WidthValue 0x0004
+#define HeightValue 0x0008
+#define AllValues 0x000F
+#define XNegative 0x0010
+#define YNegative 0x0020
+
+#define USPosition (1L << 0) /* user specified x, y */
+#define USSize (1L << 1) /* user specified width, height */
+
+#define PPosition (1L << 2) /* program specified position */
+#define PSize (1L << 3) /* program specified size */
+#define PMinSize (1L << 4) /* program specified minimum size */
+#define PMaxSize (1L << 5) /* program specified maximum size */
+#define PResizeInc (1L << 6) /* program specified resize increments */
+#define PAspect (1L << 7) /* program specified min and max aspect ratios */
+#define PBaseSize (1L << 8) /* program specified base for incrementing */
+#define PWinGravity (1L << 9) /* program specified window gravity */
+
+extern int XParseGeometry ();
+
+#endif
--- /dev/null
+/* X Communication module for terminals which understand the X protocol.
+ Copyright (C) 1986, 1988, 1993, 1994 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs; see the file COPYING. If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+/* Written by Kevin Gallo. */
+
+#include <signal.h>
+#include <config.h>
+
+#include <stdio.h>
+#include "lisp.h"
+#include "termhooks.h"
+#include "frame.h"
+#include "window.h"
+#include "keyboard.h"
+#include "blockinput.h"
+
+/* This may include sys/types.h, and that somehow loses
+ if this is not done before the other system files. */
+#include "w32term.h"
+
+/* Load sys/types.h if not already loaded.
+ In some systems loading it twice is suicidal. */
+#ifndef makedev
+#include <sys/types.h>
+#endif
+
+#include "dispextern.h"
+
+#define min(x, y) (((x) < (y)) ? (x) : (y))
+#define max(x, y) (((x) > (y)) ? (x) : (y))
+
+typedef struct menu_map
+{
+ Lisp_Object menu_items;
+ int menu_items_allocated;
+ int menu_items_used;
+} menu_map;
+
+extern Lisp_Object Qmenu_enable;
+extern Lisp_Object Qmenu_bar;
+
+static Lisp_Object win32_dialog_show ();
+static Lisp_Object win32menu_show ();
+
+static HMENU keymap_panes ();
+static HMENU single_keymap_panes ();
+static HMENU list_of_panes ();
+static HMENU list_of_items ();
+
+static HMENU create_menu_items ();
+
+/* Initialize the menu_items structure if we haven't already done so.
+ Also mark it as currently empty. */
+
+static void
+init_menu_items (lpmm)
+ menu_map * lpmm;
+{
+ if (NILP (lpmm->menu_items))
+ {
+ lpmm->menu_items_allocated = 60;
+ lpmm->menu_items = Fmake_vector (make_number (lpmm->menu_items_allocated),
+ Qnil);
+ }
+
+ lpmm->menu_items_used = 0;
+}
+
+/* Call when finished using the data for the current menu
+ in menu_items. */
+
+static void
+discard_menu_items (lpmm)
+ menu_map * lpmm;
+{
+ lpmm->menu_items = Qnil;
+ lpmm->menu_items_allocated = lpmm->menu_items_used = 0;
+}
+
+/* Make the menu_items vector twice as large. */
+
+static void
+grow_menu_items (lpmm)
+ menu_map * lpmm;
+{
+ Lisp_Object new;
+ int old_size = lpmm->menu_items_allocated;
+
+ lpmm->menu_items_allocated *= 2;
+ new = Fmake_vector (make_number (lpmm->menu_items_allocated), Qnil);
+ bcopy (XVECTOR (lpmm->menu_items)->contents, XVECTOR (new)->contents,
+ old_size * sizeof (Lisp_Object));
+
+ lpmm->menu_items = new;
+}
+
+/* Indicate boundary between left and right. */
+
+static void
+add_left_right_boundary (hmenu)
+ HMENU hmenu;
+{
+ AppendMenu (hmenu, MF_MENUBARBREAK, 0, NULL);
+}
+
+/* Push one menu item into the current pane.
+ NAME is the string to display. ENABLE if non-nil means
+ this item can be selected. KEY is the key generated by
+ choosing this item. EQUIV is the textual description
+ of the keyboard equivalent for this item (or nil if none). */
+
+static void
+add_menu_item (lpmm, hmenu, name, enable, key)
+ menu_map * lpmm;
+ HMENU hmenu;
+ Lisp_Object name;
+ UINT enable;
+ Lisp_Object key;
+{
+ UINT fuFlags;
+
+ if (NILP (name)
+ || ((char *) XSTRING (name)->data)[0] == 0
+ || strcmp ((char *) XSTRING (name)->data, "--") == 0)
+ fuFlags = MF_SEPARATOR;
+ else if (enable)
+ fuFlags = MF_STRING;
+ else
+ fuFlags = MF_STRING | MF_GRAYED;
+
+ AppendMenu (hmenu,
+ fuFlags,
+ lpmm->menu_items_used + 1,
+ (fuFlags == MF_SEPARATOR)?NULL: (char *) XSTRING (name)->data);
+
+ lpmm->menu_items_used++;
+#if 0
+ if (lpmm->menu_items_used >= lpmm->menu_items_allocated)
+ grow_menu_items (lpmm);
+
+ XSET (XVECTOR (lpmm->menu_items)->contents[lpmm->menu_items_used++],
+ Lisp_Cons,
+ key);
+#endif
+}
+\f
+/* Figure out the current keyboard equivalent of a menu item ITEM1.
+ The item string for menu display should be ITEM_STRING.
+ Store the equivalent keyboard key sequence's
+ textual description into *DESCRIP_PTR.
+ Also cache them in the item itself.
+ Return the real definition to execute. */
+
+static Lisp_Object
+menu_item_equiv_key (item_string, item1, descrip_ptr)
+ Lisp_Object item_string;
+ Lisp_Object item1;
+ Lisp_Object *descrip_ptr;
+{
+ /* This is the real definition--the function to run. */
+ Lisp_Object def;
+ /* This is the sublist that records cached equiv key data
+ so we can save time. */
+ Lisp_Object cachelist;
+ /* These are the saved equivalent keyboard key sequence
+ and its key-description. */
+ Lisp_Object savedkey, descrip;
+ Lisp_Object def1;
+ int changed = 0;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+
+ /* If a help string follows the item string, skip it. */
+ if (CONSP (XCONS (item1)->cdr)
+ && STRINGP (XCONS (XCONS (item1)->cdr)->car))
+ item1 = XCONS (item1)->cdr;
+
+ def = Fcdr (item1);
+
+ /* Get out the saved equivalent-keyboard-key info. */
+ cachelist = savedkey = descrip = Qnil;
+ if (CONSP (def) && CONSP (XCONS (def)->car)
+ && (NILP (XCONS (XCONS (def)->car)->car)
+ || VECTORP (XCONS (XCONS (def)->car)->car)))
+ {
+ cachelist = XCONS (def)->car;
+ def = XCONS (def)->cdr;
+ savedkey = XCONS (cachelist)->car;
+ descrip = XCONS (cachelist)->cdr;
+ }
+
+ GCPRO4 (def, def1, savedkey, descrip);
+
+ /* Is it still valid? */
+ def1 = Qnil;
+ if (!NILP (savedkey))
+ def1 = Fkey_binding (savedkey, Qnil);
+ /* If not, update it. */
+ if (! EQ (def1, def)
+ /* If the command is an alias for another
+ (such as easymenu.el and lmenu.el set it up),
+ check if the original command matches the cached command. */
+ && !(SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function)
+ && EQ (def1, XSYMBOL (def)->function))
+ /* If something had no key binding before, don't recheck it--
+ doing that takes too much time and makes menus too slow. */
+ && !(!NILP (cachelist) && NILP (savedkey)))
+ {
+ changed = 1;
+ descrip = Qnil;
+ savedkey = Fwhere_is_internal (def, Qnil, Qt, Qnil);
+ /* If the command is an alias for another
+ (such as easymenu.el and lmenu.el set it up),
+ see if the original command name has equivalent keys. */
+ if (SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function))
+ savedkey = Fwhere_is_internal (XSYMBOL (def)->function,
+ Qnil, Qt, Qnil);
+
+ if (VECTORP (savedkey)
+ && EQ (XVECTOR (savedkey)->contents[0], Qmenu_bar))
+ savedkey = Qnil;
+ if (!NILP (savedkey))
+ {
+ descrip = Fkey_description (savedkey);
+ descrip = concat2 (make_string (" (", 3), descrip);
+ descrip = concat2 (descrip, make_string (")", 1));
+ }
+ }
+
+ /* Cache the data we just got in a sublist of the menu binding. */
+ if (NILP (cachelist))
+ XCONS (item1)->cdr = Fcons (Fcons (savedkey, descrip), def);
+ else if (changed)
+ {
+ XCONS (cachelist)->car = savedkey;
+ XCONS (cachelist)->cdr = descrip;
+ }
+
+ UNGCPRO;
+ *descrip_ptr = descrip;
+ return def;
+}
+
+/* This is used as the handler when calling internal_condition_case_1. */
+
+static Lisp_Object
+menu_item_enabled_p_1 (arg)
+ Lisp_Object arg;
+{
+ return Qnil;
+}
+
+/* Return non-nil if the command DEF is enabled when used as a menu item.
+ This is based on looking for a menu-enable property.
+ If NOTREAL is set, don't bother really computing this. */
+
+static Lisp_Object
+menu_item_enabled_p (def, notreal)
+ Lisp_Object def;
+{
+ Lisp_Object enabled, tem;
+
+ enabled = Qt;
+ if (notreal)
+ return enabled;
+ if (XTYPE (def) == Lisp_Symbol)
+ {
+ /* No property, or nil, means enable.
+ Otherwise, enable if value is not nil. */
+ tem = Fget (def, Qmenu_enable);
+ if (!NILP (tem))
+ /* (condition-case nil (eval tem)
+ (error nil)) */
+ enabled = internal_condition_case_1 (Feval, tem, Qerror,
+ menu_item_enabled_p_1);
+ }
+ return enabled;
+}
+\f
+/* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
+ and generate menu panes for them in menu_items.
+ If NOTREAL is nonzero,
+ don't bother really computing whether an item is enabled. */
+
+static HMENU
+keymap_panes (lpmm, keymaps, nmaps, notreal)
+ menu_map * lpmm;
+ Lisp_Object *keymaps;
+ int nmaps;
+ int notreal;
+{
+ int mapno;
+
+ // init_menu_items (lpmm);
+
+ if (nmaps > 1)
+ {
+ HMENU hmenu;
+
+ if (!notreal)
+ {
+ hmenu = CreateMenu ();
+
+ if (!hmenu) return (NULL);
+ }
+ else
+ {
+ hmenu = NULL;
+ }
+
+ /* Loop over the given keymaps, making a pane for each map.
+ But don't make a pane that is empty--ignore that map instead.
+ P is the number of panes we have made so far. */
+ for (mapno = 0; mapno < nmaps; mapno++)
+ {
+ HMENU new_hmenu;
+
+ new_hmenu = single_keymap_panes (lpmm, keymaps[mapno],
+ Qnil, Qnil, notreal);
+
+ if (!notreal && new_hmenu)
+ {
+ AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, "");
+ }
+ }
+
+ return (hmenu);
+ }
+ else
+ {
+ return (single_keymap_panes (lpmm, keymaps[0], Qnil, Qnil, notreal));
+ }
+}
+
+/* This is a recursive subroutine of keymap_panes.
+ It handles one keymap, KEYMAP.
+ The other arguments are passed along
+ or point to local variables of the previous function.
+ If NOTREAL is nonzero,
+ don't bother really computing whether an item is enabled. */
+
+HMENU
+single_keymap_panes (lpmm, keymap, pane_name, prefix, notreal)
+ menu_map * lpmm;
+ Lisp_Object keymap;
+ Lisp_Object pane_name;
+ Lisp_Object prefix;
+ int notreal;
+{
+ Lisp_Object pending_maps;
+ Lisp_Object tail, item, item1, item_string, table;
+ HMENU hmenu;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+
+ if (!notreal)
+ {
+ hmenu = CreateMenu ();
+ if (hmenu == NULL) return NULL;
+ }
+ else
+ {
+ hmenu = NULL;
+ }
+
+ pending_maps = Qnil;
+
+ for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
+ {
+ /* Look at each key binding, and if it has a menu string,
+ make a menu item from it. */
+
+ item = XCONS (tail)->car;
+
+ if (CONSP (item))
+ {
+ item1 = XCONS (item)->cdr;
+
+ if (XTYPE (item1) == Lisp_Cons)
+ {
+ item_string = XCONS (item1)->car;
+ if (XTYPE (item_string) == Lisp_String)
+ {
+ /* This is the real definition--the function to run. */
+
+ Lisp_Object def;
+
+ /* These are the saved equivalent keyboard key sequence
+ and its key-description. */
+
+ Lisp_Object descrip;
+ Lisp_Object tem, enabled;
+
+ /* GCPRO because ...enabled_p will call eval
+ and ..._equiv_key may autoload something.
+ Protecting KEYMAP preserves everything we use;
+ aside from that, must protect whatever might be
+ a string. Since there's no GCPRO5, we refetch
+ item_string instead of protecting it. */
+
+ descrip = def = Qnil;
+ GCPRO4 (keymap, pending_maps, def, prefix);
+
+ def = menu_item_equiv_key (item_string, item1, &descrip);
+ enabled = menu_item_enabled_p (def, notreal);
+
+ UNGCPRO;
+
+ item_string = XCONS (item1)->car;
+
+ tem = Fkeymapp (def);
+ if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
+ {
+ pending_maps = Fcons (Fcons (def,
+ Fcons (item_string,
+ XCONS (item)->car)),
+ pending_maps);
+ }
+ else
+ {
+ Lisp_Object submap;
+
+ GCPRO4 (keymap, pending_maps, item, item_string);
+
+ submap = get_keymap_1 (def, 0, 1);
+
+ UNGCPRO;
+
+ if (NILP (submap))
+ {
+ if (!notreal)
+ {
+ add_menu_item (lpmm,
+ hmenu,
+ item_string,
+ !NILP (enabled),
+ Fcons (XCONS (item)->car, prefix));
+ }
+ }
+ else
+ /* Display a submenu. */
+ {
+ HMENU new_hmenu = single_keymap_panes (lpmm,
+ submap,
+ item_string,
+ XCONS (item)->car,
+ notreal);
+
+ if (!notreal)
+ {
+ AppendMenu (hmenu, MF_POPUP,
+ (UINT)new_hmenu,
+ (char *) XSTRING (item_string)->data);
+ }
+ }
+ }
+ }
+ }
+ }
+ else if (VECTORP (item))
+ {
+ /* Loop over the char values represented in the vector. */
+ int len = XVECTOR (item)->size;
+ int c;
+ for (c = 0; c < len; c++)
+ {
+ Lisp_Object character;
+ XSETFASTINT (character, c);
+ item1 = XVECTOR (item)->contents[c];
+ if (CONSP (item1))
+ {
+ item_string = XCONS (item1)->car;
+ if (STRINGP (item_string))
+ {
+ Lisp_Object def;
+
+ /* These are the saved equivalent keyboard key sequence
+ and its key-description. */
+ Lisp_Object descrip;
+ Lisp_Object tem, enabled;
+
+ /* GCPRO because ...enabled_p will call eval
+ and ..._equiv_key may autoload something.
+ Protecting KEYMAP preserves everything we use;
+ aside from that, must protect whatever might be
+ a string. Since there's no GCPRO5, we refetch
+ item_string instead of protecting it. */
+ GCPRO4 (keymap, pending_maps, def, descrip);
+ descrip = def = Qnil;
+
+ def = menu_item_equiv_key (item_string, item1, &descrip);
+ enabled = menu_item_enabled_p (def, notreal);
+
+ UNGCPRO;
+
+ item_string = XCONS (item1)->car;
+
+ tem = Fkeymapp (def);
+ if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
+ pending_maps = Fcons (Fcons (def, Fcons (item_string, character)),
+ pending_maps);
+ else
+ {
+ Lisp_Object submap;
+
+ GCPRO4 (keymap, pending_maps, descrip, item_string);
+
+ submap = get_keymap_1 (def, 0, 1);
+
+ UNGCPRO;
+
+ if (NILP (submap))
+ {
+ if (!notreal)
+ {
+ add_menu_item (lpmm,
+ hmenu,
+ item_string,
+ !NILP (enabled),
+ character);
+ }
+ }
+ else
+ /* Display a submenu. */
+ {
+ HMENU new_hmenu = single_keymap_panes (lpmm,
+ submap,
+ Qnil,
+ character,
+ notreal);
+
+ if (!notreal)
+ {
+ AppendMenu (hmenu,MF_POPUP,
+ (UINT)new_hmenu,
+ (char *)XSTRING (item_string)->data);
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+
+ /* Process now any submenus which want to be panes at this level. */
+ while (!NILP (pending_maps))
+ {
+ Lisp_Object elt, eltcdr, string;
+ elt = Fcar (pending_maps);
+ eltcdr = XCONS (elt)->cdr;
+ string = XCONS (eltcdr)->car;
+ /* We no longer discard the @ from the beginning of the string here.
+ Instead, we do this in win32menu_show. */
+ {
+ HMENU new_hmenu = single_keymap_panes (lpmm,
+ Fcar (elt),
+ string,
+ XCONS (eltcdr)->cdr, notreal);
+
+ if (!notreal)
+ {
+ AppendMenu (hmenu, MF_POPUP,
+ (UINT)new_hmenu,
+ (char *) XSTRING (string)->data);
+ }
+ }
+
+ pending_maps = Fcdr (pending_maps);
+ }
+
+ return (hmenu);
+}
+\f
+/* Push all the panes and items of a menu decsribed by the
+ alist-of-alists MENU.
+ This handles old-fashioned calls to x-popup-menu. */
+
+static HMENU
+list_of_panes (lpmm, menu)
+ menu_map * lpmm;
+ Lisp_Object menu;
+{
+ Lisp_Object tail;
+ HMENU hmenu;
+
+ hmenu = CreateMenu ();
+ if (hmenu == NULL) return NULL;
+
+ // init_menu_items (lpmm);
+
+ for (tail = menu; !NILP (tail); tail = Fcdr (tail))
+ {
+ Lisp_Object elt, pane_name, pane_data;
+ HMENU new_hmenu;
+
+ elt = Fcar (tail);
+ pane_name = Fcar (elt);
+ CHECK_STRING (pane_name, 0);
+ pane_data = Fcdr (elt);
+ CHECK_CONS (pane_data, 0);
+
+ new_hmenu = list_of_items (lpmm, pane_data);
+ if (new_hmenu == NULL) goto error;
+
+ AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu,
+ (char *) XSTRING (pane_name)->data);
+ }
+
+ return (hmenu);
+
+ error:
+ DestroyMenu (hmenu);
+
+ return (NULL);
+}
+
+/* Push the items in a single pane defined by the alist PANE. */
+
+static HMENU
+list_of_items (lpmm, pane)
+ menu_map * lpmm;
+ Lisp_Object pane;
+{
+ Lisp_Object tail, item, item1;
+ HMENU hmenu;
+
+ hmenu = CreateMenu ();
+ if (hmenu == NULL) return NULL;
+
+ for (tail = pane; !NILP (tail); tail = Fcdr (tail))
+ {
+ item = Fcar (tail);
+ if (STRINGP (item))
+ add_menu_item (lpmm, hmenu, item, Qnil, Qnil);
+ else if (NILP (item))
+ add_left_right_boundary ();
+ else
+ {
+ CHECK_CONS (item, 0);
+ item1 = Fcar (item);
+ CHECK_STRING (item1, 1);
+ add_menu_item (lpmm, hmenu, item1, Qt, Fcdr (item));
+ }
+ }
+
+ return (hmenu);
+}
+\f
+
+HMENU
+create_menu_items (lpmm, menu, notreal)
+ menu_map * lpmm;
+ Lisp_Object menu;
+ int notreal;
+{
+ Lisp_Object title;
+ Lisp_Object keymap, tem;
+ HMENU hmenu;
+
+ title = Qnil;
+
+ /* Decode the menu items from what was specified. */
+
+ keymap = Fkeymapp (menu);
+ tem = Qnil;
+ if (XTYPE (menu) == Lisp_Cons)
+ tem = Fkeymapp (Fcar (menu));
+
+ if (!NILP (keymap))
+ {
+ /* We were given a keymap. Extract menu info from the keymap. */
+ Lisp_Object prompt;
+ keymap = get_keymap (menu);
+
+ /* Extract the detailed info to make one pane. */
+ hmenu = keymap_panes (lpmm, &keymap, 1, notreal);
+
+#if 0
+ /* Search for a string appearing directly as an element of the keymap.
+ That string is the title of the menu. */
+ prompt = map_prompt (keymap);
+
+ /* Make that be the pane title of the first pane. */
+ if (!NILP (prompt) && menu_items_n_panes >= 0)
+ XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
+#endif
+ }
+ else if (!NILP (tem))
+ {
+ /* We were given a list of keymaps. */
+ int nmaps = XFASTINT (Flength (menu));
+ Lisp_Object *maps
+ = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
+ int i;
+
+ title = Qnil;
+
+ /* The first keymap that has a prompt string
+ supplies the menu title. */
+ for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem))
+ {
+ Lisp_Object prompt;
+
+ maps[i++] = keymap = get_keymap (Fcar (tem));
+#if 0
+ prompt = map_prompt (keymap);
+ if (NILP (title) && !NILP (prompt))
+ title = prompt;
+#endif
+ }
+
+ /* Extract the detailed info to make one pane. */
+ hmenu = keymap_panes (lpmm, maps, nmaps, notreal);
+
+#if 0
+ /* Make the title be the pane title of the first pane. */
+ if (!NILP (title) && menu_items_n_panes >= 0)
+ XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
+#endif
+ }
+ else
+ {
+ /* We were given an old-fashioned menu. */
+ title = Fcar (menu);
+ CHECK_STRING (title, 1);
+
+ hmenu = list_of_panes (lpmm, Fcdr (menu));
+ }
+
+ return (hmenu);
+}
+
+/* This is a recursive subroutine of keymap_panes.
+ It handles one keymap, KEYMAP.
+ The other arguments are passed along
+ or point to local variables of the previous function.
+ If NOTREAL is nonzero,
+ don't bother really computing whether an item is enabled. */
+
+Lisp_Object
+get_single_keymap_event (keymap, lpnum)
+ Lisp_Object keymap;
+ int * lpnum;
+{
+ Lisp_Object pending_maps;
+ Lisp_Object tail, item, item1, item_string, table;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+
+ pending_maps = Qnil;
+
+ for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
+ {
+ /* Look at each key binding, and if it has a menu string,
+ make a menu item from it. */
+
+ item = XCONS (tail)->car;
+
+ if (XTYPE (item) == Lisp_Cons)
+ {
+ item1 = XCONS (item)->cdr;
+
+ if (CONSP (item1))
+ {
+ item_string = XCONS (item1)->car;
+ if (XTYPE (item_string) == Lisp_String)
+ {
+ /* This is the real definition--the function to run. */
+
+ Lisp_Object def;
+
+ /* These are the saved equivalent keyboard key sequence
+ and its key-description. */
+
+ Lisp_Object descrip;
+ Lisp_Object tem, enabled;
+
+ /* GCPRO because ...enabled_p will call eval
+ and ..._equiv_key may autoload something.
+ Protecting KEYMAP preserves everything we use;
+ aside from that, must protect whatever might be
+ a string. Since there's no GCPRO5, we refetch
+ item_string instead of protecting it. */
+
+ descrip = def = Qnil;
+ GCPRO3 (keymap, pending_maps, def);
+
+ def = menu_item_equiv_key (item_string, item1, &descrip);
+
+ UNGCPRO;
+
+ item_string = XCONS (item1)->car;
+
+ tem = Fkeymapp (def);
+ if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
+ {
+ pending_maps = Fcons (Fcons (def,
+ Fcons (item_string,
+ XCONS (item)->car)),
+ pending_maps);
+ }
+ else
+ {
+ Lisp_Object submap;
+
+ GCPRO4 (keymap, pending_maps, item, item_string);
+
+ submap = get_keymap_1 (def, 0, 1);
+
+ UNGCPRO;
+
+ if (NILP (submap))
+ {
+ if (--(*lpnum) == 0)
+ {
+ return (Fcons (XCONS (item)->car, Qnil));
+ }
+ }
+ else
+ /* Display a submenu. */
+ {
+ Lisp_Object event = get_single_keymap_event (submap,
+ lpnum);
+
+ if (*lpnum <= 0)
+ {
+ if (!NILP (XCONS (item)->car))
+ event = Fcons (XCONS (item)->car, event);
+
+ return (event);
+ }
+ }
+ }
+ }
+ }
+ }
+ else if (VECTORP (item))
+ {
+ /* Loop over the char values represented in the vector. */
+ int len = XVECTOR (item)->size;
+ int c;
+ for (c = 0; c < len; c++)
+ {
+ Lisp_Object character;
+ XSETFASTINT (character, c);
+ item1 = XVECTOR (item)->contents[c];
+ if (XTYPE (item1) == Lisp_Cons)
+ {
+ item_string = XCONS (item1)->car;
+ if (XTYPE (item_string) == Lisp_String)
+ {
+ Lisp_Object def;
+
+ /* These are the saved equivalent keyboard key sequence
+ and its key-description. */
+ Lisp_Object descrip;
+ Lisp_Object tem, enabled;
+
+ /* GCPRO because ...enabled_p will call eval
+ and ..._equiv_key may autoload something.
+ Protecting KEYMAP preserves everything we use;
+ aside from that, must protect whatever might be
+ a string. Since there's no GCPRO5, we refetch
+ item_string instead of protecting it. */
+ GCPRO4 (keymap, pending_maps, def, descrip);
+ descrip = def = Qnil;
+
+ def = menu_item_equiv_key (item_string, item1, &descrip);
+
+ UNGCPRO;
+
+ item_string = XCONS (item1)->car;
+
+ tem = Fkeymapp (def);
+ if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
+ pending_maps = Fcons (Fcons (def, Fcons (item_string, character)),
+ pending_maps);
+ else
+ {
+ Lisp_Object submap;
+
+ GCPRO4 (keymap, pending_maps, descrip, item_string);
+
+ submap = get_keymap_1 (def, 0, 1);
+
+ UNGCPRO;
+
+ if (NILP (submap))
+ {
+ if (--(*lpnum) == 0)
+ {
+ return (Fcons (character, Qnil));
+ }
+ }
+ else
+ /* Display a submenu. */
+ {
+ Lisp_Object event = get_single_keymap_event (submap,
+ lpnum);
+
+ if (*lpnum <= 0)
+ {
+ if (!NILP (character))
+ event = Fcons (character, event);
+
+ return (event);
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+
+ /* Process now any submenus which want to be panes at this level. */
+ while (!NILP (pending_maps))
+ {
+ Lisp_Object elt, eltcdr, string;
+ elt = Fcar (pending_maps);
+ eltcdr = XCONS (elt)->cdr;
+ string = XCONS (eltcdr)->car;
+ /* We no longer discard the @ from the beginning of the string here.
+ Instead, we do this in win32menu_show. */
+ {
+ Lisp_Object event = get_single_keymap_event (Fcar (elt), lpnum);
+
+ if (*lpnum <= 0)
+ {
+ if (!NILP (XCONS (eltcdr)->cdr))
+ event = Fcons (XCONS (eltcdr)->cdr, event);
+
+ return (event);
+ }
+ }
+
+ pending_maps = Fcdr (pending_maps);
+ }
+
+ return (Qnil);
+}
+
+/* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
+ and generate menu panes for them in menu_items.
+ If NOTREAL is nonzero,
+ don't bother really computing whether an item is enabled. */
+
+static Lisp_Object
+get_keymap_event (keymaps, nmaps, lpnum)
+ Lisp_Object *keymaps;
+ int nmaps;
+ int * lpnum;
+{
+ int mapno;
+ Lisp_Object event = Qnil;
+
+ /* Loop over the given keymaps, making a pane for each map.
+ But don't make a pane that is empty--ignore that map instead.
+ P is the number of panes we have made so far. */
+ for (mapno = 0; mapno < nmaps; mapno++)
+ {
+ event = get_single_keymap_event (keymaps[mapno], lpnum);
+
+ if (*lpnum <= 0) break;
+ }
+
+ return (event);
+}
+
+static Lisp_Object
+get_list_of_items_event (pane, lpnum)
+ Lisp_Object pane;
+ int * lpnum;
+{
+ Lisp_Object tail, item, item1;
+
+ for (tail = pane; !NILP (tail); tail = Fcdr (tail))
+ {
+ item = Fcar (tail);
+ if (STRINGP (item))
+ {
+ if (-- (*lpnum) == 0)
+ {
+ return (Qnil);
+ }
+ }
+ else if (!NILP (item))
+ {
+ if (--(*lpnum) == 0)
+ {
+ CHECK_CONS (item, 0);
+ return (Fcdr (item));
+ }
+ }
+ }
+
+ return (Qnil);
+}
+
+/* Push all the panes and items of a menu decsribed by the
+ alist-of-alists MENU.
+ This handles old-fashioned calls to x-popup-menu. */
+
+static Lisp_Object
+get_list_of_panes_event (menu, lpnum)
+ Lisp_Object menu;
+ int * lpnum;
+{
+ Lisp_Object tail;
+
+ for (tail = menu; !NILP (tail); tail = Fcdr (tail))
+ {
+ Lisp_Object elt, pane_name, pane_data;
+ Lisp_Object event;
+
+ elt = Fcar (tail);
+ pane_data = Fcdr (elt);
+ CHECK_CONS (pane_data, 0);
+
+ event = get_list_of_items_event (pane_data, lpnum);
+
+ if (*lpnum <= 0)
+ {
+ return (event);
+ }
+ }
+
+ return (Qnil);
+}
+
+Lisp_Object
+get_menu_event (menu, lpnum)
+ Lisp_Object menu;
+ int * lpnum;
+{
+ Lisp_Object keymap, tem;
+ Lisp_Object event;
+
+ /* Decode the menu items from what was specified. */
+
+ keymap = Fkeymapp (menu);
+ tem = Qnil;
+ if (XTYPE (menu) == Lisp_Cons)
+ tem = Fkeymapp (Fcar (menu));
+
+ if (!NILP (keymap))
+ {
+ keymap = get_keymap (menu);
+
+ event = get_keymap_event (menu, 1, lpnum);
+ }
+ else if (!NILP (tem))
+ {
+ /* We were given a list of keymaps. */
+ int nmaps = XFASTINT (Flength (menu));
+ Lisp_Object *maps
+ = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
+ int i;
+
+ /* The first keymap that has a prompt string
+ supplies the menu title. */
+ for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem))
+ {
+ Lisp_Object prompt;
+
+ maps[i++] = keymap = get_keymap (Fcar (tem));
+ }
+
+ event = get_keymap_event (maps, nmaps, lpnum);
+ }
+ else
+ {
+ /* We were given an old-fashioned menu. */
+ event = get_list_of_panes_event (Fcdr (menu), lpnum);
+ }
+
+ return (event);
+}
+
+DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
+ "Pop up a deck-of-cards menu and return user's selection.\n\
+POSITION is a position specification. This is either a mouse button event\n\
+or a list ((XOFFSET YOFFSET) WINDOW)\n\
+where XOFFSET and YOFFSET are positions in pixels from the top left\n\
+corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
+This controls the position of the center of the first line\n\
+in the first pane of the menu, not the top left of the menu as a whole.\n\
+If POSITION is t, it means to use the current mouse position.\n\
+\n\
+MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
+The menu items come from key bindings that have a menu string as well as\n\
+a definition; actually, the \"definition\" in such a key binding looks like\n\
+\(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
+the keymap as a top-level element.\n\n\
+You can also use a list of keymaps as MENU.\n\
+ Then each keymap makes a separate pane.\n\
+When MENU is a keymap or a list of keymaps, the return value\n\
+is a list of events.\n\n\
+Alternatively, you can specify a menu of multiple panes\n\
+ with a list of the form (TITLE PANE1 PANE2...),\n\
+where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
+Each ITEM is normally a cons cell (STRING . VALUE);\n\
+but a string can appear as an item--that makes a nonselectable line\n\
+in the menu.\n\
+With this form of menu, the return value is VALUE from the chosen item.\n\
+\n\
+If POSITION is nil, don't display the menu at all, just precalculate the\n\
+cached information about equivalent key sequences.")
+ (position, menu)
+ Lisp_Object position, menu;
+{
+ int number_of_panes, panes;
+ Lisp_Object keymap, tem;
+ int xpos, ypos;
+ Lisp_Object title;
+ char *error_name;
+ Lisp_Object selection;
+ int i, j;
+ FRAME_PTR f;
+ Lisp_Object x, y, window;
+ int keymaps = 0;
+ int menubarp = 0;
+ struct gcpro gcpro1;
+ HMENU hmenu;
+ menu_map mm;
+
+ if (! NILP (position))
+ {
+ /* Decode the first argument: find the window and the coordinates. */
+ if (EQ (position, Qt))
+ {
+ /* Use the mouse's current position. */
+ FRAME_PTR new_f = 0;
+ Lisp_Object bar_window;
+ int part;
+ unsigned long time;
+
+ if (mouse_position_hook)
+ (*mouse_position_hook) (&new_f, &bar_window, &part, &x, &y, &time);
+ if (new_f != 0)
+ XSETFRAME (window, new_f);
+ else
+ {
+ window = selected_window;
+ XSETFASTINT (x, 0);
+ XSETFASTINT (y, 0);
+ }
+ }
+ else
+ {
+ tem = Fcar (position);
+ if (CONSP (tem))
+ {
+ window = Fcar (Fcdr (position));
+ x = Fcar (tem);
+ y = Fcar (Fcdr (tem));
+ }
+ else
+ {
+ tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
+ window = Fcar (tem); /* POSN_WINDOW (tem) */
+ tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
+ x = Fcar (tem);
+ y = Fcdr (tem);
+
+ /* Determine whether this menu is handling a menu bar click. */
+ tem = Fcar (Fcdr (Fcar (Fcdr (position))));
+ if (CONSP (tem) && EQ (Fcar (tem), Qmenu_bar))
+ menubarp = 1;
+ }
+ }
+
+ CHECK_NUMBER (x, 0);
+ CHECK_NUMBER (y, 0);
+
+ /* Decode where to put the menu. */
+
+ if (FRAMEP (window))
+ {
+ f = XFRAME (window);
+
+ xpos = 0;
+ ypos = 0;
+ }
+ else if (WINDOWP (window))
+ {
+ CHECK_LIVE_WINDOW (window, 0);
+ f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
+
+ xpos = (FONT_WIDTH (f->output_data.win32->font) * XWINDOW (window)->left);
+ ypos = (f->output_data.win32->line_height * XWINDOW (window)->top);
+ }
+ else
+ /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
+ but I don't want to make one now. */
+ CHECK_WINDOW (window, 0);
+
+ xpos += XINT (x);
+ ypos += XINT (y);
+ }
+
+ title = Qnil;
+ GCPRO1 (title);
+
+ discard_menu_items (&mm);
+ hmenu = create_menu_items (&mm, menu, NILP (position));
+
+ if (NILP (position))
+ {
+ discard_menu_items (&mm);
+ UNGCPRO;
+ return Qnil;
+ }
+
+ /* Display them in a menu. */
+ BLOCK_INPUT;
+
+ selection = win32menu_show (f, xpos, ypos, menu, &hmenu, &error_name);
+
+ UNBLOCK_INPUT;
+
+ discard_menu_items (&mm);
+ DestroyMenu (hmenu);
+
+ UNGCPRO;
+
+ if (error_name) error (error_name);
+ return selection;
+}
+
+DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
+ "Pop up a dialog box and return user's selection.\n\
+POSITION specifies which frame to use.\n\
+This is normally a mouse button event or a window or frame.\n\
+If POSITION is t, it means to use the frame the mouse is on.\n\
+The dialog box appears in the middle of the specified frame.\n\
+\n\
+CONTENTS specifies the alternatives to display in the dialog box.\n\
+It is a list of the form (TITLE ITEM1 ITEM2...).\n\
+Each ITEM is a cons cell (STRING . VALUE).\n\
+The return value is VALUE from the chosen item.\n\n\
+An ITEM may also be just a string--that makes a nonselectable item.\n\
+An ITEM may also be nil--that means to put all preceding items\n\
+on the left of the dialog box and all following items on the right.\n\
+\(By default, approximately half appear on each side.)")
+ (position, contents)
+ Lisp_Object position, contents;
+{
+ FRAME_PTR f;
+ Lisp_Object window;
+
+ /* Decode the first argument: find the window or frame to use. */
+ if (EQ (position, Qt))
+ {
+ /* Decode the first argument: find the window and the coordinates. */
+ if (EQ (position, Qt))
+ window = selected_window;
+ }
+ else if (CONSP (position))
+ {
+ Lisp_Object tem;
+ tem = Fcar (position);
+ if (XTYPE (tem) == Lisp_Cons)
+ window = Fcar (Fcdr (position));
+ else
+ {
+ tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
+ window = Fcar (tem); /* POSN_WINDOW (tem) */
+ }
+ }
+ else if (WINDOWP (position) || FRAMEP (position))
+ window = position;
+
+ /* Decode where to put the menu. */
+
+ if (FRAMEP (window))
+ f = XFRAME (window);
+ else if (WINDOWP (window))
+ {
+ CHECK_LIVE_WINDOW (window, 0);
+ f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
+ }
+ else
+ /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
+ but I don't want to make one now. */
+ CHECK_WINDOW (window, 0);
+
+#if 1
+ /* Display a menu with these alternatives
+ in the middle of frame F. */
+ {
+ Lisp_Object x, y, frame, newpos;
+ XSETFRAME (frame, f);
+ XSETINT (x, x_pixel_width (f) / 2);
+ XSETINT (y, x_pixel_height (f) / 2);
+ newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
+
+ return Fx_popup_menu (newpos,
+ Fcons (Fcar (contents), Fcons (contents, Qnil)));
+ }
+#else
+ {
+ Lisp_Object title;
+ char *error_name;
+ Lisp_Object selection;
+
+ /* Decode the dialog items from what was specified. */
+ title = Fcar (contents);
+ CHECK_STRING (title, 1);
+
+ list_of_panes (Fcons (contents, Qnil));
+
+ /* Display them in a dialog box. */
+ BLOCK_INPUT;
+ selection = win32_dialog_show (f, 0, 0, title, &error_name);
+ UNBLOCK_INPUT;
+
+ discard_menu_items ();
+
+ if (error_name) error (error_name);
+ return selection;
+ }
+#endif
+}
+
+Lisp_Object
+get_frame_menubar_event (f, num)
+ FRAME_PTR f;
+ int num;
+{
+ Lisp_Object tail, items;
+ int i;
+ struct gcpro gcpro1;
+
+ BLOCK_INPUT;
+
+ GCPRO1 (items);
+
+ if (NILP (items = FRAME_MENU_BAR_ITEMS (f)))
+ items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
+
+ for (i = 0; i < XVECTOR (items)->size; i += 3)
+ {
+ Lisp_Object event;
+
+ event = get_menu_event (XVECTOR (items)->contents[i + 2], &num);
+
+ if (num <= 0)
+ {
+ UNGCPRO;
+ UNBLOCK_INPUT;
+ return (Fcons (XVECTOR (items)->contents[i], event));
+ }
+ }
+
+ UNGCPRO;
+ UNBLOCK_INPUT;
+
+ return (Qnil);
+}
+
+void
+set_frame_menubar (f, first_time)
+ FRAME_PTR f;
+ int first_time;
+{
+ Lisp_Object tail, items;
+ HMENU hmenu;
+ int i;
+ struct gcpro gcpro1;
+ menu_map mm;
+
+ BLOCK_INPUT;
+
+ GCPRO1 (items);
+
+ if (NILP (items = FRAME_MENU_BAR_ITEMS (f)))
+ items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
+
+ hmenu = CreateMenu ();
+
+ if (!hmenu) goto error;
+
+ discard_menu_items (&mm);
+
+ for (i = 0; i < XVECTOR (items)->size; i += 3)
+ {
+ Lisp_Object string;
+ int keymaps;
+ CHAR *error;
+ HMENU new_hmenu;
+
+ string = XVECTOR (items)->contents[i + 1];
+ if (NILP (string))
+ break;
+
+ new_hmenu = create_menu_items (&mm,
+ XVECTOR (items)->contents[i + 2],
+ 0);
+
+ if (!new_hmenu)
+ continue;
+
+ AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu,
+ (char *) XSTRING (string)->data);
+ }
+
+ {
+ HMENU old = GetMenu (FRAME_WIN32_WINDOW (f));
+ SetMenu (FRAME_WIN32_WINDOW (f), hmenu);
+ DestroyMenu (old);
+ }
+
+ error:
+ UNGCPRO;
+ UNBLOCK_INPUT;
+}
+
+void
+free_frame_menubar (f)
+ FRAME_PTR f;
+{
+ BLOCK_INPUT;
+
+ {
+ HMENU old = GetMenu (FRAME_WIN32_WINDOW (f));
+ SetMenu (FRAME_WIN32_WINDOW (f), NULL);
+ DestroyMenu (old);
+ }
+
+ UNBLOCK_INPUT;
+}
+/* Called from Fwin32_create_frame to create the inital menubar of a frame
+ before it is mapped, so that the window is mapped with the menubar already
+ there instead of us tacking it on later and thrashing the window after it
+ is visible. */
+void
+initialize_frame_menubar (f)
+ FRAME_PTR f;
+{
+ set_frame_menubar (f, 1);
+}
+\f
+#if 0
+/* If the mouse has moved to another menu bar item,
+ return 1 and unread a button press event for that item.
+ Otherwise return 0. */
+
+static int
+check_mouse_other_menu_bar (f)
+ FRAME_PTR f;
+{
+ FRAME_PTR new_f;
+ Lisp_Object bar_window;
+ int part;
+ Lisp_Object x, y;
+ unsigned long time;
+
+ (*mouse_position_hook) (&new_f, &bar_window, &part, &x, &y, &time);
+
+ if (f == new_f && other_menu_bar_item_p (f, x, y))
+ {
+ unread_menu_bar_button (f, x);
+ return 1;
+ }
+
+ return 0;
+}
+#endif
+\f
+
+#if 0
+static HMENU
+create_menu (keymaps, error)
+ int keymaps;
+ char **error;
+{
+ HMENU hmenu = NULL; /* the menu we are currently working on */
+ HMENU first_hmenu = NULL;
+
+ HMENU *submenu_stack = (HMENU *) alloca (menu_items_used * sizeof (HMENU));
+ Lisp_Object *subprefix_stack = (Lisp_Object *) alloca (menu_items_used *
+ sizeof (Lisp_Object));
+ int submenu_depth = 0;
+ int i;
+
+ if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
+ {
+ *error = "Empty menu";
+ return NULL;
+ }
+
+ i = 0;
+
+ /* Loop over all panes and items, filling in the tree. */
+
+ while (i < menu_items_used)
+ {
+ if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
+ {
+ submenu_stack[submenu_depth++] = hmenu;
+ i++;
+ }
+ else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
+ {
+ hmenu = submenu_stack[--submenu_depth];
+ i++;
+ }
+#if 0
+else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
+ && submenu_depth != 0)
+ i += MENU_ITEMS_PANE_LENGTH;
+#endif
+ /* Ignore a nil in the item list.
+ It's meaningful only for dialog boxes. */
+else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
+ i += 1;
+else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
+ {
+ /* Create a new pane. */
+
+ Lisp_Object pane_name;
+ char *pane_string;
+
+ pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
+ pane_string = (NILP (pane_name) ? "" : (char *) XSTRING (pane_name)->data);
+
+ if (!hmenu || strcmp (pane_string, ""))
+ {
+ HMENU new_hmenu = CreateMenu ();
+
+ if (!new_hmenu)
+ {
+ *error = "Could not create menu pane";
+ goto error;
+ }
+
+ if (hmenu)
+ {
+ AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, pane_string);
+ }
+
+ hmenu = new_hmenu;
+
+ if (!first_hmenu) first_hmenu = hmenu;
+ }
+ i += MENU_ITEMS_PANE_LENGTH;
+ }
+else
+ {
+ /* Create a new item within current pane. */
+
+ Lisp_Object item_name, enable, descrip;
+ UINT fuFlags;
+
+ item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
+ enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
+ // descrip = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
+
+ if (((char *) XSTRING (item_name)->data)[0] == 0
+ || strcmp ((char *) XSTRING (item_name)->data, "--") == 0)
+ fuFlags = MF_SEPARATOR;
+ else if (NILP (enable) || !XUINT(enable))
+ fuFlags = MF_STRING | MF_GRAYED;
+ else
+ fuFlags = MF_STRING;
+
+ AppendMenu (hmenu,
+ fuFlags,
+ i,
+ (char *) XSTRING (item_name)->data);
+
+ // if (!NILP (descrip))
+ // hmenu->key = (char *) XSTRING (descrip)->data;
+
+ i += MENU_ITEMS_ITEM_LENGTH;
+ }
+}
+
+ return (first_hmenu);
+
+ error:
+ if (first_hmenu) DestroyMenu (first_hmenu);
+ return (NULL);
+}
+
+#endif
+
+/* win32menu_show actually displays a menu using the panes and items in
+ menu_items and returns the value selected from it.
+ There are two versions of win32menu_show, one for Xt and one for Xlib.
+ Both assume input is blocked by the caller. */
+
+/* F is the frame the menu is for.
+ X and Y are the frame-relative specified position,
+ relative to the inside upper left corner of the frame F.
+ MENUBARP is 1 if the click that asked for this menu came from the menu bar.
+ KEYMAPS is 1 if this menu was specified with keymaps;
+ in that case, we return a list containing the chosen item's value
+ and perhaps also the pane's prefix.
+ TITLE is the specified menu title.
+ ERROR is a place to store an error message string in case of failure.
+ (We return nil on failure, but the value doesn't actually matter.) */
+
+
+static Lisp_Object
+win32menu_show (f, x, y, menu, hmenu, error)
+ FRAME_PTR f;
+ int x;
+ int y;
+ Lisp_Object menu;
+ HMENU hmenu;
+ char **error;
+{
+ int i , menu_selection;
+ POINT pos;
+
+ *error = NULL;
+
+ if (!hmenu)
+ {
+ *error = "Empty menu";
+ return Qnil;
+ }
+
+ pos.x = x;
+ pos.y = y;
+
+ /* Offset the coordinates to root-relative. */
+ ClientToScreen (FRAME_WIN32_WINDOW (f), &pos);
+
+#if 0
+ /* If the mouse moves out of the menu before we show the menu,
+ don't show it at all. */
+ if (check_mouse_other_menu_bar (f))
+ {
+ DestroyMenu (hmenu);
+ return Qnil;
+ }
+#endif
+
+ /* Display the menu. */
+ menu_selection = TrackPopupMenu (hmenu,
+ 0x10,
+ pos.x, pos.y,
+ 0,
+ FRAME_WIN32_WINDOW (f),
+ NULL);
+ if (menu_selection == -1)
+ {
+ *error = "Invalid menu specification";
+ return Qnil;
+ }
+
+ /* Find the selected item, and its pane, to return
+ the proper value. */
+
+#if 1
+ if (menu_selection > 0)
+ {
+ return get_menu_event (menu, menu_selection);
+ }
+#else
+ if (menu_selection > 0 && menu_selection <= lpmm->menu_items_used)
+ {
+ return (XVECTOR (lpmm->menu_items)->contents[menu_selection - 1]);
+ }
+#endif
+
+ return Qnil;
+}
+
+#if 0
+static char * button_names [] =
+{
+ "button1", "button2", "button3", "button4", "button5",
+ "button6", "button7", "button8", "button9", "button10"
+};
+
+static Lisp_Object
+win32_dialog_show (f, menubarp, keymaps, title, error)
+ FRAME_PTR f;
+ int menubarp;
+ int keymaps;
+ Lisp_Object title;
+ char **error;
+{
+ int i, nb_buttons=0;
+ HMENU hmenu;
+ char dialog_name[6];
+
+ /* Number of elements seen so far, before boundary. */
+ int left_count = 0;
+ /* 1 means we've seen the boundary between left-hand elts and right-hand. */
+ int boundary_seen = 0;
+
+ *error = NULL;
+
+ if (menu_items_n_panes > 1)
+ {
+ *error = "Multiple panes in dialog box";
+ return Qnil;
+ }
+
+ /* Create a tree of widget_value objects
+ representing the text label and buttons. */
+ {
+ Lisp_Object pane_name, prefix;
+ char *pane_string;
+ pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
+ prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
+ pane_string = (NILP (pane_name)
+ ? "" : (char *) XSTRING (pane_name)->data);
+ prev_wv = malloc_widget_value ();
+ prev_wv->value = pane_string;
+ if (keymaps && !NILP (prefix))
+ prev_wv->name++;
+ prev_wv->enabled = 1;
+ prev_wv->name = "message";
+ first_wv = prev_wv;
+
+ /* Loop over all panes and items, filling in the tree. */
+ i = MENU_ITEMS_PANE_LENGTH;
+ while (i < menu_items_used)
+ {
+
+ /* Create a new item within current pane. */
+ Lisp_Object item_name, enable, descrip;
+ item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
+ enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
+ descrip
+ = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
+
+ if (NILP (item_name))
+ {
+ free_menubar_widget_value_tree (first_wv);
+ *error = "Submenu in dialog items";
+ return Qnil;
+ }
+ if (EQ (item_name, Qquote))
+ {
+ /* This is the boundary between left-side elts
+ and right-side elts. Stop incrementing right_count. */
+ boundary_seen = 1;
+ i++;
+ continue;
+ }
+ if (nb_buttons >= 10)
+ {
+ free_menubar_widget_value_tree (first_wv);
+ *error = "Too many dialog items";
+ return Qnil;
+ }
+
+ wv = malloc_widget_value ();
+ prev_wv->next = wv;
+ wv->name = (char *) button_names[nb_buttons];
+ if (!NILP (descrip))
+ wv->key = (char *) XSTRING (descrip)->data;
+ wv->value = (char *) XSTRING (item_name)->data;
+ wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
+ wv->enabled = !NILP (enable);
+ prev_wv = wv;
+
+ if (! boundary_seen)
+ left_count++;
+
+ nb_buttons++;
+ i += MENU_ITEMS_ITEM_LENGTH;
+ }
+
+ /* If the boundary was not specified,
+ by default put half on the left and half on the right. */
+ if (! boundary_seen)
+ left_count = nb_buttons - nb_buttons / 2;
+
+ wv = malloc_widget_value ();
+ wv->name = dialog_name;
+
+ /* Dialog boxes use a really stupid name encoding
+ which specifies how many buttons to use
+ and how many buttons are on the right.
+ The Q means something also. */
+ dialog_name[0] = 'Q';
+ dialog_name[1] = '0' + nb_buttons;
+ dialog_name[2] = 'B';
+ dialog_name[3] = 'R';
+ /* Number of buttons to put on the right. */
+ dialog_name[4] = '0' + nb_buttons - left_count;
+ dialog_name[5] = 0;
+ wv->contents = first_wv;
+ first_wv = wv;
+ }
+
+ /* Actually create the dialog. */
+ dialog_id = ++popup_id_tick;
+ menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
+ f->output_data.win32->widget, 1, 0,
+ dialog_selection_callback, 0);
+#if 0 /* This causes crashes, and seems to be redundant -- rms. */
+ lw_modify_all_widgets (dialog_id, first_wv, True);
+#endif
+ lw_modify_all_widgets (dialog_id, first_wv->contents, True);
+ /* Free the widget_value objects we used to specify the contents. */
+ free_menubar_widget_value_tree (first_wv);
+
+ /* No selection has been chosen yet. */
+ menu_item_selection = 0;
+
+ /* Display the menu. */
+ lw_pop_up_all_widgets (dialog_id);
+
+ /* Process events that apply to the menu. */
+ while (1)
+ {
+ XEvent event;
+
+ XtAppNextEvent (Xt_app_con, &event);
+ if (event.type == ButtonRelease)
+ {
+ XtDispatchEvent (&event);
+ break;
+ }
+ else if (event.type == Expose)
+ process_expose_from_menu (event);
+ XtDispatchEvent (&event);
+ if (XtWindowToWidget(XDISPLAY event.xany.window) != menu)
+ {
+ queue_tmp = (struct event_queue *) malloc (sizeof (struct event_queue));
+
+ if (queue_tmp != NULL)
+ {
+ queue_tmp->event = event;
+ queue_tmp->next = queue;
+ queue = queue_tmp;
+ }
+ }
+ }
+ pop_down:
+
+ /* State that no mouse buttons are now held.
+ That is not necessarily true, but the fiction leads to reasonable
+ results, and it is a pain to ask which are actually held now
+ or track this in the loop above. */
+ win32_mouse_grabbed = 0;
+
+ /* Unread any events that we got but did not handle. */
+ while (queue != NULL)
+ {
+ queue_tmp = queue;
+ XPutBackEvent (XDISPLAY &queue_tmp->event);
+ queue = queue_tmp->next;
+ free ((char *)queue_tmp);
+ /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
+ interrupt_input_pending = 1;
+ }
+
+ /* Find the selected item, and its pane, to return
+ the proper value. */
+ if (menu_item_selection != 0)
+ {
+ Lisp_Object prefix;
+
+ prefix = Qnil;
+ i = 0;
+ while (i < menu_items_used)
+ {
+ Lisp_Object entry;
+
+ if (EQ (XVECTOR (menu_items)->contents[i], Qt))
+ {
+ prefix
+ = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
+ i += MENU_ITEMS_PANE_LENGTH;
+ }
+ else
+ {
+ entry
+ = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
+ if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
+ {
+ if (keymaps != 0)
+ {
+ entry = Fcons (entry, Qnil);
+ if (!NILP (prefix))
+ entry = Fcons (prefix, entry);
+ }
+ return entry;
+ }
+ i += MENU_ITEMS_ITEM_LENGTH;
+ }
+ }
+ }
+
+ return Qnil;
+}
+#endif
+
+syms_of_win32menu ()
+{
+ defsubr (&Sx_popup_menu);
+ defsubr (&Sx_popup_dialog);
+}
--- /dev/null
+/* Emulate the X Resource Manager through the registry.
+ Copyright (C) 1990, 1993, 1994 Free Software Foundation.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; see the file COPYING. If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+/* Written by Kevin Gallo */
+
+#include <config.h>
+#include "lisp.h"
+#include "w32term.h"
+#include "blockinput.h"
+
+#include <stdio.h>
+#include <string.h>
+
+#define REG_ROOT "SOFTWARE\\GNU\\Emacs\\"
+
+LPBYTE
+win32_get_string_resource (name, class, dwexptype)
+ char *name, *class;
+ DWORD dwexptype;
+{
+ LPBYTE lpvalue = NULL;
+ HKEY hrootkey = NULL;
+ DWORD dwType;
+ DWORD cbData;
+ BOOL ok = FALSE;
+
+ BLOCK_INPUT;
+
+ /* Check both the current user and the local machine to see if we have any resources */
+
+ if (RegOpenKeyEx (HKEY_CURRENT_USER, REG_ROOT, 0, KEY_READ, &hrootkey) == ERROR_SUCCESS
+ || RegOpenKeyEx (HKEY_LOCAL_MACHINE, REG_ROOT, 0, KEY_READ, &hrootkey) == ERROR_SUCCESS)
+ {
+ char *keyname;
+
+ if (RegQueryValueEx (hrootkey, name, NULL, &dwType, NULL, &cbData) == ERROR_SUCCESS
+ && dwType == dwexptype)
+ {
+ keyname = name;
+ }
+ else if (RegQueryValueEx (hrootkey, class, NULL, &dwType, NULL, &cbData) == ERROR_SUCCESS
+ && dwType == dwexptype)
+ {
+ keyname = class;
+ }
+ else
+ {
+ keyname = NULL;
+ }
+
+ ok = (keyname
+ && (lpvalue = (LPBYTE) xmalloc (cbData)) != NULL
+ && RegQueryValueEx (hrootkey, keyname, NULL, NULL, lpvalue, &cbData) == ERROR_SUCCESS);
+
+ RegCloseKey (hrootkey);
+ }
+
+ UNBLOCK_INPUT;
+
+ if (!ok)
+ {
+ if (lpvalue) xfree (lpvalue);
+ return (NULL);
+ }
+ else
+ {
+ return (lpvalue);
+ }
+}
+
+/* Retrieve the string resource specified by NAME with CLASS from
+ database RDB. */
+
+char *
+x_get_string_resource (rdb, name, class)
+ int rdb;
+ char *name, *class;
+{
+ return (win32_get_string_resource (name, class, REG_SZ));
+}
--- /dev/null
+/* Win32 Selection processing for emacs
+ Copyright (C) 1993, 1994 Free Software Foundation.
+
+ This file is part of GNU Emacs.
+
+ GNU Emacs is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ GNU Emacs is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with GNU Emacs; see the file COPYING. If not, write to
+ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+/* Written by Kevin Gallo */
+
+#include <config.h>
+#include "lisp.h"
+#include "w32term.h" /* for all of the win32 includes */
+#include "dispextern.h" /* frame.h seems to want this */
+#include "frame.h" /* Need this to get the X window of selected_frame */
+#include "blockinput.h"
+
+#if 0
+DEFUN ("win32-open-clipboard", Fwin32_open_clipboard, Swin32_open_clipboard, 0, 1, 0,
+ "This opens the clipboard with the given frame pointer.")
+ (frame)
+ Lisp_Object frame;
+{
+ BOOL ok = FALSE;
+
+ if (!NILP (frame))
+ CHECK_LIVE_FRAME (frame, 0);
+
+ BLOCK_INPUT;
+
+ ok = OpenClipboard ((!NILP (frame) && FRAME_WIN32_P (XFRAME (frame))) ? FRAME_WIN32_WINDOW (XFRAME (frame)) : NULL);
+
+ UNBLOCK_INPUT;
+
+ return (ok ? frame : Qnil);
+}
+
+DEFUN ("win32-empty-clipboard", Fwin32_empty_clipboard, Swin32_empty_clipboard, 0, 0, 0,
+ "This empties the clipboard and assigns ownership to the window which opened the clipboard.")
+ ()
+{
+ BOOL ok = FALSE;
+
+ BLOCK_INPUT;
+
+ ok = EmptyClipboard ();
+
+ UNBLOCK_INPUT;
+
+ return (ok ? Qt : Qnil);
+}
+
+DEFUN ("win32-close-clipboard", Fwin32_close_clipboard, Swin32_close_clipboard, 0, 0, 0,
+ "This closes the clipboard.")
+ ()
+{
+ BOOL ok = FALSE;
+
+ BLOCK_INPUT;
+
+ ok = CloseClipboard ();
+
+ UNBLOCK_INPUT;
+
+ return (ok ? Qt : Qnil);
+}
+
+#endif
+
+DEFUN ("win32-set-clipboard-data", Fwin32_set_clipboard_data, Swin32_set_clipboard_data, 1, 2, 0,
+ "This sets the clipboard data to the given text.")
+ (string, frame)
+ Lisp_Object string, frame;
+{
+ BOOL ok = TRUE;
+ HANDLE htext;
+
+ CHECK_STRING (string, 0);
+
+ if (!NILP (frame))
+ CHECK_LIVE_FRAME (frame, 0);
+
+ BLOCK_INPUT;
+
+ /* Allocate twice the amount so we can convert lf to cr-lf */
+
+ if ((htext = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, (2 * XSTRING (string)->size) + 1)) == NULL)
+ goto error;
+
+ {
+ unsigned char *lptext;
+
+ if ((lptext = (unsigned char *)GlobalLock (htext)) == NULL)
+ goto error;
+
+ {
+ int i = XSTRING (string)->size;
+ int newsize = XSTRING (string)->size;
+ register char *p1 = XSTRING (string)->data;
+ register char *p2 = lptext;
+
+ while (i--)
+ {
+ if (*p1 == '\n')
+ {
+ newsize++;
+ *p2++ = '\r';
+ }
+
+ *p2++ = *p1++;
+ }
+
+ *p2 = 0;
+ }
+
+ GlobalUnlock (htext);
+ }
+
+ if (!OpenClipboard ((!NILP (frame) && FRAME_WIN32_P (XFRAME (frame))) ? FRAME_WIN32_WINDOW (XFRAME (frame)) : NULL))
+ goto error;
+
+ ok = EmptyClipboard () && SetClipboardData (CF_TEXT, htext);
+
+ CloseClipboard ();
+
+ if (ok) goto done;
+
+ error:
+
+ ok = FALSE;
+ if (htext) GlobalFree (htext);
+
+ done:
+ UNBLOCK_INPUT;
+
+ return (ok ? string : Qnil);
+}
+
+DEFUN ("win32-get-clipboard-data", Fwin32_get_clipboard_data, Swin32_get_clipboard_data, 0, 1, 0,
+ "This gets the clipboard data in text format.")
+ (frame)
+ Lisp_Object frame;
+{
+ HANDLE htext;
+ Lisp_Object ret = Qnil;
+
+ if (!NILP (frame))
+ CHECK_LIVE_FRAME (frame, 0);
+
+ BLOCK_INPUT;
+
+ if (!OpenClipboard ((!NILP (frame) && FRAME_WIN32_P (XFRAME (frame))) ? FRAME_WIN32_WINDOW (XFRAME (frame)) : NULL))
+ goto done;
+
+ if ((htext = GetClipboardData (CF_TEXT)) == NULL)
+ goto closeclip;
+
+
+ {
+ unsigned char *lptext;
+ int nbytes;
+
+ if ((lptext = (unsigned char *)GlobalLock (htext)) == NULL)
+ goto closeclip;
+
+ nbytes = strlen (lptext);
+
+ {
+ char *buf = (char *) xmalloc (nbytes);
+ register char *p1 = lptext;
+ register char *p2 = buf;
+ int i = nbytes;
+
+ if (buf == NULL) goto closeclip;
+
+ while (i--)
+ {
+ if (p1[0] == '\r' && i && p1[1] == '\n')
+ {
+ p1++;
+ i--;
+ nbytes--;
+ }
+
+ *p2++ = *p1++;
+ }
+
+ ret = make_string (buf, nbytes);
+
+ xfree (buf);
+ }
+
+ GlobalUnlock (htext);
+ }
+
+ closeclip:
+ CloseClipboard ();
+
+ done:
+ UNBLOCK_INPUT;
+
+ return (ret);
+}
+
+void
+syms_of_win32select ()
+{
+#if 0
+ defsubr (&Swin32_open_clipboard);
+ defsubr (&Swin32_empty_clipboard);
+ defsubr (&Swin32_close_clipboard);
+#endif
+ defsubr (&Swin32_set_clipboard_data);
+ defsubr (&Swin32_get_clipboard_data);
+}
--- /dev/null
+/* Implementation of Win32 GUI terminal
+ Copyright (C) 1989, 1993, 1994, 1995 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs; see the file COPYING. If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+/* Added by Kevin Gallo */
+
+#include <signal.h>
+#include <config.h>
+#include <stdio.h>
+#include "lisp.h"
+#include "blockinput.h"
+
+#include <w32term.h>
+
+#include "systty.h"
+#include "systime.h"
+
+#include <ctype.h>
+#include <errno.h>
+#include <setjmp.h>
+#include <sys/stat.h>
+
+#include "frame.h"
+#include "dispextern.h"
+#include "termhooks.h"
+#include "termopts.h"
+#include "termchar.h"
+#include "gnu.h"
+#include "disptab.h"
+#include "buffer.h"
+#include "window.h"
+#include "keyboard.h"
+#include "intervals.h"
+
+extern void free_frame_menubar ();
+
+#define x_any_window_to_frame x_window_to_frame
+#define x_top_window_to_frame x_window_to_frame
+
+\f
+/* This is display since win32 does not support multiple ones. */
+struct win32_display_info one_win32_display_info;
+
+/* This is a list of cons cells, each of the form (NAME . FONT-LIST-CACHE),
+ one for each element of win32_display_list and in the same order.
+ NAME is the name of the frame.
+ FONT-LIST-CACHE records previous values returned by x-list-fonts. */
+Lisp_Object win32_display_name_list;
+
+/* Frame being updated by update_frame. This is declared in term.c.
+ This is set by update_begin and looked at by all the
+ win32 functions. It is zero while not inside an update.
+ In that case, the win32 functions assume that `selected_frame'
+ is the frame to apply to. */
+extern struct frame *updating_frame;
+
+/* This is a frame waiting to be autoraised, within w32_read_socket. */
+struct frame *pending_autoraise_frame;
+
+/* During an update, maximum vpos for ins/del line operations to affect. */
+
+static int flexlines;
+
+/* During an update, nonzero if chars output now should be highlighted. */
+
+static int highlight;
+
+/* Nominal cursor position -- where to draw output.
+ During an update, these are different from the cursor-box position. */
+
+static int curs_x;
+static int curs_y;
+
+DWORD dwWinThreadId = 0;
+HANDLE hWinThread = NULL;
+DWORD dwMainThreadId = 0;
+HANDLE hMainThread = NULL;
+
+/* Mouse movement. */
+
+/* Where the mouse was last time we reported a mouse event. */
+static FRAME_PTR last_mouse_frame;
+static RECT last_mouse_glyph;
+
+/* The scroll bar in which the last motion event occurred.
+
+ If the last motion event occurred in a scroll bar, we set this
+ so win32_mouse_position can know whether to report a scroll bar motion or
+ an ordinary motion.
+
+ If the last motion event didn't occur in a scroll bar, we set this
+ to Qnil, to tell win32_mouse_position to return an ordinary motion event. */
+Lisp_Object last_mouse_scroll_bar;
+int last_mouse_scroll_bar_pos;
+
+/* This is a hack. We would really prefer that win32_mouse_position would
+ return the time associated with the position it returns, but there
+ doesn't seem to be any way to wrest the timestamp from the server
+ along with the position query. So, we just keep track of the time
+ of the last movement we received, and return that in hopes that
+ it's somewhat accurate. */
+Time last_mouse_movement_time;
+
+/* Incremented by w32_read_socket whenever it really tries to read events. */
+#ifdef __STDC__
+static int volatile input_signal_count;
+#else
+static int input_signal_count;
+#endif
+
+extern Lisp_Object Vcommand_line_args, Vsystem_name;
+
+extern Lisp_Object Qface, Qmouse_face;
+
+extern int errno;
+
+/* A mask of extra modifier bits to put into every keyboard char. */
+extern int extra_keyboard_modifiers;
+
+static Lisp_Object Qvendor_specific_keysyms;
+
+void win32_delete_display ();
+
+static void redraw_previous_char ();
+static void redraw_following_char ();
+static unsigned int win32_get_modifiers ();
+
+static int fast_find_position ();
+static void note_mouse_highlight ();
+static void clear_mouse_face ();
+static void show_mouse_face ();
+static void do_line_dance ();
+
+static int win32_cursor_to ();
+static int win32_clear_end_of_line ();
+\f
+#if 0
+/* This is a function useful for recording debugging information
+ about the sequence of occurrences in this file. */
+
+struct record
+{
+ char *locus;
+ int type;
+};
+
+struct record event_record[100];
+
+int event_record_index;
+
+record_event (locus, type)
+ char *locus;
+ int type;
+{
+ if (event_record_index == sizeof (event_record) / sizeof (struct record))
+ event_record_index = 0;
+
+ event_record[event_record_index].locus = locus;
+ event_record[event_record_index].type = type;
+ event_record_index++;
+}
+
+#endif /* 0 */
+\f
+/* Return the struct win32_display_info. */
+
+struct win32_display_info *
+win32_display_info_for_display ()
+{
+ return (&one_win32_display_info);
+}
+
+void
+win32_fill_rect (f, _hdc, pix, lprect)
+ FRAME_PTR f;
+ HDC _hdc;
+ COLORREF pix;
+ RECT * lprect;
+{
+ HDC hdc;
+ HBRUSH hb;
+ HANDLE oldobj;
+ RECT rect;
+
+ if (_hdc)
+ hdc = _hdc;
+ else
+ {
+ if (!f) return;
+ hdc = my_get_dc (FRAME_WIN32_WINDOW (f));
+ }
+
+ hb = CreateSolidBrush (pix);
+ oldobj = SelectObject (hdc, hb);
+
+ FillRect (hdc, lprect, hb);
+ SelectObject (hdc, oldobj);
+ DeleteObject (hb);
+
+ if (!_hdc)
+ ReleaseDC (FRAME_WIN32_WINDOW (f), hdc);
+}
+
+void
+win32_clear_window (f)
+ FRAME_PTR f;
+{
+ RECT rect;
+
+ GetClientRect (FRAME_WIN32_WINDOW (f), &rect);
+ win32_clear_rect (f, NULL, &rect);
+}
+
+\f
+/* Starting and ending updates.
+
+ These hooks are called by update_frame at the beginning and end
+ of a frame update. We record in `updating_frame' the identity
+ of the frame being updated, so that the win32_... functions do not
+ need to take a frame as argument. Most of the win32_... functions
+ should never be called except during an update, the only exceptions
+ being win32_cursor_to, win32_write_glyphs and win32_reassert_line_highlight. */
+
+static
+win32_update_begin (f)
+ struct frame *f;
+{
+ if (f == 0)
+ abort ();
+
+ flexlines = f->height;
+ highlight = 0;
+
+ BLOCK_INPUT;
+
+ if (f == FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_mouse_frame)
+ {
+ /* Don't do highlighting for mouse motion during the update. */
+ FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_defer = 1;
+
+ /* If the frame needs to be redrawn,
+ simply forget about any prior mouse highlighting. */
+ if (FRAME_GARBAGED_P (f))
+ FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_window = Qnil;
+
+ if (!NILP (FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_window))
+ {
+ int firstline, lastline, i;
+ struct window *w = XWINDOW (FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_window);
+
+ /* Find the first, and the last+1, lines affected by redisplay. */
+ for (firstline = 0; firstline < f->height; firstline++)
+ if (FRAME_DESIRED_GLYPHS (f)->enable[firstline])
+ break;
+
+ lastline = f->height;
+ for (i = f->height - 1; i >= 0; i--)
+ {
+ if (FRAME_DESIRED_GLYPHS (f)->enable[i])
+ break;
+ else
+ lastline = i;
+ }
+
+ /* Can we tell that this update does not affect the window
+ where the mouse highlight is? If so, no need to turn off.
+ Likewise, don't do anything if the frame is garbaged;
+ in that case, the FRAME_CURRENT_GLYPHS that we would use
+ are all wrong, and we will redisplay that line anyway. */
+ if (! (firstline > (XFASTINT (w->top) + window_internal_height (w))
+ || lastline < XFASTINT (w->top)))
+ clear_mouse_face (FRAME_WIN32_DISPLAY_INFO (f));
+ }
+ }
+
+ UNBLOCK_INPUT;
+}
+
+static
+win32_update_end (f)
+ struct frame *f;
+{
+ BLOCK_INPUT;
+
+ do_line_dance ();
+ x_display_cursor (f, 1);
+
+ if (f == FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_mouse_frame)
+ FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_defer = 0;
+
+ UNBLOCK_INPUT;
+}
+
+/* This is called after a redisplay on frame F. */
+
+static
+win32_frame_up_to_date (f)
+ FRAME_PTR f;
+{
+ if (FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_deferred_gc
+ || f == FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_mouse_frame)
+ {
+ note_mouse_highlight (FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_mouse_frame,
+ FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_mouse_x,
+ FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_mouse_y);
+ FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_deferred_gc = 0;
+ }
+}
+\f
+/* External interface to control of standout mode.
+ Call this when about to modify line at position VPOS
+ and not change whether it is highlighted. */
+
+win32_reassert_line_highlight (new, vpos)
+ int new, vpos;
+{
+ highlight = new;
+}
+
+/* Call this when about to modify line at position VPOS
+ and change whether it is highlighted. */
+
+static
+win32_change_line_highlight (new_highlight, vpos, first_unused_hpos)
+ int new_highlight, vpos, first_unused_hpos;
+{
+ highlight = new_highlight;
+ win32_cursor_to (vpos, 0);
+ win32_clear_end_of_line (updating_frame->width);
+}
+
+/* This is used when starting Emacs and when restarting after suspend.
+ When starting Emacs, no window is mapped. And nothing must be done
+ to Emacs's own window if it is suspended (though that rarely happens). */
+
+static
+win32_set_terminal_modes ()
+{
+}
+
+/* This is called when exiting or suspending Emacs.
+ Exiting will make the Win32 windows go away, and suspending
+ requires no action. */
+
+static
+win32_reset_terminal_modes ()
+{
+}
+\f
+/* Set the nominal cursor position of the frame.
+ This is where display update commands will take effect.
+ This does not affect the place where the cursor-box is displayed. */
+
+static int
+win32_cursor_to (row, col)
+ register int row, col;
+{
+ int orow = row;
+
+ curs_x = col;
+ curs_y = row;
+
+ if (updating_frame == 0)
+ {
+ BLOCK_INPUT;
+ x_display_cursor (selected_frame, 1);
+ UNBLOCK_INPUT;
+ }
+}
+\f
+/* Display a sequence of N glyphs found at GP.
+ WINDOW is the window to output to. LEFT and TOP are starting coords.
+ HL is 1 if this text is highlighted, 2 if the cursor is on it,
+ 3 if should appear in its mouse-face.
+ JUST_FOREGROUND if 1 means draw only the foreground;
+ don't alter the background.
+
+ FONT is the default font to use (for glyphs whose font-code is 0).
+
+ Since the display generation code is responsible for calling
+ compute_char_face and compute_glyph_face on everything it puts in
+ the display structure, we can assume that the face code on each
+ glyph is a valid index into FRAME_COMPUTED_FACES (f), and the one
+ to which we can actually apply intern_face.
+ Call this function with input blocked. */
+
+static void
+dumpglyphs (f, left, top, gp, n, hl, just_foreground)
+ struct frame *f;
+ int left, top;
+ register GLYPH *gp; /* Points to first GLYPH. */
+ register int n; /* Number of glyphs to display. */
+ int hl;
+ int just_foreground;
+{
+ /* Holds characters to be displayed. */
+ char *buf = (char *) alloca (f->width * sizeof (*buf));
+ register char *cp; /* Steps through buf[]. */
+ register int tlen = GLYPH_TABLE_LENGTH;
+ register Lisp_Object *tbase = GLYPH_TABLE_BASE;
+ Window window = FRAME_WIN32_WINDOW (f);
+ int orig_left = left;
+ HDC hdc;
+
+ hdc = my_get_dc (window);
+
+ while (n > 0)
+ {
+ /* Get the face-code of the next GLYPH. */
+ int cf, len;
+ int g = *gp;
+
+ GLYPH_FOLLOW_ALIASES (tbase, tlen, g);
+ cf = FAST_GLYPH_FACE (g);
+
+ /* Find the run of consecutive glyphs with the same face-code.
+ Extract their character codes into BUF. */
+ cp = buf;
+ while (n > 0)
+ {
+ g = *gp;
+ GLYPH_FOLLOW_ALIASES (tbase, tlen, g);
+ if (FAST_GLYPH_FACE (g) != cf)
+ break;
+
+ *cp++ = FAST_GLYPH_CHAR (g);
+ --n;
+ ++gp;
+ }
+
+ /* LEN gets the length of the run. */
+ len = cp - buf;
+
+ /* Now output this run of chars, with the font and pixel values
+ determined by the face code CF. */
+ {
+ struct face *face = FRAME_DEFAULT_FACE (f);
+ XFontStruct *font = FACE_FONT (face);
+ int stippled = 0;
+ COLORREF fg;
+ COLORREF bg;
+
+ /* HL = 3 means use a mouse face previously chosen. */
+ if (hl == 3)
+ cf = FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_face_id;
+
+ /* First look at the face of the text itself. */
+ if (cf != 0)
+ {
+ /* It's possible for the display table to specify
+ a face code that is out of range. Use 0 in that case. */
+ if (cf < 0 || cf >= FRAME_N_COMPUTED_FACES (f)
+ || FRAME_COMPUTED_FACES (f) [cf] == 0)
+ cf = 0;
+
+ if (cf == 1)
+ face = FRAME_MODE_LINE_FACE (f);
+ else
+ face = intern_face (f, FRAME_COMPUTED_FACES (f) [cf]);
+ font = FACE_FONT (face);
+ if (FACE_STIPPLE (face))
+ stippled = 1;
+ }
+
+ /* Then comes the distinction between modeline and normal text. */
+ else if (hl == 0)
+ ;
+ else if (hl == 1)
+ {
+ face = FRAME_MODE_LINE_FACE (f);
+ font = FACE_FONT (face);
+ if (FACE_STIPPLE (face))
+ stippled = 1;
+ }
+
+ fg = face->foreground;
+ bg = face->background;
+
+ /* Now override that if the cursor's on this character. */
+ if (hl == 2)
+ {
+ /* The cursor overrides stippling. */
+ stippled = 0;
+
+ if ((!face->font
+ || face->font == (XFontStruct *) FACE_DEFAULT
+ || face->font == f->output_data.win32->font)
+ && face->background == f->output_data.win32->background_pixel
+ && face->foreground == f->output_data.win32->foreground_pixel)
+ {
+ bg = f->output_data.win32->cursor_pixel;
+ fg = face->background;
+ }
+ /* Cursor on non-default face: must merge. */
+ else
+ {
+ bg = f->output_data.win32->cursor_pixel;
+ fg = face->background;
+ /* If the glyph would be invisible,
+ try a different foreground. */
+ if (fg == bg)
+ fg = face->foreground;
+ if (fg == bg)
+ fg = f->output_data.win32->cursor_foreground_pixel;
+ if (fg == bg)
+ fg = face->foreground;
+ /* Make sure the cursor is distinct from text in this face. */
+ if (bg == face->background
+ && fg == face->foreground)
+ {
+ bg = face->foreground;
+ fg = face->background;
+ }
+ }
+ }
+
+ if (font == (XFontStruct *) FACE_DEFAULT)
+ font = f->output_data.win32->font;
+
+ SetBkMode (hdc, just_foreground ? TRANSPARENT : OPAQUE);
+
+ SetTextColor (hdc, fg);
+ SetBkColor (hdc, bg);
+
+ SelectObject (hdc, font->hfont);
+
+ TextOut (hdc, left, top, buf, len);
+
+ if (!just_foreground)
+ {
+ /* Clear the rest of the line's height. */
+ if (f->output_data.win32->line_height != FONT_HEIGHT (font))
+ win32_fill_area (f, hdc, bg,
+ left,
+ top + FONT_HEIGHT (font),
+ FONT_WIDTH (font) * len,
+ f->output_data.win32->line_height - FONT_HEIGHT (font));
+ }
+
+ {
+ int underline_position = 1;
+
+ if (font->tm.tmDescent <= underline_position)
+ underline_position = font->tm.tmDescent - 1;
+
+ if (face->underline)
+ win32_fill_area (f, hdc, fg,
+ left, (top
+ + FONT_BASE (font)
+ + underline_position),
+ len * FONT_WIDTH (font), 1);
+ }
+
+ left += len * FONT_WIDTH (font);
+ }
+ }
+
+ ReleaseDC (window, hdc);
+}
+
+\f
+/* Output some text at the nominal frame cursor position.
+ Advance the cursor over the text.
+ Output LEN glyphs at START.
+
+ `highlight', set up by win32_reassert_line_highlight or win32_change_line_highlight,
+ controls the pixel values used for foreground and background. */
+
+static
+win32_write_glyphs (start, len)
+ register GLYPH *start;
+ int len;
+{
+ register int temp_length;
+ struct frame *f;
+
+ BLOCK_INPUT;
+
+ do_line_dance ();
+ f = updating_frame;
+ if (f == 0)
+ {
+ f = selected_frame;
+ /* If not within an update,
+ output at the frame's visible cursor. */
+ curs_x = f->cursor_x;
+ curs_y = f->cursor_y;
+ }
+
+ dumpglyphs (f,
+ CHAR_TO_PIXEL_COL (f, curs_x),
+ CHAR_TO_PIXEL_ROW (f, curs_y),
+ start, len, highlight, 0);
+
+ /* If we drew on top of the cursor, note that it is turned off. */
+ if (curs_y == f->phys_cursor_y
+ && curs_x <= f->phys_cursor_x
+ && curs_x + len > f->phys_cursor_x)
+ f->phys_cursor_x = -1;
+
+ if (updating_frame == 0)
+ {
+ f->cursor_x += len;
+ x_display_cursor (f, 1);
+ f->cursor_x -= len;
+ }
+ else
+ curs_x += len;
+
+ UNBLOCK_INPUT;
+}
+\f
+/* Clear to the end of the line.
+ Erase the current text line from the nominal cursor position (inclusive)
+ to column FIRST_UNUSED (exclusive). The idea is that everything
+ from FIRST_UNUSED onward is already erased. */
+
+static
+win32_clear_end_of_line (first_unused)
+ register int first_unused;
+{
+ struct frame *f = updating_frame;
+
+ if (f == 0)
+ abort ();
+
+ if (curs_y < 0 || curs_y >= f->height)
+ return 1;
+ if (first_unused <= 0)
+ return 1;
+
+ if (first_unused >= f->width)
+ first_unused = f->width;
+
+ BLOCK_INPUT;
+
+ do_line_dance ();
+
+ /* Notice if the cursor will be cleared by this operation. */
+ if (curs_y == f->phys_cursor_y
+ && curs_x <= f->phys_cursor_x
+ && f->phys_cursor_x < first_unused)
+ f->phys_cursor_x = -1;
+
+ win32_clear_area (f, NULL,
+ CHAR_TO_PIXEL_COL (f, curs_x),
+ CHAR_TO_PIXEL_ROW (f, curs_y),
+ FONT_WIDTH (f->output_data.win32->font) * (first_unused - curs_x),
+ f->output_data.win32->line_height);
+
+ UNBLOCK_INPUT;
+}
+
+static
+win32_clear_frame ()
+{
+ struct frame *f = updating_frame;
+
+ if (f == 0)
+ f = selected_frame;
+
+ f->phys_cursor_x = -1; /* Cursor not visible. */
+ curs_x = 0; /* Nominal cursor position is top left. */
+ curs_y = 0;
+
+ BLOCK_INPUT;
+
+ win32_clear_window (f);
+
+ /* We have to clear the scroll bars, too. If we have changed
+ colors or something like that, then they should be notified. */
+ x_scroll_bar_clear (f);
+
+ UNBLOCK_INPUT;
+}
+\f
+/* Make audible bell. */
+
+win32_ring_bell ()
+{
+ BLOCK_INPUT;
+
+ if (visible_bell)
+ FlashWindow (FRAME_WIN32_WINDOW (selected_frame), FALSE);
+ else
+ nt_ring_bell ();
+
+ UNBLOCK_INPUT;
+
+ return 1;
+}
+\f
+/* Insert and delete character.
+ These are not supposed to be used because we are supposed to turn
+ off the feature of using them. */
+
+static
+win32_insert_glyphs (start, len)
+ register char *start;
+ register int len;
+{
+ abort ();
+}
+
+static
+win32_delete_glyphs (n)
+ register int n;
+{
+ abort ();
+}
+\f
+/* Specify how many text lines, from the top of the window,
+ should be affected by insert-lines and delete-lines operations.
+ This, and those operations, are used only within an update
+ that is bounded by calls to win32_update_begin and win32_update_end. */
+
+static
+win32_set_terminal_window (n)
+ register int n;
+{
+ if (updating_frame == 0)
+ abort ();
+
+ if ((n <= 0) || (n > updating_frame->height))
+ flexlines = updating_frame->height;
+ else
+ flexlines = n;
+}
+\f
+/* These variables need not be per frame
+ because redisplay is done on a frame-by-frame basis
+ and the line dance for one frame is finished before
+ anything is done for another frame. */
+
+/* Array of line numbers from cached insert/delete operations.
+ line_dance[i] is the old position of the line that we want
+ to move to line i, or -1 if we want a blank line there. */
+static int *line_dance;
+
+/* Allocated length of that array. */
+static int line_dance_len;
+
+/* Flag indicating whether we've done any work. */
+static int line_dance_in_progress;
+
+/* Perform an insert-lines or delete-lines operation,
+ inserting N lines or deleting -N lines at vertical position VPOS. */
+win32_ins_del_lines (vpos, n)
+ int vpos, n;
+{
+ register int fence, i;
+
+ if (vpos >= flexlines)
+ return 1;
+
+ if (!line_dance_in_progress)
+ {
+ int ht = updating_frame->height;
+ if (ht > line_dance_len)
+ {
+ line_dance = (int *)xrealloc (line_dance, ht * sizeof (int));
+ line_dance_len = ht;
+ }
+ for (i = 0; i < ht; ++i) line_dance[i] = i;
+ line_dance_in_progress = 1;
+ }
+ if (n >= 0)
+ {
+ if (n > flexlines - vpos)
+ n = flexlines - vpos;
+ fence = vpos + n;
+ for (i = flexlines; --i >= fence;)
+ line_dance[i] = line_dance[i-n];
+ for (i = fence; --i >= vpos;)
+ line_dance[i] = -1;
+ }
+ else
+ {
+ n = -n;
+ if (n > flexlines - vpos)
+ n = flexlines - vpos;
+ fence = flexlines - n;
+ for (i = vpos; i < fence; ++i)
+ line_dance[i] = line_dance[i + n];
+ for (i = fence; i < flexlines; ++i)
+ line_dance[i] = -1;
+ }
+}
+
+/* Here's where we actually move the pixels around.
+ Must be called with input blocked. */
+static void
+do_line_dance ()
+{
+ register int i, j, distance;
+ register struct frame *f;
+ int ht;
+ int intborder;
+ HDC hdc;
+
+ /* Must check this flag first. If it's not set, then not only is the
+ array uninitialized, but we might not even have a frame. */
+ if (!line_dance_in_progress)
+ return;
+
+ f = updating_frame;
+ if (f == 0)
+ abort ();
+
+ ht = f->height;
+ intborder = f->output_data.win32->internal_border_width;
+
+ x_display_cursor (updating_frame, 0);
+
+ hdc = my_get_dc (FRAME_WIN32_WINDOW (f));
+
+ for (i = 0; i < ht; ++i)
+ if (line_dance[i] != -1 && (distance = line_dance[i]-i) > 0)
+ {
+ for (j = i; (j < ht && line_dance[j] != -1
+ && line_dance[j]-j == distance); ++j);
+ /* Copy [i,j) upward from [i+distance, j+distance) */
+ BitBlt (hdc,
+ intborder, CHAR_TO_PIXEL_ROW (f, i+distance),
+ f->width * FONT_WIDTH (f->output_data.win32->font),
+ (j-i) * f->output_data.win32->line_height,
+ hdc,
+ intborder, CHAR_TO_PIXEL_ROW (f, i),
+ SRCCOPY);
+ i = j-1;
+ }
+
+ for (i = ht; --i >=0; )
+ if (line_dance[i] != -1 && (distance = line_dance[i]-i) < 0)
+ {
+ for (j = i; (--j >= 0 && line_dance[j] != -1
+ && line_dance[j]-j == distance););
+ /* Copy (j, i] downward from (j+distance, i+distance] */
+ BitBlt (hdc,
+ intborder, CHAR_TO_PIXEL_ROW (f, j+1+distance),
+ f->width * FONT_WIDTH (f->output_data.win32->font),
+ (i-j) * f->output_data.win32->line_height,
+ hdc,
+ intborder, CHAR_TO_PIXEL_ROW (f, j+1),
+ SRCCOPY);
+ i = j+1;
+ }
+
+ ReleaseDC (FRAME_WIN32_WINDOW (f), hdc);
+
+ for (i = 0; i < ht; ++i)
+ if (line_dance[i] == -1)
+ {
+ for (j = i; j < ht && line_dance[j] == -1; ++j);
+ /* Clear [i,j) */
+ win32_clear_area (f, NULL,
+ intborder,
+ CHAR_TO_PIXEL_ROW (f, i),
+ f->width * FONT_WIDTH (f->output_data.win32->font),
+ (j-i) * f->output_data.win32->line_height);
+ i = j-1;
+ }
+ line_dance_in_progress = 0;
+}
+\f
+/* Support routines for exposure events. */
+static void clear_cursor ();
+
+/* Output into a rectangle of a window (for frame F)
+ the characters in f->phys_lines that overlap that rectangle.
+ TOP and LEFT are the position of the upper left corner of the rectangle.
+ ROWS and COLS are the size of the rectangle.
+ Call this function with input blocked. */
+
+void
+dumprectangle (f, left, top, cols, rows)
+ struct frame *f;
+ register int left, top, cols, rows;
+{
+ register struct frame_glyphs *active_frame = FRAME_CURRENT_GLYPHS (f);
+ int cursor_cleared = 0;
+ int bottom, right;
+ register int y;
+
+ if (FRAME_GARBAGED_P (f))
+ return;
+
+ /* Express rectangle as four edges, instead of position-and-size. */
+ bottom = top + rows;
+ right = left + cols;
+
+ /* Convert rectangle edges in pixels to edges in chars.
+ Round down for left and top, up for right and bottom. */
+ top = PIXEL_TO_CHAR_ROW (f, top);
+ left = PIXEL_TO_CHAR_COL (f, left);
+ bottom += (f->output_data.win32->line_height - 1);
+ right += (FONT_WIDTH (f->output_data.win32->font) - 1);
+ bottom = PIXEL_TO_CHAR_ROW (f, bottom);
+ right = PIXEL_TO_CHAR_COL (f, right);
+
+ /* Clip the rectangle to what can be visible. */
+ if (left < 0)
+ left = 0;
+ if (top < 0)
+ top = 0;
+ if (right > f->width)
+ right = f->width;
+ if (bottom > f->height)
+ bottom = f->height;
+
+ /* Get size in chars of the rectangle. */
+ cols = right - left;
+ rows = bottom - top;
+
+ /* If rectangle has zero area, return. */
+ if (rows <= 0) return;
+ if (cols <= 0) return;
+
+ /* Turn off the cursor if it is in the rectangle.
+ We will turn it back on afterward. */
+ if ((f->phys_cursor_x >= left) && (f->phys_cursor_x < right)
+ && (f->phys_cursor_y >= top) && (f->phys_cursor_y < bottom))
+ {
+ clear_cursor (f);
+ cursor_cleared = 1;
+ }
+
+ /* Display the text in the rectangle, one text line at a time. */
+
+ for (y = top; y < bottom; y++)
+ {
+ GLYPH *line = &active_frame->glyphs[y][left];
+
+ if (! active_frame->enable[y] || left > active_frame->used[y])
+ continue;
+
+ dumpglyphs (f,
+ CHAR_TO_PIXEL_COL (f, left),
+ CHAR_TO_PIXEL_ROW (f, y),
+ line, min (cols, active_frame->used[y] - left),
+ active_frame->highlight[y], 0);
+ }
+
+ /* Turn the cursor on if we turned it off. */
+
+ if (cursor_cleared)
+ x_display_cursor (f, 1);
+}
+\f
+static void
+frame_highlight (f)
+ struct frame *f;
+{
+ x_display_cursor (f, 1);
+}
+
+static void
+frame_unhighlight (f)
+ struct frame *f;
+{
+ x_display_cursor (f, 1);
+}
+
+static void win32_frame_rehighlight ();
+static void x_frame_rehighlight ();
+
+/* The focus has changed. Update the frames as necessary to reflect
+ the new situation. Note that we can't change the selected frame
+ here, because the Lisp code we are interrupting might become confused.
+ Each event gets marked with the frame in which it occurred, so the
+ Lisp code can tell when the switch took place by examining the events. */
+
+void
+x_new_focus_frame (dpyinfo, frame)
+ struct win32_display_info *dpyinfo;
+ struct frame *frame;
+{
+ struct frame *old_focus = dpyinfo->win32_focus_frame;
+ int events_enqueued = 0;
+
+ if (frame != dpyinfo->win32_focus_frame)
+ {
+ /* Set this before calling other routines, so that they see
+ the correct value of win32_focus_frame. */
+ dpyinfo->win32_focus_frame = frame;
+
+ if (old_focus && old_focus->auto_lower)
+ x_lower_frame (old_focus);
+
+ if (dpyinfo->win32_focus_frame && dpyinfo->win32_focus_frame->auto_raise)
+ pending_autoraise_frame = dpyinfo->win32_focus_frame;
+ else
+ pending_autoraise_frame = 0;
+ }
+
+ x_frame_rehighlight (dpyinfo);
+}
+
+/* Handle an event saying the mouse has moved out of an Emacs frame. */
+
+void
+x_mouse_leave (dpyinfo)
+ struct win32_display_info *dpyinfo;
+{
+ x_new_focus_frame (dpyinfo, dpyinfo->win32_focus_event_frame);
+}
+
+/* The focus has changed, or we have redirected a frame's focus to
+ another frame (this happens when a frame uses a surrogate
+ minibuffer frame). Shift the highlight as appropriate.
+
+ The FRAME argument doesn't necessarily have anything to do with which
+ frame is being highlighted or unhighlighted; we only use it to find
+ the appropriate display info. */
+static void
+win32_frame_rehighlight (frame)
+ struct frame *frame;
+{
+ x_frame_rehighlight (FRAME_WIN32_DISPLAY_INFO (frame));
+}
+
+static void
+x_frame_rehighlight (dpyinfo)
+ struct win32_display_info *dpyinfo;
+{
+ struct frame *old_highlight = dpyinfo->win32_highlight_frame;
+
+ if (dpyinfo->win32_focus_frame)
+ {
+ dpyinfo->win32_highlight_frame
+ = ((GC_FRAMEP (FRAME_FOCUS_FRAME (dpyinfo->win32_focus_frame)))
+ ? XFRAME (FRAME_FOCUS_FRAME (dpyinfo->win32_focus_frame))
+ : dpyinfo->win32_focus_frame);
+ if (! FRAME_LIVE_P (dpyinfo->win32_highlight_frame))
+ {
+ FRAME_FOCUS_FRAME (dpyinfo->win32_focus_frame) = Qnil;
+ dpyinfo->win32_highlight_frame = dpyinfo->win32_focus_frame;
+ }
+ }
+ else
+ dpyinfo->win32_highlight_frame = 0;
+
+ if (dpyinfo->win32_highlight_frame != old_highlight)
+ {
+ if (old_highlight)
+ frame_unhighlight (old_highlight);
+ if (dpyinfo->win32_highlight_frame)
+ frame_highlight (dpyinfo->win32_highlight_frame);
+ }
+}
+\f
+/* Keyboard processing - modifier keys, etc. */
+
+/* Convert a keysym to its name. */
+
+char *
+x_get_keysym_name (keysym)
+ int keysym;
+{
+ /* Make static so we can always return it */
+ static char value[100];
+
+ BLOCK_INPUT;
+ GetKeyNameText(keysym, value, 100);
+ UNBLOCK_INPUT;
+
+ return value;
+}
+\f
+/* Mouse clicks and mouse movement. Rah. */
+
+/* Given a pixel position (PIX_X, PIX_Y) on the frame F, return
+ glyph co-ordinates in (*X, *Y). Set *BOUNDS to the rectangle
+ that the glyph at X, Y occupies, if BOUNDS != 0.
+ If NOCLIP is nonzero, do not force the value into range. */
+
+void
+pixel_to_glyph_coords (f, pix_x, pix_y, x, y, bounds, noclip)
+ FRAME_PTR f;
+ register int pix_x, pix_y;
+ register int *x, *y;
+ RECT *bounds;
+ int noclip;
+{
+ /* Arrange for the division in PIXEL_TO_CHAR_COL etc. to round down
+ even for negative values. */
+ if (pix_x < 0)
+ pix_x -= FONT_WIDTH ((f)->output_data.win32->font) - 1;
+ if (pix_y < 0)
+ pix_y -= (f)->output_data.win32->line_height - 1;
+
+ pix_x = PIXEL_TO_CHAR_COL (f, pix_x);
+ pix_y = PIXEL_TO_CHAR_ROW (f, pix_y);
+
+ if (bounds)
+ {
+ bounds->left = CHAR_TO_PIXEL_COL (f, pix_x);
+ bounds->top = CHAR_TO_PIXEL_ROW (f, pix_y);
+ bounds->right = bounds->left + FONT_WIDTH (f->output_data.win32->font) - 1;
+ bounds->bottom = bounds->top + f->output_data.win32->line_height - 1;
+ }
+
+ if (!noclip)
+ {
+ if (pix_x < 0)
+ pix_x = 0;
+ else if (pix_x > f->width)
+ pix_x = f->width;
+
+ if (pix_y < 0)
+ pix_y = 0;
+ else if (pix_y > f->height)
+ pix_y = f->height;
+ }
+
+ *x = pix_x;
+ *y = pix_y;
+}
+
+void
+glyph_to_pixel_coords (f, x, y, pix_x, pix_y)
+ FRAME_PTR f;
+ register int x, y;
+ register int *pix_x, *pix_y;
+{
+ *pix_x = CHAR_TO_PIXEL_COL (f, x);
+ *pix_y = CHAR_TO_PIXEL_ROW (f, y);
+}
+
+BOOL
+parse_button (message, pbutton, pup)
+ int message;
+ int * pbutton;
+ int * pup;
+{
+ int button = 0;
+ int up = 0;
+
+ switch (message)
+ {
+ case WM_LBUTTONDOWN:
+ button = 0;
+ up = 0;
+ break;
+ case WM_LBUTTONUP:
+ button = 0;
+ up = 1;
+ break;
+ case WM_MBUTTONDOWN:
+ button = 1;
+ up = 0;
+ break;
+ case WM_MBUTTONUP:
+ button = 1;
+ up = 1;
+ break;
+ case WM_RBUTTONDOWN:
+ button = 2;
+ up = 0;
+ break;
+ case WM_RBUTTONUP:
+ button = 2;
+ up = 1;
+ break;
+ default:
+ return (FALSE);
+ }
+
+ if (pup) *pup = up;
+ if (pbutton) *pbutton = button;
+
+ return (TRUE);
+}
+
+
+/* Prepare a mouse-event in *RESULT for placement in the input queue.
+
+ If the event is a button press, then note that we have grabbed
+ the mouse. */
+
+static void
+construct_mouse_click (result, msg, f)
+ struct input_event *result;
+ Win32Msg *msg;
+ struct frame *f;
+{
+ int button;
+ int up;
+
+ parse_button (msg->msg.message, &button, &up);
+
+ /* Make the event type no_event; we'll change that when we decide
+ otherwise. */
+ result->kind = mouse_click;
+ result->code = button;
+ result->timestamp = msg->msg.time;
+ result->modifiers = (msg->dwModifiers
+ | (up
+ ? up_modifier
+ : down_modifier));
+
+ {
+ int row, column;
+
+ XSETINT (result->x, LOWORD (msg->msg.lParam));
+ XSETINT (result->y, HIWORD (msg->msg.lParam));
+ XSETFRAME (result->frame_or_window, f);
+ }
+}
+
+\f
+/* Function to report a mouse movement to the mainstream Emacs code.
+ The input handler calls this.
+
+ We have received a mouse movement event, which is given in *event.
+ If the mouse is over a different glyph than it was last time, tell
+ the mainstream emacs code by setting mouse_moved. If not, ask for
+ another motion event, so we can check again the next time it moves. */
+
+static void
+note_mouse_movement (frame, msg)
+ FRAME_PTR frame;
+ MSG *msg;
+{
+ last_mouse_movement_time = msg->time;
+
+ if (msg->hwnd != FRAME_WIN32_WINDOW (frame))
+ {
+ frame->mouse_moved = 1;
+ last_mouse_scroll_bar = Qnil;
+
+ note_mouse_highlight (frame, -1, -1);
+ }
+
+ /* Has the mouse moved off the glyph it was on at the last sighting? */
+ else if (LOWORD (msg->lParam) < last_mouse_glyph.left
+ || LOWORD (msg->lParam) > last_mouse_glyph.right
+ || HIWORD (msg->lParam) < last_mouse_glyph.left
+ || HIWORD (msg->lParam) > last_mouse_glyph.bottom)
+ {
+ frame->mouse_moved = 1;
+ last_mouse_scroll_bar = Qnil;
+
+ note_mouse_highlight (frame, LOWORD (msg->lParam), HIWORD (msg->lParam));
+ }
+}
+
+/* This is used for debugging, to turn off note_mouse_highlight. */
+static int disable_mouse_highlight;
+
+/* Take proper action when the mouse has moved to position X, Y on frame F
+ as regards highlighting characters that have mouse-face properties.
+ Also dehighlighting chars where the mouse was before.
+ X and Y can be negative or out of range. */
+
+static void
+note_mouse_highlight (f, x, y)
+ FRAME_PTR f;
+ int x, y;
+{
+ int row, column, portion;
+ RECT new_glyph;
+ Lisp_Object window;
+ struct window *w;
+
+ if (disable_mouse_highlight)
+ return;
+
+ FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_mouse_x = x;
+ FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_mouse_y = y;
+ FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_mouse_frame = f;
+
+ if (FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_defer)
+ return;
+
+ if (gc_in_progress)
+ {
+ FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_deferred_gc = 1;
+ return;
+ }
+
+ /* Find out which glyph the mouse is on. */
+ pixel_to_glyph_coords (f, x, y, &column, &row,
+ &new_glyph, FRAME_WIN32_DISPLAY_INFO (f)->grabbed);
+
+ /* Which window is that in? */
+ window = window_from_coordinates (f, column, row, &portion);
+ w = XWINDOW (window);
+
+ /* If we were displaying active text in another window, clear that. */
+ if (! EQ (window, FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_window))
+ clear_mouse_face (FRAME_WIN32_DISPLAY_INFO (f));
+
+ /* Are we in a window whose display is up to date?
+ And verify the buffer's text has not changed. */
+ if (WINDOWP (window) && portion == 0 && row >= 0 && column >= 0
+ && row < FRAME_HEIGHT (f) && column < FRAME_WIDTH (f)
+ && EQ (w->window_end_valid, w->buffer)
+ && w->last_modified == BUF_MODIFF (XBUFFER (w->buffer)))
+ {
+ int *ptr = FRAME_CURRENT_GLYPHS (f)->charstarts[row];
+ int i, pos;
+
+ /* Find which buffer position the mouse corresponds to. */
+ for (i = column; i >= 0; i--)
+ if (ptr[i] > 0)
+ break;
+ pos = ptr[i];
+ /* Is it outside the displayed active region (if any)? */
+ if (pos <= 0)
+ clear_mouse_face (FRAME_WIN32_DISPLAY_INFO (f));
+ else if (! (EQ (window, FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_window)
+ && row >= FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_row
+ && row <= FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_row
+ && (row > FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_row
+ || column >= FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_col)
+ && (row < FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_row
+ || column < FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_col
+ || FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_past_end)))
+ {
+ Lisp_Object mouse_face, overlay, position;
+ Lisp_Object *overlay_vec;
+ int len, noverlays, ignor1;
+ struct buffer *obuf;
+ int obegv, ozv;
+
+ /* If we get an out-of-range value, return now; avoid an error. */
+ if (pos > BUF_Z (XBUFFER (w->buffer)))
+ return;
+
+ /* Make the window's buffer temporarily current for
+ overlays_at and compute_char_face. */
+ obuf = current_buffer;
+ current_buffer = XBUFFER (w->buffer);
+ obegv = BEGV;
+ ozv = ZV;
+ BEGV = BEG;
+ ZV = Z;
+
+ /* Yes. Clear the display of the old active region, if any. */
+ clear_mouse_face (FRAME_WIN32_DISPLAY_INFO (f));
+
+ /* Is this char mouse-active? */
+ XSETINT (position, pos);
+
+ len = 10;
+ overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
+
+ /* Put all the overlays we want in a vector in overlay_vec.
+ Store the length in len. */
+ noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
+ NULL, NULL);
+ noverlays = sort_overlays (overlay_vec, noverlays, w);
+
+ /* Find the highest priority overlay that has a mouse-face prop. */
+ overlay = Qnil;
+ for (i = 0; i < noverlays; i++)
+ {
+ mouse_face = Foverlay_get (overlay_vec[i], Qmouse_face);
+ if (!NILP (mouse_face))
+ {
+ overlay = overlay_vec[i];
+ break;
+ }
+ }
+ free (overlay_vec);
+ /* If no overlay applies, get a text property. */
+ if (NILP (overlay))
+ mouse_face = Fget_text_property (position, Qmouse_face, w->buffer);
+
+ /* Handle the overlay case. */
+ if (! NILP (overlay))
+ {
+ /* Find the range of text around this char that
+ should be active. */
+ Lisp_Object before, after;
+ int ignore;
+
+ before = Foverlay_start (overlay);
+ after = Foverlay_end (overlay);
+ /* Record this as the current active region. */
+ fast_find_position (window, before,
+ &FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_col,
+ &FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_row);
+ FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_past_end
+ = !fast_find_position (window, after,
+ &FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_col,
+ &FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_row);
+ FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_window = window;
+ FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_face_id
+ = compute_char_face (f, w, pos, 0, 0,
+ &ignore, pos + 1, 1);
+
+ /* Display it as active. */
+ show_mouse_face (FRAME_WIN32_DISPLAY_INFO (f), 1);
+ }
+ /* Handle the text property case. */
+ else if (! NILP (mouse_face))
+ {
+ /* Find the range of text around this char that
+ should be active. */
+ Lisp_Object before, after, beginning, end;
+ int ignore;
+
+ beginning = Fmarker_position (w->start);
+ XSETINT (end, (BUF_Z (XBUFFER (w->buffer))
+ - XFASTINT (w->window_end_pos)));
+ before
+ = Fprevious_single_property_change (make_number (pos + 1),
+ Qmouse_face,
+ w->buffer, beginning);
+ after
+ = Fnext_single_property_change (position, Qmouse_face,
+ w->buffer, end);
+ /* Record this as the current active region. */
+ fast_find_position (window, before,
+ &FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_col,
+ &FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_row);
+ FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_past_end
+ = !fast_find_position (window, after,
+ &FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_col,
+ &FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_row);
+ FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_window = window;
+ FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_face_id
+ = compute_char_face (f, w, pos, 0, 0,
+ &ignore, pos + 1, 1);
+
+ /* Display it as active. */
+ show_mouse_face (FRAME_WIN32_DISPLAY_INFO (f), 1);
+ }
+ BEGV = obegv;
+ ZV = ozv;
+ current_buffer = obuf;
+ }
+ }
+}
+\f
+/* Find the row and column of position POS in window WINDOW.
+ Store them in *COLUMNP and *ROWP.
+ This assumes display in WINDOW is up to date.
+ If POS is above start of WINDOW, return coords
+ of start of first screen line.
+ If POS is after end of WINDOW, return coords of end of last screen line.
+
+ Value is 1 if POS is in range, 0 if it was off screen. */
+
+static int
+fast_find_position (window, pos, columnp, rowp)
+ Lisp_Object window;
+ int pos;
+ int *columnp, *rowp;
+{
+ struct window *w = XWINDOW (window);
+ FRAME_PTR f = XFRAME (WINDOW_FRAME (w));
+ int i;
+ int row = 0;
+ int left = w->left;
+ int top = w->top;
+ int height = XFASTINT (w->height) - ! MINI_WINDOW_P (w);
+ int width = window_internal_width (w);
+ int *charstarts;
+ int lastcol;
+ int maybe_next_line = 0;
+
+ /* Find the right row. */
+ for (i = 0;
+ i < height;
+ i++)
+ {
+ int linestart = FRAME_CURRENT_GLYPHS (f)->charstarts[top + i][left];
+ if (linestart > pos)
+ break;
+ /* If the position sought is the end of the buffer,
+ don't include the blank lines at the bottom of the window. */
+ if (linestart == pos && pos == BUF_ZV (XBUFFER (w->buffer)))
+ {
+ maybe_next_line = 1;
+ break;
+ }
+ if (linestart > 0)
+ row = i;
+ }
+
+ /* Find the right column with in it. */
+ charstarts = FRAME_CURRENT_GLYPHS (f)->charstarts[top + row];
+ lastcol = left;
+ for (i = 0; i < width; i++)
+ {
+ if (charstarts[left + i] == pos)
+ {
+ *rowp = row + top;
+ *columnp = i + left;
+ return 1;
+ }
+ else if (charstarts[left + i] > pos)
+ break;
+ else if (charstarts[left + i] > 0)
+ lastcol = left + i;
+ }
+
+ /* If we're looking for the end of the buffer,
+ and we didn't find it in the line we scanned,
+ use the start of the following line. */
+ if (maybe_next_line)
+ {
+ row++;
+ i = 0;
+ }
+
+ *rowp = row + top;
+ *columnp = lastcol;
+ return 0;
+}
+
+/* Display the active region described by mouse_face_*
+ in its mouse-face if HL > 0, in its normal face if HL = 0. */
+
+static void
+show_mouse_face (dpyinfo, hl)
+ struct win32_display_info *dpyinfo;
+ int hl;
+{
+ struct window *w = XWINDOW (dpyinfo->mouse_face_window);
+ int width = window_internal_width (w);
+ FRAME_PTR f = XFRAME (WINDOW_FRAME (w));
+ int i;
+ int cursor_off = 0;
+ int old_curs_x = curs_x;
+ int old_curs_y = curs_y;
+
+ /* Set these variables temporarily
+ so that if we have to turn the cursor off and on again
+ we will put it back at the same place. */
+ curs_x = f->phys_cursor_x;
+ curs_y = f->phys_cursor_y;
+
+ for (i = FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_row;
+ i <= FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_row; i++)
+ {
+ int column = (i == FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_row
+ ? FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_col
+ : w->left);
+ int endcolumn = (i == FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_row
+ ? FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_col
+ : w->left + width);
+ endcolumn = min (endcolumn, FRAME_CURRENT_GLYPHS (f)->used[i]);
+
+ /* If the cursor's in the text we are about to rewrite,
+ turn the cursor off. */
+ if (i == curs_y
+ && curs_x >= FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_col - 1
+ && curs_x <= FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_col)
+ {
+ x_display_cursor (f, 0);
+ cursor_off = 1;
+ }
+
+ dumpglyphs (f,
+ CHAR_TO_PIXEL_COL (f, column),
+ CHAR_TO_PIXEL_ROW (f, i),
+ FRAME_CURRENT_GLYPHS (f)->glyphs[i] + column,
+ endcolumn - column,
+ /* Highlight with mouse face if hl > 0. */
+ hl > 0 ? 3 : 0, 0);
+ }
+
+ /* If we turned the cursor off, turn it back on. */
+ if (cursor_off)
+ x_display_cursor (f, 1);
+
+ curs_x = old_curs_x;
+ curs_y = old_curs_y;
+
+ /* Change the mouse cursor according to the value of HL. */
+ if (hl > 0)
+ SetCursor (f->output_data.win32->cross_cursor);
+ else
+ SetCursor (f->output_data.win32->text_cursor);
+}
+
+/* Clear out the mouse-highlighted active region.
+ Redraw it unhighlighted first. */
+
+static void
+clear_mouse_face (dpyinfo)
+ struct win32_display_info *dpyinfo;
+{
+ if (! NILP (dpyinfo->mouse_face_window))
+ show_mouse_face (dpyinfo, 0);
+
+ dpyinfo->mouse_face_beg_row = dpyinfo->mouse_face_beg_col = -1;
+ dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_end_col = -1;
+ dpyinfo->mouse_face_window = Qnil;
+}
+\f
+struct scroll_bar *x_window_to_scroll_bar ();
+static void x_scroll_bar_report_motion ();
+
+/* Return the current position of the mouse.
+ *fp should be a frame which indicates which display to ask about.
+
+ If the mouse movement started in a scroll bar, set *fp, *bar_window,
+ and *part to the frame, window, and scroll bar part that the mouse
+ is over. Set *x and *y to the portion and whole of the mouse's
+ position on the scroll bar.
+
+ If the mouse movement started elsewhere, set *fp to the frame the
+ mouse is on, *bar_window to nil, and *x and *y to the character cell
+ the mouse is over.
+
+ Set *time to the server timestamp for the time at which the mouse
+ was at this position.
+
+ Don't store anything if we don't have a valid set of values to report.
+
+ This clears the mouse_moved flag, so we can wait for the next mouse
+ movement. This also calls XQueryPointer, which will cause the
+ server to give us another MotionNotify when the mouse moves
+ again. */
+
+static void
+win32_mouse_position (fp, insist, bar_window, part, x, y, time)
+ FRAME_PTR *fp;
+ int insist;
+ Lisp_Object *bar_window;
+ enum scroll_bar_part *part;
+ Lisp_Object *x, *y;
+ unsigned long *time;
+{
+ FRAME_PTR f1;
+
+ BLOCK_INPUT;
+
+ if (! NILP (last_mouse_scroll_bar))
+ x_scroll_bar_report_motion (fp, bar_window, part, x, y, time);
+ else
+ {
+ POINT pt;
+
+ Lisp_Object frame, tail;
+
+ /* Clear the mouse-moved flag for every frame on this display. */
+ FOR_EACH_FRAME (tail, frame)
+ XFRAME (frame)->mouse_moved = 0;
+
+ last_mouse_scroll_bar = Qnil;
+
+ GetCursorPos (&pt);
+
+ /* Now we have a position on the root; find the innermost window
+ containing the pointer. */
+ {
+ if (FRAME_WIN32_DISPLAY_INFO (*fp)->grabbed && last_mouse_frame
+ && FRAME_LIVE_P (last_mouse_frame))
+ {
+ f1 = last_mouse_frame;
+ }
+ else
+ {
+ /* Is win one of our frames? */
+ f1 = x_window_to_frame (FRAME_WIN32_DISPLAY_INFO (*fp), WindowFromPoint(pt));
+ }
+
+ /* If not, is it one of our scroll bars? */
+ if (! f1)
+ {
+ struct scroll_bar *bar = x_window_to_scroll_bar (WindowFromPoint(pt));
+
+ if (bar)
+ {
+ f1 = XFRAME (WINDOW_FRAME (XWINDOW (bar->window)));
+ }
+ }
+
+ if (f1 == 0 && insist)
+ f1 = selected_frame;
+
+ if (f1)
+ {
+ int ignore1, ignore2;
+
+ ScreenToClient (FRAME_WIN32_WINDOW (f1), &pt);
+
+ /* Ok, we found a frame. Store all the values. */
+
+ pixel_to_glyph_coords (f1, pt.x, pt.y, &ignore1, &ignore2,
+ &last_mouse_glyph,
+ FRAME_WIN32_DISPLAY_INFO (f1)->grabbed
+ || insist);
+
+ *bar_window = Qnil;
+ *part = 0;
+ *fp = f1;
+ XSETINT (*x, pt.x);
+ XSETINT (*y, pt.y);
+ *time = last_mouse_movement_time;
+ }
+ }
+ }
+
+ UNBLOCK_INPUT;
+}
+\f
+/* Scroll bar support. */
+
+/* Given an window ID, find the struct scroll_bar which manages it.
+ This can be called in GC, so we have to make sure to strip off mark
+ bits. */
+struct scroll_bar *
+x_window_to_scroll_bar (window_id)
+ Window window_id;
+{
+ Lisp_Object tail, frame;
+
+ for (tail = Vframe_list;
+ XGCTYPE (tail) == Lisp_Cons;
+ tail = XCONS (tail)->cdr)
+ {
+ Lisp_Object frame, bar, condemned;
+
+ frame = XCONS (tail)->car;
+ /* All elements of Vframe_list should be frames. */
+ if (! GC_FRAMEP (frame))
+ abort ();
+
+ /* Scan this frame's scroll bar list for a scroll bar with the
+ right window ID. */
+ condemned = FRAME_CONDEMNED_SCROLL_BARS (XFRAME (frame));
+ for (bar = FRAME_SCROLL_BARS (XFRAME (frame));
+ /* This trick allows us to search both the ordinary and
+ condemned scroll bar lists with one loop. */
+ ! GC_NILP (bar) || (bar = condemned,
+ condemned = Qnil,
+ ! GC_NILP (bar));
+ bar = XSCROLL_BAR (bar)->next)
+ if (SCROLL_BAR_WIN32_WINDOW (XSCROLL_BAR (bar)) == window_id)
+ return XSCROLL_BAR (bar);
+ }
+
+ return 0;
+}
+
+HWND
+my_create_scrollbar (f, bar)
+ struct frame * f;
+ struct scroll_bar * bar;
+{
+ MSG msg;
+
+ PostThreadMessage (dwWinThreadId, WM_EMACS_CREATESCROLLBAR, (WPARAM) f,
+ (LPARAM) bar);
+ GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
+
+ return ((HWND) msg.wParam);
+}
+
+void
+my_destroy_window (f, hwnd)
+ struct frame * f;
+ HWND hwnd;
+{
+ SendMessage (FRAME_WIN32_WINDOW (f), WM_EMACS_DESTROYWINDOW,
+ (WPARAM) hwnd, 0);
+}
+
+/* Open a new window to serve as a scroll bar, and return the
+ scroll bar vector for it. */
+static struct scroll_bar *
+x_scroll_bar_create (window, top, left, width, height)
+ struct window *window;
+ int top, left, width, height;
+{
+ FRAME_PTR f = XFRAME (WINDOW_FRAME (window));
+ struct scroll_bar *bar
+ = XSCROLL_BAR (Fmake_vector (make_number (SCROLL_BAR_VEC_SIZE), Qnil));
+ HWND hwnd;
+
+ BLOCK_INPUT;
+
+ XSETWINDOW (bar->window, window);
+ XSETINT (bar->top, top);
+ XSETINT (bar->left, left);
+ XSETINT (bar->width, width);
+ XSETINT (bar->height, height);
+ XSETINT (bar->start, 0);
+ XSETINT (bar->end, 0);
+ bar->dragging = Qnil;
+
+ /* Requires geometry to be set before call to create the real window */
+
+ hwnd = my_create_scrollbar (f, bar);
+
+ SetScrollRange (hwnd, SB_CTL, 0, height, FALSE);
+ SetScrollPos (hwnd, SB_CTL, 0, TRUE);
+
+ SET_SCROLL_BAR_WIN32_WINDOW (bar, hwnd);
+
+ /* Add bar to its frame's list of scroll bars. */
+ bar->next = FRAME_SCROLL_BARS (f);
+ bar->prev = Qnil;
+ XSETVECTOR (FRAME_SCROLL_BARS (f), bar);
+ if (! NILP (bar->next))
+ XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar);
+
+ UNBLOCK_INPUT;
+
+ return bar;
+}
+
+/* Draw BAR's handle in the proper position.
+ If the handle is already drawn from START to END, don't bother
+ redrawing it, unless REBUILD is non-zero; in that case, always
+ redraw it. (REBUILD is handy for drawing the handle after expose
+ events.)
+
+ Normally, we want to constrain the start and end of the handle to
+ fit inside its rectangle, but if the user is dragging the scroll bar
+ handle, we want to let them drag it down all the way, so that the
+ bar's top is as far down as it goes; otherwise, there's no way to
+ move to the very end of the buffer. */
+static void
+x_scroll_bar_set_handle (bar, start, end, rebuild)
+ struct scroll_bar *bar;
+ int start, end;
+ int rebuild;
+{
+ int dragging = ! NILP (bar->dragging);
+ Window w = SCROLL_BAR_WIN32_WINDOW (bar);
+ FRAME_PTR f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window)));
+
+ /* If the display is already accurate, do nothing. */
+ if (! rebuild
+ && start == XINT (bar->start)
+ && end == XINT (bar->end))
+ return;
+
+ BLOCK_INPUT;
+
+ /* Store the adjusted setting in the scroll bar. */
+ XSETINT (bar->start, start);
+ XSETINT (bar->end, end);
+
+ /* If we are less than half of the page use start otherwise use end */
+
+ SetScrollPos (w, SB_CTL, ((start >> 1) < bar->height)?start:end, TRUE);
+
+ UNBLOCK_INPUT;
+}
+
+/* Move a scroll bar around on the screen, to accommodate changing
+ window configurations. */
+static void
+x_scroll_bar_move (bar, top, left, width, height)
+ struct scroll_bar *bar;
+ int top, left, width, height;
+{
+ Window w = SCROLL_BAR_WIN32_WINDOW (bar);
+ FRAME_PTR f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window)));
+
+ BLOCK_INPUT;
+
+ MoveWindow (w, left, top, width, height, TRUE);
+ SetScrollRange (w, SB_CTL, 0, height, FALSE);
+
+ XSETINT (bar->left, left);
+ XSETINT (bar->top, top);
+ XSETINT (bar->width, width);
+ XSETINT (bar->height, height);
+
+ UNBLOCK_INPUT;
+}
+
+/* Destroy the window for BAR, and set its Emacs window's scroll bar
+ to nil. */
+static void
+x_scroll_bar_remove (bar)
+ struct scroll_bar *bar;
+{
+ FRAME_PTR f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window)));
+
+ BLOCK_INPUT;
+
+ /* Destroy the window. */
+ my_destroy_window (f, SCROLL_BAR_WIN32_WINDOW (bar));
+
+ /* Disassociate this scroll bar from its window. */
+ XWINDOW (bar->window)->vertical_scroll_bar = Qnil;
+
+ UNBLOCK_INPUT;
+}
+
+/* Set the handle of the vertical scroll bar for WINDOW to indicate
+ that we are displaying PORTION characters out of a total of WHOLE
+ characters, starting at POSITION. If WINDOW has no scroll bar,
+ create one. */
+static void
+win32_set_vertical_scroll_bar (window, portion, whole, position)
+ struct window *window;
+ int portion, whole, position;
+{
+ FRAME_PTR f = XFRAME (WINDOW_FRAME (window));
+ int top = XINT (window->top);
+ int left = WINDOW_VERTICAL_SCROLL_BAR_COLUMN (window);
+ int height = WINDOW_VERTICAL_SCROLL_BAR_HEIGHT (window);
+
+ /* Where should this scroll bar be, pixelwise? */
+ int pixel_top = CHAR_TO_PIXEL_ROW (f, top);
+ int pixel_left = CHAR_TO_PIXEL_COL (f, left);
+ int pixel_width
+ = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0
+ ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
+ : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.win32->font)));
+ int pixel_height = VERTICAL_SCROLL_BAR_PIXEL_HEIGHT (f, height);
+
+ struct scroll_bar *bar;
+
+ /* Does the scroll bar exist yet? */
+ if (NILP (window->vertical_scroll_bar))
+ bar = x_scroll_bar_create (window,
+ pixel_top, pixel_left,
+ pixel_width, pixel_height);
+ else
+ {
+ /* It may just need to be moved and resized. */
+ bar = XSCROLL_BAR (window->vertical_scroll_bar);
+ x_scroll_bar_move (bar, pixel_top, pixel_left, pixel_width, pixel_height);
+ }
+
+ /* Set the scroll bar's current state, unless we're currently being
+ dragged. */
+ if (NILP (bar->dragging))
+ {
+ int top_range = VERTICAL_SCROLL_BAR_TOP_RANGE (pixel_height);
+
+ if (whole == 0)
+ x_scroll_bar_set_handle (bar, 0, top_range, 0);
+ else
+ {
+ int start = (int) (((double) position * top_range) / whole);
+ int end = (int) (((double) (position + portion) * top_range) / whole);
+
+ x_scroll_bar_set_handle (bar, start, end, 0);
+ }
+ }
+
+ XSETVECTOR (window->vertical_scroll_bar, bar);
+}
+
+
+/* The following three hooks are used when we're doing a thorough
+ redisplay of the frame. We don't explicitly know which scroll bars
+ are going to be deleted, because keeping track of when windows go
+ away is a real pain - "Can you say set-window-configuration, boys
+ and girls?" Instead, we just assert at the beginning of redisplay
+ that *all* scroll bars are to be removed, and then save a scroll bar
+ from the fiery pit when we actually redisplay its window. */
+
+/* Arrange for all scroll bars on FRAME to be removed at the next call
+ to `*judge_scroll_bars_hook'. A scroll bar may be spared if
+ `*redeem_scroll_bar_hook' is applied to its window before the judgement. */
+static void
+win32_condemn_scroll_bars (frame)
+ FRAME_PTR frame;
+{
+ /* The condemned list should be empty at this point; if it's not,
+ then the rest of Emacs isn't using the condemn/redeem/judge
+ protocol correctly. */
+ if (! NILP (FRAME_CONDEMNED_SCROLL_BARS (frame)))
+ abort ();
+
+ /* Move them all to the "condemned" list. */
+ FRAME_CONDEMNED_SCROLL_BARS (frame) = FRAME_SCROLL_BARS (frame);
+ FRAME_SCROLL_BARS (frame) = Qnil;
+}
+
+/* Unmark WINDOW's scroll bar for deletion in this judgement cycle.
+ Note that WINDOW isn't necessarily condemned at all. */
+static void
+win32_redeem_scroll_bar (window)
+ struct window *window;
+{
+ struct scroll_bar *bar;
+
+ /* We can't redeem this window's scroll bar if it doesn't have one. */
+ if (NILP (window->vertical_scroll_bar))
+ abort ();
+
+ bar = XSCROLL_BAR (window->vertical_scroll_bar);
+
+ /* Unlink it from the condemned list. */
+ {
+ FRAME_PTR f = XFRAME (WINDOW_FRAME (window));
+
+ if (NILP (bar->prev))
+ {
+ /* If the prev pointer is nil, it must be the first in one of
+ the lists. */
+ if (EQ (FRAME_SCROLL_BARS (f), window->vertical_scroll_bar))
+ /* It's not condemned. Everything's fine. */
+ return;
+ else if (EQ (FRAME_CONDEMNED_SCROLL_BARS (f),
+ window->vertical_scroll_bar))
+ FRAME_CONDEMNED_SCROLL_BARS (f) = bar->next;
+ else
+ /* If its prev pointer is nil, it must be at the front of
+ one or the other! */
+ abort ();
+ }
+ else
+ XSCROLL_BAR (bar->prev)->next = bar->next;
+
+ if (! NILP (bar->next))
+ XSCROLL_BAR (bar->next)->prev = bar->prev;
+
+ bar->next = FRAME_SCROLL_BARS (f);
+ bar->prev = Qnil;
+ XSETVECTOR (FRAME_SCROLL_BARS (f), bar);
+ if (! NILP (bar->next))
+ XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar);
+ }
+}
+
+/* Remove all scroll bars on FRAME that haven't been saved since the
+ last call to `*condemn_scroll_bars_hook'. */
+static void
+win32_judge_scroll_bars (f)
+ FRAME_PTR f;
+{
+ Lisp_Object bar, next;
+
+ bar = FRAME_CONDEMNED_SCROLL_BARS (f);
+
+ /* Clear out the condemned list now so we won't try to process any
+ more events on the hapless scroll bars. */
+ FRAME_CONDEMNED_SCROLL_BARS (f) = Qnil;
+
+ for (; ! NILP (bar); bar = next)
+ {
+ struct scroll_bar *b = XSCROLL_BAR (bar);
+
+ x_scroll_bar_remove (b);
+
+ next = b->next;
+ b->next = b->prev = Qnil;
+ }
+
+ /* Now there should be no references to the condemned scroll bars,
+ and they should get garbage-collected. */
+}
+
+/* Handle a mouse click on the scroll bar BAR. If *EMACS_EVENT's kind
+ is set to something other than no_event, it is enqueued.
+
+ This may be called from a signal handler, so we have to ignore GC
+ mark bits. */
+static void
+x_scroll_bar_handle_click (bar, msg, emacs_event)
+ struct scroll_bar *bar;
+ Win32Msg *msg;
+ struct input_event *emacs_event;
+{
+ if (! GC_WINDOWP (bar->window))
+ abort ();
+
+ emacs_event->kind = scroll_bar_click;
+ emacs_event->code = 0;
+ emacs_event->modifiers = (msg->dwModifiers
+ | ((LOWORD (msg->msg.wParam) == SB_ENDSCROLL)
+ ? up_modifier
+ : down_modifier));
+ emacs_event->frame_or_window = bar->window;
+ emacs_event->timestamp = msg->msg.time;
+
+ {
+ int internal_height
+ = VERTICAL_SCROLL_BAR_INSIDE_HEIGHT (XINT (bar->height));
+ int top_range
+ = VERTICAL_SCROLL_BAR_TOP_RANGE (XINT (bar->height));
+ int y = GetScrollPos ((HWND) msg->msg.lParam, SB_CTL);
+
+ switch (LOWORD (msg->msg.wParam))
+ {
+ case SB_THUMBPOSITION:
+ case SB_THUMBTRACK:
+ emacs_event->part = scroll_bar_handle;
+ if (VERTICAL_SCROLL_BAR_TOP_RANGE (XINT (bar->height)) <= 0xffff)
+ y = HIWORD (msg->msg.wParam);
+ break;
+ case SB_LINEDOWN:
+ emacs_event->part = scroll_bar_handle;
+ if (y < top_range) y++;
+ break;
+ case SB_LINEUP:
+ emacs_event->part = scroll_bar_handle;
+ if (y) y--;
+ break;
+ case SB_PAGEUP:
+ emacs_event->part = scroll_bar_above_handle;
+ break;
+ case SB_PAGEDOWN:
+ emacs_event->part = scroll_bar_below_handle;
+ break;
+ case SB_TOP:
+ emacs_event->part = scroll_bar_handle;
+ y = 0;
+ break;
+ case SB_BOTTOM:
+ emacs_event->part = scroll_bar_handle;
+ y = top_range;
+ break;
+ case SB_ENDSCROLL:
+ emacs_event->part = scroll_bar_handle;
+ x_scroll_bar_set_handle (bar, y , y, 0);
+ break;
+ default:
+ emacs_event->part = scroll_bar_handle;
+ break;
+ }
+
+ XSETINT (emacs_event->x, y);
+ XSETINT (emacs_event->y, top_range);
+ }
+}
+
+/* Return information to the user about the current position of the mouse
+ on the scroll bar. */
+static void
+x_scroll_bar_report_motion (fp, bar_window, part, x, y, time)
+ FRAME_PTR *fp;
+ Lisp_Object *bar_window;
+ enum scroll_bar_part *part;
+ Lisp_Object *x, *y;
+ unsigned long *time;
+{
+ struct scroll_bar *bar = XSCROLL_BAR (last_mouse_scroll_bar);
+ Window w = SCROLL_BAR_WIN32_WINDOW (bar);
+ FRAME_PTR f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window)));
+ int pos;
+
+ BLOCK_INPUT;
+
+ *fp = f;
+ *bar_window = bar->window;
+
+ pos = GetScrollPos (w, SB_CTL);
+
+ switch (LOWORD (last_mouse_scroll_bar_pos))
+ {
+ case SB_THUMBPOSITION:
+ case SB_THUMBTRACK:
+ *part = scroll_bar_handle;
+ if (VERTICAL_SCROLL_BAR_TOP_RANGE (XINT (bar->height)) <= 0xffff)
+ pos = HIWORD (last_mouse_scroll_bar_pos);
+ break;
+ case SB_LINEDOWN:
+ *part = scroll_bar_handle;
+ pos++;
+ break;
+ default:
+ *part = scroll_bar_handle;
+ break;
+ }
+
+ XSETINT(*x, pos);
+ XSETINT(*y, VERTICAL_SCROLL_BAR_TOP_RANGE (XINT (bar->height)));
+
+ f->mouse_moved = 0;
+ last_mouse_scroll_bar = Qnil;
+
+ *time = last_mouse_movement_time;
+
+ UNBLOCK_INPUT;
+}
+
+/* The screen has been cleared so we may have changed foreground or
+ background colors, and the scroll bars may need to be redrawn.
+ Clear out the scroll bars, and ask for expose events, so we can
+ redraw them. */
+
+x_scroll_bar_clear (f)
+ FRAME_PTR f;
+{
+#if 0
+ Lisp_Object bar;
+
+ for (bar = FRAME_SCROLL_BARS (f); VECTORP (bar);
+ bar = XSCROLL_BAR (bar)->next)
+ UpdateWindow (SCROLL_BAR_WIN32_WINDOW (XSCROLL_BAR (bar)));
+#endif
+}
+
+\f
+/* The main Win32 event-reading loop - w32_read_socket. */
+
+/* Timestamp of enter window event. This is only used by w32_read_socket,
+ but we have to put it out here, since static variables within functions
+ sometimes don't work. */
+static Time enter_timestamp;
+
+/* Record the last 100 characters stored
+ to help debug the loss-of-chars-during-GC problem. */
+int temp_index;
+short temp_buffer[100];
+
+/* Read events coming from the Win32 shell.
+ This routine is called by the SIGIO handler.
+ We return as soon as there are no more events to be read.
+
+ Events representing keys are stored in buffer BUFP,
+ which can hold up to NUMCHARS characters.
+ We return the number of characters stored into the buffer,
+ thus pretending to be `read'.
+
+ WAITP is nonzero if we should block until input arrives.
+ EXPECTED is nonzero if the caller knows input is available.
+
+ Some of these messages are reposted back to the message queue since the
+ system calls the winproc directly in a context where we cannot return the
+ data nor can we guarantee the state we are in. So if we dispatch them
+ we will get into an infinite loop. To prevent this from ever happening we
+ will set a variable to indicate we are in the read_socket call and indicate
+ which message we are processing since the winproc gets called recursively with different
+ messages by the system.
+*/
+
+int
+w32_read_socket (sd, bufp, numchars, waitp, expected)
+ register int sd;
+ register struct input_event *bufp;
+ register int numchars;
+ int waitp;
+ int expected;
+{
+ int count = 0;
+ int nbytes = 0;
+ int items_pending; /* How many items are in the X queue. */
+ Win32Msg msg;
+ struct frame *f;
+ int event_found = 0;
+ int prefix;
+ Lisp_Object part;
+ struct win32_display_info *dpyinfo = &one_win32_display_info;
+
+ if (interrupt_input_blocked)
+ {
+ interrupt_input_pending = 1;
+ return -1;
+ }
+
+ interrupt_input_pending = 0;
+ BLOCK_INPUT;
+
+ /* So people can tell when we have read the available input. */
+ input_signal_count++;
+
+ if (numchars <= 0)
+ abort (); /* Don't think this happens. */
+
+ while (get_next_msg (&msg, 0))
+ {
+ switch (msg.msg.message)
+ {
+ case WM_ERASEBKGND:
+ f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
+ if (f)
+ {
+ win32_clear_rect (f, NULL, &msg.rect);
+ }
+ break;
+ case WM_PAINT:
+ {
+ f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
+
+ if (f)
+ {
+ if (f->async_visible == 0)
+ {
+ f->async_visible = 1;
+ f->async_iconified = 0;
+ SET_FRAME_GARBAGED (f);
+ }
+ else
+ {
+ dumprectangle (f,
+ msg.rect.left,
+ msg.rect.top,
+ msg.rect.right-msg.rect.left+1,
+ msg.rect.bottom-msg.rect.top+1);
+
+ }
+ }
+ }
+
+ break;
+ case WM_KEYDOWN:
+ case WM_SYSKEYDOWN:
+ f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
+
+ if (f && !f->iconified)
+ {
+ if (temp_index == sizeof temp_buffer / sizeof (short))
+ temp_index = 0;
+ temp_buffer[temp_index++] = msg.msg.wParam;
+ bufp->kind = non_ascii_keystroke;
+ bufp->code = msg.msg.wParam;
+ bufp->modifiers = msg.dwModifiers;
+ XSETFRAME (bufp->frame_or_window, f);
+ bufp->timestamp = msg.msg.time;
+ bufp++;
+ numchars--;
+ count++;
+ }
+ break;
+ case WM_SYSCHAR:
+ case WM_CHAR:
+ f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
+
+ if (f && !f->iconified)
+ {
+ if (numchars > 1)
+ {
+ if (temp_index == sizeof temp_buffer / sizeof (short))
+ temp_index = 0;
+ temp_buffer[temp_index++] = msg.msg.wParam;
+ bufp->kind = ascii_keystroke;
+ bufp->code = msg.msg.wParam;
+ XSETFRAME (bufp->frame_or_window, f);
+ bufp->modifiers = msg.dwModifiers;
+ bufp->timestamp = msg.msg.time;
+ bufp++;
+ numchars--;
+ count++;
+ }
+ else
+ {
+ abort ();
+ }
+ }
+ break;
+ case WM_MOUSEMOVE:
+ if (dpyinfo->grabbed && last_mouse_frame
+ && FRAME_LIVE_P (last_mouse_frame))
+ f = last_mouse_frame;
+ else
+ f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
+
+ if (f)
+ note_mouse_movement (f, &msg.msg);
+ else
+ clear_mouse_face (FRAME_WIN32_DISPLAY_INFO (f));
+
+ break;
+ case WM_LBUTTONDOWN:
+ case WM_LBUTTONUP:
+ case WM_MBUTTONDOWN:
+ case WM_MBUTTONUP:
+ case WM_RBUTTONDOWN:
+ case WM_RBUTTONUP:
+ {
+ int button;
+ int up;
+
+ if (dpyinfo->grabbed && last_mouse_frame
+ && FRAME_LIVE_P (last_mouse_frame))
+ f = last_mouse_frame;
+ else
+ f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
+
+ if (f)
+ {
+ if ((!dpyinfo->win32_focus_frame || f == dpyinfo->win32_focus_frame)
+ && (numchars >= 1))
+ {
+ construct_mouse_click (bufp, &msg, f);
+ bufp++;
+ count++;
+ numchars--;
+ }
+ }
+
+ parse_button (msg.msg.message, &button, &up);
+
+ if (up)
+ {
+ dpyinfo->grabbed &= ~ (1 << button);
+ }
+ else
+ {
+ dpyinfo->grabbed |= (1 << button);
+ last_mouse_frame = f;
+ }
+ }
+
+ break;
+ case WM_VSCROLL:
+ {
+ struct scroll_bar *bar = x_window_to_scroll_bar ((HWND)msg.msg.lParam);
+
+ if (bar && numchars >= 1)
+ {
+ x_scroll_bar_handle_click (bar, &msg, bufp);
+ bufp++;
+ count++;
+ numchars--;
+ }
+ }
+
+ break;
+ case WM_MOVE:
+ f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
+
+ if (f && !f->async_iconified)
+ {
+ f->output_data.win32->left_pos = LOWORD (msg.msg.lParam);
+ f->output_data.win32->top_pos = HIWORD (msg.msg.lParam);
+ }
+
+ break;
+ case WM_SIZE:
+ f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
+
+ if (f && !f->async_iconified && msg.msg.wParam != SIZE_MINIMIZED)
+ {
+ RECT rect;
+ int rows;
+ int columns;
+ int width;
+ int height;
+
+ GetClientRect(msg.msg.hwnd, &rect);
+
+ height = rect.bottom - rect.top + 1;
+ width = rect.right - rect.left + 1;
+
+ rows = PIXEL_TO_CHAR_HEIGHT (f, height);
+ columns = PIXEL_TO_CHAR_WIDTH (f, width);
+
+ /* Even if the number of character rows and columns has
+ not changed, the font size may have changed, so we need
+ to check the pixel dimensions as well. */
+
+ if (columns != f->width
+ || rows != f->height
+ || width != f->output_data.win32->pixel_width
+ || height != f->output_data.win32->pixel_height)
+ {
+ /* I had set this to 0, 0 - I am not sure why?? */
+
+ change_frame_size (f, rows, columns, 0, 1);
+ SET_FRAME_GARBAGED (f);
+
+ f->output_data.win32->pixel_width = width;
+ f->output_data.win32->pixel_height = height;
+ f->output_data.win32->win_gravity = NorthWestGravity;
+ }
+ }
+
+ break;
+ case WM_SETFOCUS:
+ case WM_KILLFOCUS:
+ f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
+
+ if (msg.msg.message == WM_SETFOCUS)
+ {
+ x_new_focus_frame (dpyinfo, f);
+ }
+ else if (f == dpyinfo->win32_focus_frame)
+ x_new_focus_frame (dpyinfo, 0);
+
+ break;
+ case WM_SYSCOMMAND:
+ switch (msg.msg.wParam)
+ {
+ case SC_CLOSE:
+ f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
+
+ if (f)
+ {
+ if (numchars == 0)
+ abort ();
+
+ bufp->kind = delete_window_event;
+ XSETFRAME (bufp->frame_or_window, f);
+ bufp++;
+ count++;
+ numchars--;
+ }
+
+ break;
+ case SC_MINIMIZE:
+ f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
+
+ if (f)
+ {
+ f->async_visible = 1;
+ f->async_iconified = 1;
+
+ bufp->kind = iconify_event;
+ XSETFRAME (bufp->frame_or_window, f);
+ bufp++;
+ count++;
+ numchars--;
+ }
+
+ break;
+ case SC_MAXIMIZE:
+ case SC_RESTORE:
+ f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
+
+ if (f)
+ {
+ f->async_visible = 1;
+ f->async_iconified = 0;
+
+ /* wait_reading_process_input will notice this and update
+ the frame's display structures. */
+ SET_FRAME_GARBAGED (f);
+
+ if (f->iconified)
+ {
+ bufp->kind = deiconify_event;
+ XSETFRAME (bufp->frame_or_window, f);
+ bufp++;
+ count++;
+ numchars--;
+ }
+ else
+ /* Force a redisplay sooner or later
+ to update the frame titles
+ in case this is the second frame. */
+ record_asynch_buffer_change ();
+ }
+
+ break;
+ }
+
+ break;
+ case WM_CLOSE:
+ f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
+
+ if (f)
+ {
+ if (numchars == 0)
+ abort ();
+
+ bufp->kind = delete_window_event;
+ XSETFRAME (bufp->frame_or_window, f);
+ bufp++;
+ count++;
+ numchars--;
+ }
+
+ break;
+ case WM_COMMAND:
+ f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
+
+ if (f)
+ {
+ if (msg.msg.lParam == 0)
+ {
+ /* Came from window menu */
+
+ extern Lisp_Object get_frame_menubar_event ();
+ Lisp_Object event = get_frame_menubar_event (f, msg.msg.wParam);
+ struct input_event buf;
+ Lisp_Object frame;
+
+ XSETFRAME (frame, f);
+ buf.kind = menu_bar_event;
+
+ /* Store initial menu bar event */
+
+ if (!NILP (event))
+ {
+ buf.frame_or_window = Fcons (frame, Fcons (Qmenu_bar, Qnil));
+ kbd_buffer_store_event (&buf);
+ }
+
+ /* Enqueue the events */
+
+ while (!NILP (event))
+ {
+ buf.frame_or_window = Fcons (frame, XCONS (event)->car);
+ kbd_buffer_store_event (&buf);
+ event = XCONS (event)->cdr;
+ }
+ }
+ else
+ {
+ /* Came from popup menu */
+ }
+ }
+ break;
+ }
+ }
+
+ /* If the focus was just given to an autoraising frame,
+ raise it now. */
+ /* ??? This ought to be able to handle more than one such frame. */
+ if (pending_autoraise_frame)
+ {
+ x_raise_frame (pending_autoraise_frame);
+ pending_autoraise_frame = 0;
+ }
+
+ UNBLOCK_INPUT;
+ return count;
+}
+\f
+/* Drawing the cursor. */
+
+
+/* Draw a hollow box cursor. Don't change the inside of the box. */
+
+static void
+x_draw_box (f)
+ struct frame *f;
+{
+ RECT rect;
+ HBRUSH hb;
+ HDC hdc;
+
+ hdc = my_get_dc (FRAME_WIN32_WINDOW (f));
+
+ hb = CreateSolidBrush (f->output_data.win32->cursor_pixel);
+
+ rect.left = CHAR_TO_PIXEL_COL (f, curs_x);
+ rect.top = CHAR_TO_PIXEL_ROW (f, curs_y);
+ rect.right = rect.left + FONT_WIDTH (f->output_data.win32->font) - 1;
+ rect.bottom = rect.top + f->output_data.win32->line_height - 1;
+
+ /* rect.left++; */
+ /* rect.top++; */
+ rect.right--;
+ rect.bottom--;
+
+ FrameRect (hdc, &rect, hb);
+
+ DeleteObject (hb);
+
+ ReleaseDC (FRAME_WIN32_WINDOW (f), hdc);
+}
+
+/* Clear the cursor of frame F to background color,
+ and mark the cursor as not shown.
+ This is used when the text where the cursor is
+ is about to be rewritten. */
+
+static void
+clear_cursor (f)
+ struct frame *f;
+{
+ if (! FRAME_VISIBLE_P (f)
+ || f->phys_cursor_x < 0)
+ return;
+
+ x_display_cursor (f, 0);
+ f->phys_cursor_x = -1;
+}
+
+/* Redraw the glyph at ROW, COLUMN on frame F, in the style
+ HIGHLIGHT. HIGHLIGHT is as defined for dumpglyphs. Return the
+ glyph drawn. */
+
+static void
+x_draw_single_glyph (f, row, column, glyph, highlight)
+ struct frame *f;
+ int row, column;
+ GLYPH glyph;
+ int highlight;
+{
+ dumpglyphs (f,
+ CHAR_TO_PIXEL_COL (f, column),
+ CHAR_TO_PIXEL_ROW (f, row),
+ &glyph, 1, highlight, 0);
+}
+
+static void
+x_display_bar_cursor (f, on)
+ struct frame *f;
+ int on;
+{
+ struct frame_glyphs *current_glyphs = FRAME_CURRENT_GLYPHS (f);
+
+ /* This is pointless on invisible frames, and dangerous on garbaged
+ frames; in the latter case, the frame may be in the midst of
+ changing its size, and curs_x and curs_y may be off the frame. */
+ if (! FRAME_VISIBLE_P (f) || FRAME_GARBAGED_P (f))
+ return;
+
+ if (! on && f->phys_cursor_x < 0)
+ return;
+
+ /* If we're not updating, then we want to use the current frame's
+ cursor position, not our local idea of where the cursor ought to be. */
+ if (f != updating_frame)
+ {
+ curs_x = FRAME_CURSOR_X (f);
+ curs_y = FRAME_CURSOR_Y (f);
+ }
+
+ /* If there is anything wrong with the current cursor state, remove it. */
+ if (f->phys_cursor_x >= 0
+ && (!on
+ || f->phys_cursor_x != curs_x
+ || f->phys_cursor_y != curs_y
+ || f->output_data.win32->current_cursor != bar_cursor))
+ {
+ /* Erase the cursor by redrawing the character underneath it. */
+ x_draw_single_glyph (f, f->phys_cursor_y, f->phys_cursor_x,
+ f->phys_cursor_glyph,
+ current_glyphs->highlight[f->phys_cursor_y]);
+ f->phys_cursor_x = -1;
+ }
+
+ /* If we now need a cursor in the new place or in the new form, do it so. */
+ if (on
+ && (f->phys_cursor_x < 0
+ || (f->output_data.win32->current_cursor != bar_cursor)))
+ {
+ f->phys_cursor_glyph
+ = ((current_glyphs->enable[curs_y]
+ && curs_x < current_glyphs->used[curs_y])
+ ? current_glyphs->glyphs[curs_y][curs_x]
+ : SPACEGLYPH);
+ win32_fill_area (f, NULL, f->output_data.win32->cursor_pixel,
+ CHAR_TO_PIXEL_COL (f, curs_x),
+ CHAR_TO_PIXEL_ROW (f, curs_y),
+ max (f->output_data.win32->cursor_width, 1),
+ f->output_data.win32->line_height);
+
+ f->phys_cursor_x = curs_x;
+ f->phys_cursor_y = curs_y;
+
+ f->output_data.win32->current_cursor = bar_cursor;
+ }
+}
+
+
+/* Turn the displayed cursor of frame F on or off according to ON.
+ If ON is nonzero, where to put the cursor is specified
+ by F->cursor_x and F->cursor_y. */
+
+static void
+x_display_box_cursor (f, on)
+ struct frame *f;
+ int on;
+{
+ struct frame_glyphs *current_glyphs = FRAME_CURRENT_GLYPHS (f);
+
+ /* This is pointless on invisible frames, and dangerous on garbaged
+ frames; in the latter case, the frame may be in the midst of
+ changing its size, and curs_x and curs_y may be off the frame. */
+ if (! FRAME_VISIBLE_P (f) || FRAME_GARBAGED_P (f))
+ return;
+
+ /* If cursor is off and we want it off, return quickly. */
+ if (!on && f->phys_cursor_x < 0)
+ return;
+
+ /* If we're not updating, then we want to use the current frame's
+ cursor position, not our local idea of where the cursor ought to be. */
+ if (f != updating_frame)
+ {
+ curs_x = FRAME_CURSOR_X (f);
+ curs_y = FRAME_CURSOR_Y (f);
+ }
+
+ /* If cursor is currently being shown and we don't want it to be
+ or it is in the wrong place,
+ or we want a hollow box and it's not so, (pout!)
+ erase it. */
+ if (f->phys_cursor_x >= 0
+ && (!on
+ || f->phys_cursor_x != curs_x
+ || f->phys_cursor_y != curs_y
+ || (f->output_data.win32->current_cursor != hollow_box_cursor
+ && (f != FRAME_WIN32_DISPLAY_INFO (f)->win32_highlight_frame))))
+ {
+ int mouse_face_here = 0;
+ struct frame_glyphs *active_glyphs = FRAME_CURRENT_GLYPHS (f);
+
+ /* If the cursor is in the mouse face area, redisplay that when
+ we clear the cursor. */
+ if (f == FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_mouse_frame
+ &&
+ (f->phys_cursor_y > FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_row
+ || (f->phys_cursor_y == FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_row
+ && f->phys_cursor_x >= FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_beg_col))
+ &&
+ (f->phys_cursor_y < FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_row
+ || (f->phys_cursor_y == FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_row
+ && f->phys_cursor_x < FRAME_WIN32_DISPLAY_INFO (f)->mouse_face_end_col))
+ /* Don't redraw the cursor's spot in mouse face
+ if it is at the end of a line (on a newline).
+ The cursor appears there, but mouse highlighting does not. */
+ && active_glyphs->used[f->phys_cursor_y] > f->phys_cursor_x)
+ mouse_face_here = 1;
+
+ /* If the font is not as tall as a whole line,
+ we must explicitly clear the line's whole height. */
+ if (FONT_HEIGHT (f->output_data.win32->font) != f->output_data.win32->line_height)
+ win32_clear_area (f, NULL,
+ CHAR_TO_PIXEL_COL (f, f->phys_cursor_x),
+ CHAR_TO_PIXEL_ROW (f, f->phys_cursor_y),
+ FONT_WIDTH (f->output_data.win32->font),
+ f->output_data.win32->line_height);
+ /* Erase the cursor by redrawing the character underneath it. */
+ x_draw_single_glyph (f, f->phys_cursor_y, f->phys_cursor_x,
+ f->phys_cursor_glyph,
+ (mouse_face_here
+ ? 3
+ : current_glyphs->highlight[f->phys_cursor_y]));
+ f->phys_cursor_x = -1;
+ }
+
+ /* If we want to show a cursor,
+ or we want a box cursor and it's not so,
+ write it in the right place. */
+ if (on
+ && (f->phys_cursor_x < 0
+ || (f->output_data.win32->current_cursor != filled_box_cursor
+ && f == FRAME_WIN32_DISPLAY_INFO (f)->win32_highlight_frame)))
+ {
+ f->phys_cursor_glyph
+ = ((current_glyphs->enable[curs_y]
+ && curs_x < current_glyphs->used[curs_y])
+ ? current_glyphs->glyphs[curs_y][curs_x]
+ : SPACEGLYPH);
+ if (f != FRAME_WIN32_DISPLAY_INFO (f)->win32_highlight_frame)
+ {
+ x_draw_box (f);
+ f->output_data.win32->current_cursor = hollow_box_cursor;
+ }
+ else
+ {
+ x_draw_single_glyph (f, curs_y, curs_x,
+ f->phys_cursor_glyph, 2);
+ f->output_data.win32->current_cursor = filled_box_cursor;
+ }
+
+ f->phys_cursor_x = curs_x;
+ f->phys_cursor_y = curs_y;
+ }
+}
+
+x_display_cursor (f, on)
+ struct frame *f;
+ int on;
+{
+ BLOCK_INPUT;
+
+ if (FRAME_DESIRED_CURSOR (f) == filled_box_cursor)
+ x_display_box_cursor (f, on);
+ else if (FRAME_DESIRED_CURSOR (f) == bar_cursor)
+ x_display_bar_cursor (f, on);
+ else
+ /* Those are the only two we have implemented! */
+ abort ();
+
+ UNBLOCK_INPUT;
+}
+\f
+/* Changing the font of the frame. */
+
+/* Give frame F the font named FONTNAME as its default font, and
+ return the full name of that font. FONTNAME may be a wildcard
+ pattern; in that case, we choose some font that fits the pattern.
+ The return value shows which font we chose. */
+
+Lisp_Object
+x_new_font (f, fontname)
+ struct frame *f;
+ register char *fontname;
+{
+ int already_loaded;
+ int n_matching_fonts;
+ XFontStruct *font_info;
+ char new_font_name[101];
+
+ /* Get a font which matches this name */
+ {
+ LOGFONT lf;
+
+ if (!x_to_win32_font(fontname, &lf)
+ || !win32_to_x_font(&lf, new_font_name, 100))
+ {
+ return Qnil;
+ }
+ }
+
+ /* See if we've already loaded a matching font. */
+ already_loaded = -1;
+
+ {
+ int i;
+
+ for (i = 0; i < FRAME_WIN32_DISPLAY_INFO (f)->n_fonts; i++)
+ if (!strcmp (FRAME_WIN32_DISPLAY_INFO (f)->font_table[i].name, new_font_name))
+ {
+ already_loaded = i;
+ fontname = FRAME_WIN32_DISPLAY_INFO (f)->font_table[i].name;
+ break;
+ }
+ }
+
+ /* If we have, just return it from the table. */
+ if (already_loaded >= 0)
+ f->output_data.win32->font = FRAME_WIN32_DISPLAY_INFO (f)->font_table[already_loaded].font;
+ /* Otherwise, load the font and add it to the table. */
+ else
+ {
+ XFontStruct *font;
+ int n_fonts;
+
+ font = win32_load_font(FRAME_WIN32_DISPLAY_INFO (f), fontname);
+
+ if (! font)
+ {
+ return Qnil;
+ }
+
+ /* Do we need to create the table? */
+ if (FRAME_WIN32_DISPLAY_INFO (f)->font_table_size == 0)
+ {
+ FRAME_WIN32_DISPLAY_INFO (f)->font_table_size = 16;
+ FRAME_WIN32_DISPLAY_INFO (f)->font_table
+ = (struct font_info *) xmalloc (FRAME_WIN32_DISPLAY_INFO (f)->font_table_size
+ * sizeof (struct font_info));
+ }
+ /* Do we need to grow the table? */
+ else if (FRAME_WIN32_DISPLAY_INFO (f)->n_fonts
+ >= FRAME_WIN32_DISPLAY_INFO (f)->font_table_size)
+ {
+ FRAME_WIN32_DISPLAY_INFO (f)->font_table_size *= 2;
+ FRAME_WIN32_DISPLAY_INFO (f)->font_table
+ = (struct font_info *) xrealloc (FRAME_WIN32_DISPLAY_INFO (f)->font_table,
+ (FRAME_WIN32_DISPLAY_INFO (f)->font_table_size
+ * sizeof (struct font_info)));
+ }
+
+ n_fonts = FRAME_WIN32_DISPLAY_INFO (f)->n_fonts;
+ FRAME_WIN32_DISPLAY_INFO (f)->font_table[n_fonts].name = (char *) xmalloc (strlen (fontname) + 1);
+ bcopy (fontname, FRAME_WIN32_DISPLAY_INFO (f)->font_table[n_fonts].name, strlen (fontname) + 1);
+ f->output_data.win32->font = FRAME_WIN32_DISPLAY_INFO (f)->font_table[n_fonts].font = font;
+ FRAME_WIN32_DISPLAY_INFO (f)->n_fonts++;
+ }
+
+ /* Compute the scroll bar width in character columns. */
+ if (f->scroll_bar_pixel_width > 0)
+ {
+ int wid = FONT_WIDTH (f->output_data.win32->font);
+ f->scroll_bar_cols = (f->scroll_bar_pixel_width + wid-1) / wid;
+ }
+ else
+ f->scroll_bar_cols = 2;
+
+ /* Now make the frame display the given font. */
+ if (FRAME_WIN32_WINDOW (f) != 0)
+ {
+ frame_update_line_height (f);
+ x_set_window_size (f, 0, f->width, f->height);
+ }
+ else
+ /* If we are setting a new frame's font for the first time,
+ there are no faces yet, so this font's height is the line height. */
+ f->output_data.win32->line_height = FONT_HEIGHT (f->output_data.win32->font);
+
+ {
+ Lisp_Object lispy_name;
+
+ lispy_name = build_string (fontname);
+
+ return lispy_name;
+ }
+}
+\f
+x_calc_absolute_position (f)
+ struct frame *f;
+{
+ Window win, child;
+ POINT pt;
+ int flags = f->output_data.win32->size_hint_flags;
+
+ pt.x = pt.y = 0;
+
+ /* Find the position of the outside upper-left corner of
+ the inner window, with respect to the outer window. */
+ if (f->output_data.win32->parent_desc != FRAME_WIN32_DISPLAY_INFO (f)->root_window)
+ {
+ BLOCK_INPUT;
+ MapWindowPoints (FRAME_WIN32_WINDOW (f),
+ f->output_data.win32->parent_desc,
+ &pt, 1);
+ UNBLOCK_INPUT;
+ }
+
+ {
+ RECT rt;
+ rt.left = rt.right = rt.top = rt.bottom = 0;
+
+ BLOCK_INPUT;
+ AdjustWindowRect(&rt, f->output_data.win32->dwStyle,
+ FRAME_EXTERNAL_MENU_BAR (f));
+ UNBLOCK_INPUT;
+
+ pt.x += (rt.right - rt.left);
+ pt.y += (rt.bottom - rt.top);
+ }
+
+ /* Treat negative positions as relative to the leftmost bottommost
+ position that fits on the screen. */
+ if (flags & XNegative)
+ f->output_data.win32->left_pos = (FRAME_WIN32_DISPLAY_INFO (f)->width
+ - 2 * f->output_data.win32->border_width - pt.x
+ - PIXEL_WIDTH (f)
+ + f->output_data.win32->left_pos);
+
+ if (flags & YNegative)
+ f->output_data.win32->top_pos = (FRAME_WIN32_DISPLAY_INFO (f)->height
+ - 2 * f->output_data.win32->border_width - pt.y
+ - PIXEL_HEIGHT (f)
+ + f->output_data.win32->top_pos);
+ /* The left_pos and top_pos
+ are now relative to the top and left screen edges,
+ so the flags should correspond. */
+ f->output_data.win32->size_hint_flags &= ~ (XNegative | YNegative);
+}
+
+/* CHANGE_GRAVITY is 1 when calling from Fset_frame_position,
+ to really change the position, and 0 when calling from
+ x_make_frame_visible (in that case, XOFF and YOFF are the current
+ position values). It is -1 when calling from x_set_frame_parameters,
+ which means, do adjust for borders but don't change the gravity. */
+
+x_set_offset (f, xoff, yoff, change_gravity)
+ struct frame *f;
+ register int xoff, yoff;
+ int change_gravity;
+{
+ int modified_top, modified_left;
+
+ if (change_gravity > 0)
+ {
+ f->output_data.win32->top_pos = yoff;
+ f->output_data.win32->left_pos = xoff;
+ f->output_data.win32->size_hint_flags &= ~ (XNegative | YNegative);
+ if (xoff < 0)
+ f->output_data.win32->size_hint_flags |= XNegative;
+ if (yoff < 0)
+ f->output_data.win32->size_hint_flags |= YNegative;
+ f->output_data.win32->win_gravity = NorthWestGravity;
+ }
+ x_calc_absolute_position (f);
+
+ BLOCK_INPUT;
+ x_wm_set_size_hint (f, (long) 0, 0);
+
+ /* It is a mystery why we need to add the border_width here
+ when the frame is already visible, but experiment says we do. */
+ modified_left = f->output_data.win32->left_pos;
+ modified_top = f->output_data.win32->top_pos;
+ if (change_gravity != 0)
+ {
+ modified_left += f->output_data.win32->border_width;
+ modified_top += f->output_data.win32->border_width;
+ }
+
+ SetWindowPos (FRAME_WIN32_WINDOW (f),
+ NULL,
+ modified_left, modified_top,
+ 0,0,
+ SWP_NOZORDER | SWP_NOSIZE);
+ UNBLOCK_INPUT;
+}
+
+/* Call this to change the size of frame F's x-window.
+ If CHANGE_GRAVITY is 1, we change to top-left-corner window gravity
+ for this size change and subsequent size changes.
+ Otherwise we leave the window gravity unchanged. */
+
+x_set_window_size (f, change_gravity, cols, rows)
+ struct frame *f;
+ int change_gravity;
+ int cols, rows;
+{
+ int pixelwidth, pixelheight;
+
+ BLOCK_INPUT;
+
+ check_frame_size (f, &rows, &cols);
+ f->output_data.win32->vertical_scroll_bar_extra
+ = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
+ ? 0
+ : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0
+ ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
+ : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.win32->font)));
+ pixelwidth = CHAR_TO_PIXEL_WIDTH (f, cols);
+ pixelheight = CHAR_TO_PIXEL_HEIGHT (f, rows);
+
+ f->output_data.win32->win_gravity = NorthWestGravity;
+ x_wm_set_size_hint (f, (long) 0, 0);
+
+ {
+ RECT rect;
+
+ rect.left = rect.top = 0;
+ rect.right = pixelwidth;
+ rect.bottom = pixelheight;
+
+ AdjustWindowRect(&rect, f->output_data.win32->dwStyle,
+ FRAME_EXTERNAL_MENU_BAR (f));
+
+ /* All windows have an extra pixel */
+
+ SetWindowPos (FRAME_WIN32_WINDOW (f),
+ NULL,
+ 0, 0,
+ rect.right - rect.left + 1,
+ rect.bottom - rect.top + 1,
+ SWP_NOZORDER | SWP_NOMOVE);
+ }
+
+ /* Now, strictly speaking, we can't be sure that this is accurate,
+ but the window manager will get around to dealing with the size
+ change request eventually, and we'll hear how it went when the
+ ConfigureNotify event gets here.
+
+ We could just not bother storing any of this information here,
+ and let the ConfigureNotify event set everything up, but that
+ might be kind of confusing to the lisp code, since size changes
+ wouldn't be reported in the frame parameters until some random
+ point in the future when the ConfigureNotify event arrives. */
+ change_frame_size (f, rows, cols, 0, 0);
+ PIXEL_WIDTH (f) = pixelwidth;
+ PIXEL_HEIGHT (f) = pixelheight;
+
+ /* If cursor was outside the new size, mark it as off. */
+ if (f->phys_cursor_y >= rows
+ || f->phys_cursor_x >= cols)
+ {
+ f->phys_cursor_x = -1;
+ f->phys_cursor_y = -1;
+ }
+
+ /* We've set {FRAME,PIXEL}_{WIDTH,HEIGHT} to the values we hope to
+ receive in the ConfigureNotify event; if we get what we asked
+ for, then the event won't cause the screen to become garbaged, so
+ we have to make sure to do it here. */
+ SET_FRAME_GARBAGED (f);
+
+ UNBLOCK_INPUT;
+}
+\f
+/* Mouse warping. */
+
+void
+x_set_mouse_position (f, x, y)
+ struct frame *f;
+ int x, y;
+{
+ int pix_x, pix_y;
+
+ pix_x = CHAR_TO_PIXEL_COL (f, x) + FONT_WIDTH (f->output_data.win32->font) / 2;
+ pix_y = CHAR_TO_PIXEL_ROW (f, y) + f->output_data.win32->line_height / 2;
+
+ if (pix_x < 0) pix_x = 0;
+ if (pix_x > PIXEL_WIDTH (f)) pix_x = PIXEL_WIDTH (f);
+
+ if (pix_y < 0) pix_y = 0;
+ if (pix_y > PIXEL_HEIGHT (f)) pix_y = PIXEL_HEIGHT (f);
+
+ BLOCK_INPUT;
+
+ SetCursorPos (pix_x, pix_y);
+
+ UNBLOCK_INPUT;
+}
+
+/* Move the mouse to position pixel PIX_X, PIX_Y relative to frame F. */
+
+void
+x_set_mouse_pixel_position (f, pix_x, pix_y)
+ struct frame *f;
+ int pix_x, pix_y;
+{
+ BLOCK_INPUT;
+
+ SetCursorPos (pix_x, pix_y);
+
+ UNBLOCK_INPUT;
+}
+\f
+/* focus shifting, raising and lowering. */
+
+x_focus_on_frame (f)
+ struct frame *f;
+{
+}
+
+x_unfocus_frame (f)
+ struct frame *f;
+{
+}
+
+/* Raise frame F. */
+
+x_raise_frame (f)
+ struct frame *f;
+{
+ if (f->async_visible)
+ {
+ BLOCK_INPUT;
+ SetWindowPos (FRAME_WIN32_WINDOW (f),
+ HWND_TOP,
+ 0, 0, 0, 0,
+ SWP_NOSIZE | SWP_NOMOVE);
+ UNBLOCK_INPUT;
+ }
+}
+
+/* Lower frame F. */
+
+x_lower_frame (f)
+ struct frame *f;
+{
+ if (f->async_visible)
+ {
+ BLOCK_INPUT;
+ SetWindowPos (FRAME_WIN32_WINDOW (f),
+ HWND_BOTTOM,
+ 0, 0, 0, 0,
+ SWP_NOSIZE | SWP_NOMOVE);
+ UNBLOCK_INPUT;
+ }
+}
+
+static void
+win32_frame_raise_lower (f, raise)
+ FRAME_PTR f;
+ int raise;
+{
+ if (raise)
+ x_raise_frame (f);
+ else
+ x_lower_frame (f);
+}
+\f
+/* Change of visibility. */
+
+/* This tries to wait until the frame is really visible.
+ However, if the window manager asks the user where to position
+ the frame, this will return before the user finishes doing that.
+ The frame will not actually be visible at that time,
+ but it will become visible later when the window manager
+ finishes with it. */
+
+x_make_frame_visible (f)
+ struct frame *f;
+{
+ BLOCK_INPUT;
+
+ if (! FRAME_VISIBLE_P (f))
+ {
+ /* We test FRAME_GARBAGED_P here to make sure we don't
+ call x_set_offset a second time
+ if we get to x_make_frame_visible a second time
+ before the window gets really visible. */
+ if (! FRAME_ICONIFIED_P (f)
+ && ! f->output_data.win32->asked_for_visible)
+ x_set_offset (f, f->output_data.win32->left_pos, f->output_data.win32->top_pos, 0);
+
+ f->output_data.win32->asked_for_visible = 1;
+
+ ShowWindow (FRAME_WIN32_WINDOW (f), SW_SHOW);
+ }
+
+ /* Synchronize to ensure Emacs knows the frame is visible
+ before we do anything else. We do this loop with input not blocked
+ so that incoming events are handled. */
+ {
+ Lisp_Object frame;
+ int count = input_signal_count;
+
+ /* This must come after we set COUNT. */
+ UNBLOCK_INPUT;
+
+ XSETFRAME (frame, f);
+
+ while (1)
+ {
+ /* Once we have handled input events,
+ we should have received the MapNotify if one is coming.
+ So if we have not got it yet, stop looping.
+ Some window managers make their own decisions
+ about visibility. */
+ if (input_signal_count != count)
+ break;
+ /* Machines that do polling rather than SIGIO have been observed
+ to go into a busy-wait here. So we'll fake an alarm signal
+ to let the handler know that there's something to be read.
+ We used to raise a real alarm, but it seems that the handler
+ isn't always enabled here. This is probably a bug. */
+ if (input_polling_used ())
+ {
+ /* It could be confusing if a real alarm arrives while processing
+ the fake one. Turn it off and let the handler reset it. */
+ alarm (0);
+ input_poll_signal ();
+ }
+ /* Once we have handled input events,
+ we should have received the MapNotify if one is coming.
+ So if we have not got it yet, stop looping.
+ Some window managers make their own decisions
+ about visibility. */
+ if (input_signal_count != count)
+ break;
+ }
+ FRAME_SAMPLE_VISIBILITY (f);
+ }
+}
+
+/* Change from mapped state to withdrawn state. */
+
+/* Make the frame visible (mapped and not iconified). */
+
+x_make_frame_invisible (f)
+ struct frame *f;
+{
+ Window window;
+
+ /* Don't keep the highlight on an invisible frame. */
+ if (FRAME_WIN32_DISPLAY_INFO (f)->win32_highlight_frame == f)
+ FRAME_WIN32_DISPLAY_INFO (f)->win32_highlight_frame = 0;
+
+ BLOCK_INPUT;
+
+ ShowWindow (FRAME_WIN32_WINDOW (f), SW_HIDE);
+
+ /* We can't distinguish this from iconification
+ just by the event that we get from the server.
+ So we can't win using the usual strategy of letting
+ FRAME_SAMPLE_VISIBILITY set this. So do it by hand,
+ and synchronize with the server to make sure we agree. */
+ f->visible = 0;
+ FRAME_ICONIFIED_P (f) = 0;
+ f->async_visible = 0;
+ f->async_iconified = 0;
+
+ UNBLOCK_INPUT;
+}
+
+/* Change window state from mapped to iconified. */
+
+void x_iconify_frame (f)
+ struct frame *f;
+{
+ int result;
+
+ /* Don't keep the highlight on an invisible frame. */
+ if (FRAME_WIN32_DISPLAY_INFO (f)->win32_highlight_frame == f)
+ FRAME_WIN32_DISPLAY_INFO (f)->win32_highlight_frame = 0;
+
+ if (f->async_iconified)
+ return;
+
+ BLOCK_INPUT;
+
+ ShowWindow (FRAME_WIN32_WINDOW (f), SW_SHOWMINIMIZED);
+
+ f->async_iconified = 1;
+
+ UNBLOCK_INPUT;
+}
+\f
+/* Destroy the window of frame F. */
+
+x_destroy_window (f)
+ struct frame *f;
+{
+ struct win32_display_info *dpyinfo = FRAME_WIN32_DISPLAY_INFO (f);
+
+ BLOCK_INPUT;
+
+ my_destroy_window (f, FRAME_WIN32_WINDOW (f));
+ free_frame_menubar (f);
+ free_frame_faces (f);
+
+ xfree (f->output_data.win32);
+ f->output_data.win32 = 0;
+ if (f == dpyinfo->win32_focus_frame)
+ dpyinfo->win32_focus_frame = 0;
+ if (f == dpyinfo->win32_focus_event_frame)
+ dpyinfo->win32_focus_event_frame = 0;
+ if (f == dpyinfo->win32_highlight_frame)
+ dpyinfo->win32_highlight_frame = 0;
+
+ dpyinfo->reference_count--;
+
+ if (f == dpyinfo->mouse_face_mouse_frame)
+ {
+ dpyinfo->mouse_face_beg_row
+ = dpyinfo->mouse_face_beg_col = -1;
+ dpyinfo->mouse_face_end_row
+ = dpyinfo->mouse_face_end_col = -1;
+ dpyinfo->mouse_face_window = Qnil;
+ }
+
+ UNBLOCK_INPUT;
+}
+\f
+/* Setting window manager hints. */
+
+/* Set the normal size hints for the window manager, for frame F.
+ FLAGS is the flags word to use--or 0 meaning preserve the flags
+ that the window now has.
+ If USER_POSITION is nonzero, we set the USPosition
+ flag (this is useful when FLAGS is 0). */
+
+x_wm_set_size_hint (f, flags, user_position)
+ struct frame *f;
+ long flags;
+ int user_position;
+{
+ Window window = FRAME_WIN32_WINDOW (f);
+
+ flexlines = f->height;
+
+ enter_crit ();
+
+ SetWindowLong (window, WND_X_UNITS_INDEX, FONT_WIDTH (f->output_data.win32->font));
+ SetWindowLong (window, WND_Y_UNITS_INDEX, f->output_data.win32->line_height);
+
+ leave_crit ();
+}
+
+/* Window manager things */
+x_wm_set_icon_position (f, icon_x, icon_y)
+ struct frame *f;
+ int icon_x, icon_y;
+{
+#if 0
+ Window window = FRAME_WIN32_WINDOW (f);
+
+ f->display.x->wm_hints.flags |= IconPositionHint;
+ f->display.x->wm_hints.icon_x = icon_x;
+ f->display.x->wm_hints.icon_y = icon_y;
+
+ XSetWMHints (FRAME_X_DISPLAY (f), window, &f->display.x->wm_hints);
+#endif
+}
+
+\f
+/* Initialization. */
+
+#ifdef USE_X_TOOLKIT
+static XrmOptionDescRec emacs_options[] = {
+ {"-geometry", ".geometry", XrmoptionSepArg, NULL},
+ {"-iconic", ".iconic", XrmoptionNoArg, (XtPointer) "yes"},
+
+ {"-internal-border-width", "*EmacsScreen.internalBorderWidth",
+ XrmoptionSepArg, NULL},
+ {"-ib", "*EmacsScreen.internalBorderWidth", XrmoptionSepArg, NULL},
+
+ {"-T", "*EmacsShell.title", XrmoptionSepArg, (XtPointer) NULL},
+ {"-wn", "*EmacsShell.title", XrmoptionSepArg, (XtPointer) NULL},
+ {"-title", "*EmacsShell.title", XrmoptionSepArg, (XtPointer) NULL},
+ {"-iconname", "*EmacsShell.iconName", XrmoptionSepArg, (XtPointer) NULL},
+ {"-in", "*EmacsShell.iconName", XrmoptionSepArg, (XtPointer) NULL},
+ {"-mc", "*pointerColor", XrmoptionSepArg, (XtPointer) NULL},
+ {"-cr", "*cursorColor", XrmoptionSepArg, (XtPointer) NULL}
+};
+#endif /* USE_X_TOOLKIT */
+
+static int win32_initialized = 0;
+
+struct win32_display_info *
+win32_term_init (display_name, xrm_option, resource_name)
+ Lisp_Object display_name;
+ char *xrm_option;
+ char *resource_name;
+{
+ Lisp_Object frame;
+ char *defaultvalue;
+ struct win32_display_info *dpyinfo;
+ HDC hdc;
+
+ BLOCK_INPUT;
+
+ if (!win32_initialized)
+ {
+ win32_initialize ();
+ win32_initialized = 1;
+ }
+
+ {
+ int argc = 0;
+ char *argv[3];
+
+ argv[0] = "";
+ argc = 1;
+ if (xrm_option)
+ {
+ argv[argc++] = "-xrm";
+ argv[argc++] = xrm_option;
+ }
+ }
+
+ dpyinfo = &one_win32_display_info;
+
+ /* Put this display on the chain. */
+ dpyinfo->next = NULL;
+
+ /* Put it on win32_display_name_list as well, to keep them parallel. */
+ win32_display_name_list = Fcons (Fcons (display_name, Qnil),
+ win32_display_name_list);
+ dpyinfo->name_list_element = XCONS (win32_display_name_list)->car;
+
+ dpyinfo->win32_id_name
+ = (char *) xmalloc (XSTRING (Vinvocation_name)->size
+ + XSTRING (Vsystem_name)->size
+ + 2);
+ sprintf (dpyinfo->win32_id_name, "%s@%s",
+ XSTRING (Vinvocation_name)->data, XSTRING (Vsystem_name)->data);
+
+#if 0
+ xrdb = x_load_resources (dpyinfo->display, xrm_option,
+ resource_name, EMACS_CLASS);
+
+ /* Put the rdb where we can find it in a way that works on
+ all versions. */
+ dpyinfo->xrdb = xrdb;
+#endif
+ hdc = my_get_dc (GetDesktopWindow ());
+
+ dpyinfo->height = GetDeviceCaps (hdc, VERTRES);
+ dpyinfo->width = GetDeviceCaps (hdc, HORZRES);
+ dpyinfo->root_window = GetDesktopWindow ();
+ dpyinfo->n_planes = GetDeviceCaps (hdc, PLANES);
+ dpyinfo->n_cbits = GetDeviceCaps (hdc, BITSPIXEL);
+ dpyinfo->height_in = GetDeviceCaps (hdc, LOGPIXELSX);
+ dpyinfo->width_in = GetDeviceCaps (hdc, LOGPIXELSY);
+ dpyinfo->grabbed = 0;
+ dpyinfo->reference_count = 0;
+ dpyinfo->n_fonts = 0;
+ dpyinfo->font_table_size = 0;
+ dpyinfo->bitmaps = 0;
+ dpyinfo->bitmaps_size = 0;
+ dpyinfo->bitmaps_last = 0;
+ dpyinfo->mouse_face_mouse_frame = 0;
+ dpyinfo->mouse_face_deferred_gc = 0;
+ dpyinfo->mouse_face_beg_row = dpyinfo->mouse_face_beg_col = -1;
+ dpyinfo->mouse_face_end_row = dpyinfo->mouse_face_end_col = -1;
+ dpyinfo->mouse_face_face_id = 0;
+ dpyinfo->mouse_face_window = Qnil;
+ dpyinfo->mouse_face_mouse_x = dpyinfo->mouse_face_mouse_y = 0;
+ dpyinfo->mouse_face_defer = 0;
+ dpyinfo->win32_focus_frame = 0;
+ dpyinfo->win32_focus_event_frame = 0;
+ dpyinfo->win32_highlight_frame = 0;
+
+ ReleaseDC (GetDesktopWindow (), hdc);
+
+#ifndef F_SETOWN_BUG
+#ifdef F_SETOWN
+#ifdef F_SETOWN_SOCK_NEG
+ /* stdin is a socket here */
+ fcntl (connection, F_SETOWN, -getpid ());
+#else /* ! defined (F_SETOWN_SOCK_NEG) */
+ fcntl (connection, F_SETOWN, getpid ());
+#endif /* ! defined (F_SETOWN_SOCK_NEG) */
+#endif /* ! defined (F_SETOWN) */
+#endif /* F_SETOWN_BUG */
+
+#ifdef SIGIO
+ if (interrupt_input)
+ init_sigio (connection);
+#endif /* ! defined (SIGIO) */
+
+ UNBLOCK_INPUT;
+
+ return dpyinfo;
+}
+\f
+/* Get rid of display DPYINFO, assuming all frames are already gone. */
+
+void
+x_delete_display (dpyinfo)
+ struct win32_display_info *dpyinfo;
+{
+ /* Discard this display from win32_display_name_list and win32_display_list.
+ We can't use Fdelq because that can quit. */
+ if (! NILP (win32_display_name_list)
+ && EQ (XCONS (win32_display_name_list)->car, dpyinfo->name_list_element))
+ win32_display_name_list = XCONS (win32_display_name_list)->cdr;
+ else
+ {
+ Lisp_Object tail;
+
+ tail = win32_display_name_list;
+ while (CONSP (tail) && CONSP (XCONS (tail)->cdr))
+ {
+ if (EQ (XCONS (XCONS (tail)->cdr)->car,
+ dpyinfo->name_list_element))
+ {
+ XCONS (tail)->cdr = XCONS (XCONS (tail)->cdr)->cdr;
+ break;
+ }
+ tail = XCONS (tail)->cdr;
+ }
+ }
+
+ xfree (dpyinfo->font_table);
+ xfree (dpyinfo->win32_id_name);
+}
+\f
+/* Set up use of Win32. */
+
+DWORD win_msg_worker ();
+
+win32_initialize ()
+{
+ clear_frame_hook = win32_clear_frame;
+ clear_end_of_line_hook = win32_clear_end_of_line;
+ ins_del_lines_hook = win32_ins_del_lines;
+ change_line_highlight_hook = win32_change_line_highlight;
+ insert_glyphs_hook = win32_insert_glyphs;
+ write_glyphs_hook = win32_write_glyphs;
+ delete_glyphs_hook = win32_delete_glyphs;
+ ring_bell_hook = win32_ring_bell;
+ reset_terminal_modes_hook = win32_reset_terminal_modes;
+ set_terminal_modes_hook = win32_set_terminal_modes;
+ update_begin_hook = win32_update_begin;
+ update_end_hook = win32_update_end;
+ set_terminal_window_hook = win32_set_terminal_window;
+ read_socket_hook = w32_read_socket;
+ frame_up_to_date_hook = win32_frame_up_to_date;
+ cursor_to_hook = win32_cursor_to;
+ reassert_line_highlight_hook = win32_reassert_line_highlight;
+ mouse_position_hook = win32_mouse_position;
+ frame_rehighlight_hook = win32_frame_rehighlight;
+ frame_raise_lower_hook = win32_frame_raise_lower;
+ set_vertical_scroll_bar_hook = win32_set_vertical_scroll_bar;
+ condemn_scroll_bars_hook = win32_condemn_scroll_bars;
+ redeem_scroll_bar_hook = win32_redeem_scroll_bar;
+ judge_scroll_bars_hook = win32_judge_scroll_bars;
+
+ scroll_region_ok = 1; /* we'll scroll partial frames */
+ char_ins_del_ok = 0; /* just as fast to write the line */
+ line_ins_del_ok = 1; /* we'll just blt 'em */
+ fast_clear_end_of_line = 1; /* X does this well */
+ memory_below_frame = 0; /* we don't remember what scrolls
+ off the bottom */
+ baud_rate = 19200;
+
+ /* Try to use interrupt input; if we can't, then start polling. */
+ Fset_input_mode (Qt, Qnil, Qt, Qnil);
+
+ /* Create the window thread - it will terminate itself or when the app terminates */
+
+ init_crit ();
+
+ dwMainThreadId = GetCurrentThreadId ();
+ DuplicateHandle (GetCurrentProcess (), GetCurrentThread (),
+ GetCurrentProcess (), &hMainThread, 0, TRUE, DUPLICATE_SAME_ACCESS);
+
+ /* Wait for thread to start */
+
+ {
+ MSG msg;
+
+ PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE);
+
+ hWinThread = CreateThread (NULL, 0,
+ (LPTHREAD_START_ROUTINE) win_msg_worker,
+ 0, 0, &dwWinThreadId);
+
+ GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
+ }
+
+ /* AttachThreadInput (dwWinThreadId, dwMainThreadId, TRUE); */
+
+}
+
+void
+syms_of_win32term ()
+{
+ staticpro (&win32_display_name_list);
+ win32_display_name_list = Qnil;
+
+ staticpro (&last_mouse_scroll_bar);
+ last_mouse_scroll_bar = Qnil;
+
+ staticpro (&Qvendor_specific_keysyms);
+ Qvendor_specific_keysyms = intern ("vendor-specific-keysyms");
+}
--- /dev/null
+/* Functions taken directly from X sources
+ Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs; see the file COPYING. If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#include <signal.h>
+#include <config.h>
+#include <stdio.h>
+#include "lisp.h"
+#include "blockinput.h"
+#include "w32term.h"
+#include "windowsx.h"
+
+#define myalloc(cb) GlobalAllocPtr (GPTR, cb)
+#define myfree(lp) GlobalFreePtr (lp)
+
+CRITICAL_SECTION critsect;
+extern HANDLE keyboard_handle;
+HANDLE hEvent = NULL;
+
+void
+init_crit ()
+{
+ InitializeCriticalSection (&critsect);
+ keyboard_handle = hEvent = CreateEvent (NULL, FALSE, FALSE, NULL);
+}
+
+void
+enter_crit ()
+{
+ EnterCriticalSection (&critsect);
+}
+
+void
+leave_crit ()
+{
+ LeaveCriticalSection (&critsect);
+}
+
+void
+delete_crit ()
+{
+ DeleteCriticalSection (&critsect);
+ if (hEvent)
+ {
+ CloseHandle (hEvent);
+ hEvent = NULL;
+ }
+}
+
+typedef struct int_msg
+{
+ Win32Msg w32msg;
+ struct int_msg *lpNext;
+} int_msg;
+
+int_msg *lpHead = NULL;
+int_msg *lpTail = NULL;
+int nQueue = 0;
+
+BOOL
+get_next_msg (lpmsg, bWait)
+ Win32Msg * lpmsg;
+ BOOL bWait;
+{
+ BOOL bRet = FALSE;
+
+ enter_crit ();
+
+ /* The while loop takes care of multiple sets */
+
+ while (!nQueue && bWait)
+ {
+ leave_crit ();
+ WaitForSingleObject (hEvent, INFINITE);
+ enter_crit ();
+ }
+
+ if (nQueue)
+ {
+ bcopy (&(lpHead->w32msg), lpmsg, sizeof (Win32Msg));
+
+ {
+ int_msg * lpCur = lpHead;
+
+ lpHead = lpHead->lpNext;
+
+ myfree (lpCur);
+ }
+
+ nQueue--;
+
+ bRet = TRUE;
+ }
+
+ leave_crit ();
+
+ return (bRet);
+}
+
+BOOL
+post_msg (lpmsg)
+ Win32Msg * lpmsg;
+{
+ int_msg * lpNew = (int_msg *) myalloc (sizeof (int_msg));
+
+ if (!lpNew) return (FALSE);
+
+ bcopy (lpmsg, &(lpNew->w32msg), sizeof (Win32Msg));
+ lpNew->lpNext = NULL;
+
+ enter_crit ();
+
+ if (nQueue++)
+ {
+ lpTail->lpNext = lpNew;
+ }
+ else
+ {
+ lpHead = lpNew;
+ SetEvent (hEvent);
+ }
+
+ lpTail = lpNew;
+
+ leave_crit ();
+
+ return (TRUE);
+}
+
+/*
+ * XParseGeometry parses strings of the form
+ * "=<width>x<height>{+-}<xoffset>{+-}<yoffset>", where
+ * width, height, xoffset, and yoffset are unsigned integers.
+ * Example: "=80x24+300-49"
+ * The equal sign is optional.
+ * It returns a bitmask that indicates which of the four values
+ * were actually found in the string. For each value found,
+ * the corresponding argument is updated; for each value
+ * not found, the corresponding argument is left unchanged.
+ */
+
+static int
+read_integer (string, NextString)
+ register char *string;
+ char **NextString;
+{
+ register int Result = 0;
+ int Sign = 1;
+
+ if (*string == '+')
+ string++;
+ else if (*string == '-')
+ {
+ string++;
+ Sign = -1;
+ }
+ for (; (*string >= '0') && (*string <= '9'); string++)
+ {
+ Result = (Result * 10) + (*string - '0');
+ }
+ *NextString = string;
+ if (Sign >= 0)
+ return (Result);
+ else
+ return (-Result);
+}
+
+int
+XParseGeometry (string, x, y, width, height)
+ char *string;
+ int *x, *y;
+ unsigned int *width, *height; /* RETURN */
+{
+ int mask = NoValue;
+ register char *strind;
+ unsigned int tempWidth, tempHeight;
+ int tempX, tempY;
+ char *nextCharacter;
+
+ if ((string == NULL) || (*string == '\0')) return (mask);
+ if (*string == '=')
+ string++; /* ignore possible '=' at beg of geometry spec */
+
+ strind = (char *)string;
+ if (*strind != '+' && *strind != '-' && *strind != 'x')
+ {
+ tempWidth = read_integer (strind, &nextCharacter);
+ if (strind == nextCharacter)
+ return (0);
+ strind = nextCharacter;
+ mask |= WidthValue;
+ }
+
+ if (*strind == 'x' || *strind == 'X')
+ {
+ strind++;
+ tempHeight = read_integer (strind, &nextCharacter);
+ if (strind == nextCharacter)
+ return (0);
+ strind = nextCharacter;
+ mask |= HeightValue;
+ }
+
+ if ((*strind == '+') || (*strind == '-'))
+ {
+ if (*strind == '-')
+ {
+ strind++;
+ tempX = -read_integer (strind, &nextCharacter);
+ if (strind == nextCharacter)
+ return (0);
+ strind = nextCharacter;
+ mask |= XNegative;
+
+ }
+ else
+ {
+ strind++;
+ tempX = read_integer (strind, &nextCharacter);
+ if (strind == nextCharacter)
+ return (0);
+ strind = nextCharacter;
+ }
+ mask |= XValue;
+ if ((*strind == '+') || (*strind == '-'))
+ {
+ if (*strind == '-')
+ {
+ strind++;
+ tempY = -read_integer (strind, &nextCharacter);
+ if (strind == nextCharacter)
+ return (0);
+ strind = nextCharacter;
+ mask |= YNegative;
+
+ }
+ else
+ {
+ strind++;
+ tempY = read_integer (strind, &nextCharacter);
+ if (strind == nextCharacter)
+ return (0);
+ strind = nextCharacter;
+ }
+ mask |= YValue;
+ }
+ }
+
+ /* If strind isn't at the end of the string the it's an invalid
+ geometry specification. */
+
+ if (*strind != '\0') return (0);
+
+ if (mask & XValue)
+ *x = tempX;
+ if (mask & YValue)
+ *y = tempY;
+ if (mask & WidthValue)
+ *width = tempWidth;
+ if (mask & HeightValue)
+ *height = tempHeight;
+ return (mask);
+}
+
+/* The semantics of the use of using_x_p is really using_a_window_system. */
+int
+using_x_p (void)
+{
+ return 1;
+}
+
+/* x_sync is a no-op on Win32. */
+void
+x_sync (f)
+ void *f;
+{
+}
+
projects / emacs.git / commitdiff