diff options
| -rw-r--r-- | lisp/term/w32-win.el | 617 | ||||
| -rw-r--r-- | src/w32faces.c | 1048 | ||||
| -rw-r--r-- | src/w32fns.c | 4308 | ||||
| -rw-r--r-- | src/w32gui.h | 83 | ||||
| -rw-r--r-- | src/w32menu.c | 1917 | ||||
| -rw-r--r-- | src/w32reg.c | 94 | ||||
| -rw-r--r-- | src/w32select.c | 226 | ||||
| -rw-r--r-- | src/w32term.c | 3711 | ||||
| -rw-r--r-- | src/w32xfns.c | 293 |
9 files changed, 12297 insertions, 0 deletions
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el new file mode 100644 index 00000000000..c84d67303f6 --- /dev/null +++ b/lisp/term/w32-win.el @@ -0,0 +1,617 @@ +;;; 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: + + +;; 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))) + + + +;; +;; 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)) + +;;;; 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) + + +;;;; 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))) + +;;; 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 diff --git a/src/w32faces.c b/src/w32faces.c new file mode 100644 index 00000000000..dd0cbbaa8a7 --- /dev/null +++ b/src/w32faces.c @@ -0,0 +1,1048 @@ +/* "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" + + +/* 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. */ + +/* 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 */ ); + +/* 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); +} + +/* 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 */ +} + +/* 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; +} + + +/* 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; +} + +/* 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 (); +} + +/* 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; +} + +/* 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); +} + +/* 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); +} + +/* 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; +} + + + +/* 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); +} + +/* 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); +} diff --git a/src/w32fns.c b/src/w32fns.c new file mode 100644 index 00000000000..22a5149c72d --- /dev/null +++ b/src/w32fns.c @@ -0,0 +1,4308 @@ +/* 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; + + +/* 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); + } +} + +/* 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; +} + + + +/* 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; +} + +/* 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)); +} + +/* 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); +} + + +#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; +} + +/* 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)); + } +} + +/* 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; +} + +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; +} + + + +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; +} + +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; +} + +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; +} + +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); +} + +/* 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; +} + + +/* 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); +} + + +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(); +} diff --git a/src/w32gui.h b/src/w32gui.h new file mode 100644 index 00000000000..ba04d1ac615 --- /dev/null +++ b/src/w32gui.h @@ -0,0 +1,83 @@ +/* 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 diff --git a/src/w32menu.c b/src/w32menu.c new file mode 100644 index 00000000000..e07255021e6 --- /dev/null +++ b/src/w32menu.c @@ -0,0 +1,1917 @@ +/* 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 +} + +/* 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; +} + +/* 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); +} + +/* 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); +} + + +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); +} + +#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 + + +#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); +} diff --git a/src/w32reg.c b/src/w32reg.c new file mode 100644 index 00000000000..2b6fbb8acc3 --- /dev/null +++ b/src/w32reg.c @@ -0,0 +1,94 @@ +/* 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)); +} diff --git a/src/w32select.c b/src/w32select.c new file mode 100644 index 00000000000..54201417337 --- /dev/null +++ b/src/w32select.c @@ -0,0 +1,226 @@ +/* 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); +} diff --git a/src/w32term.c b/src/w32term.c new file mode 100644 index 00000000000..c864d180b62 --- /dev/null +++ b/src/w32term.c @@ -0,0 +1,3711 @@ +/* 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 + + +/* 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 (); + +#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 */ + +/* 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); +} + + +/* 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; + } +} + +/* 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 () +{ +} + +/* 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; + } +} + +/* 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); +} + + +/* 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; +} + +/* 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; +} + +/* 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; +} + +/* 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 (); +} + +/* 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; +} + +/* 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; +} + +/* 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); +} + +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); + } +} + +/* 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; +} + +/* 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); + } +} + + +/* 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; + } + } +} + +/* 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; +} + +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; +} + +/* 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 +} + + +/* 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; +} + +/* 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; +} + +/* 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; + } +} + +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; +} + +/* 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; +} + +/* 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); +} + +/* 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; +} + +/* 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; +} + +/* 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 +} + + +/* 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; +} + +/* 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); +} + +/* 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"); +} diff --git a/src/w32xfns.c b/src/w32xfns.c new file mode 100644 index 00000000000..0fda8c87e6b --- /dev/null +++ b/src/w32xfns.c @@ -0,0 +1,293 @@ +/* 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; +{ +} + |