X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ed7f1a6c5caaf4159125c08db5d18c5471fdd032..641a3472ef245157ebcb2114f2d608cb3cb401a7:/lisp/term/pc-win.el diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el index 4cb88f6bd2..8ca98c6ec9 100644 --- a/lisp/term/pc-win.el +++ b/lisp/term/pc-win.el @@ -1,10 +1,10 @@ -;;; pc-win.el --- setup support for `PC windows' (whatever that is) +;;; pc-win.el --- setup support for `PC windows' (whatever that is) -*- lexical-binding:t -*- -;; Copyright (C) 1994, 1996-1997, 1999, 2001-2011 -;; Free Software Foundation, Inc. +;; Copyright (C) 1994, 1996-1997, 1999, 2001-2016 Free Software +;; Foundation, Inc. ;; Author: Morten Welinder -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; This file is part of GNU Emacs. @@ -40,27 +40,25 @@ (error "%s: Loading pc-win.el but not compiled for MS-DOS" (invocation-name))) -(load "term/internal" nil t) - (declare-function msdos-remember-default-colors "msdos.c") (declare-function w16-set-clipboard-data "w16select.c") (declare-function w16-get-clipboard-data "w16select.c") (declare-function msdos-setup-keyboard "internal" (frame)) -;;; This was copied from etc/rgb.txt, except that some values were changed -;;; a bit to make them consistent with DOS console colors, and the RGB -;;; values were scaled up to 16 bits, as `tty-define-color' requires. +;; This was copied from etc/rgb.txt, except that some values were changed +;; a bit to make them consistent with DOS console colors, and the RGB +;; values were scaled up to 16 bits, as `tty-define-color' requires. ;;; -;;; The mapping between the 16 standard EGA/VGA colors and X color names -;;; was done by running a Unix version of Emacs inside an X client and a -;;; DJGPP-compiled Emacs on the same PC. The names of X colors used to -;;; define the pixel values are shown as comments to each color below. +;; The mapping between the 16 standard EGA/VGA colors and X color names +;; was done by running a Unix version of Emacs inside an X client and a +;; DJGPP-compiled Emacs on the same PC. The names of X colors used to +;; define the pixel values are shown as comments to each color below. ;;; -;;; If you want to change the RGB values, keep in mind that various pieces -;;; of Emacs think that a color whose RGB values add up to less than 0.6 of -;;; the values for WHITE (i.e. less than 117963) are ``dark'', otherwise the -;;; color is ``light''; see `frame-set-background-mode' in lisp/faces.el for -;;; an example. +;; If you want to change the RGB values, keep in mind that various pieces +;; of Emacs think that a color whose RGB values add up to less than 0.6 of +;; the values for WHITE (i.e. less than 117963) are ``dark'', otherwise the +;; color is ``light''; see `frame-set-background-mode' in lisp/faces.el for +;; an example. (defvar msdos-color-values '(("black" 0 0 0 0) ("blue" 1 0 0 52480) ; MediumBlue @@ -134,7 +132,7 @@ ;; terminal-initialization function. Also, our handling of reverse ;; video is slightly different. (defun msdos-create-frame-with-faces (&optional parameters) - "Create an frame on MS-DOS display. + "Create a frame on MS-DOS display. Optional frame parameters PARAMETERS specify the frame parameters. Parameters not specified by PARAMETERS are taken from `default-frame-alist'. If either PARAMETERS or `default-frame-alist' @@ -159,23 +157,50 @@ created." ;; returned value matters. Also, by the way, recall that `ignore' is ;; a useful function for returning 'nil regardless of argument. +;; Note: Any re-definition in this file of a function that is defined +;; in C on other platforms, should either have no doc-string, or one +;; that is identical to the C version, but with the arglist signature +;; at the end. Otherwise help-split-fundoc gets confused on other +;; platforms. (Bug#10783) + ;; From src/xfns.c -(defun x-list-fonts (pattern &optional face frame maximum width) +(defun x-list-fonts (_pattern &optional _face _frame _maximum width) + "Return a list of the names of available fonts matching PATTERN. +If optional arguments FACE and FRAME are specified, return only fonts +the same size as FACE on FRAME. + +PATTERN should be a string containing a font name in the XLFD, +Fontconfig, or GTK format. A font name given in the XLFD format may +contain wildcard characters: + the * character matches any substring, and + the ? character matches any single character. + PATTERN is case-insensitive. + +The return value is a list of strings, suitable as arguments to +`set-face-font'. + +Fonts Emacs can't use may or may not be excluded +even if they match PATTERN and FACE. +The optional fourth argument MAXIMUM sets a limit on how many +fonts to match. The first MAXIMUM fonts are reported. +The optional fifth argument WIDTH, if specified, is a number of columns +occupied by a character of a font. In that case, return only fonts +the WIDTH times as wide as FACE on FRAME." (if (or (null width) (and (numberp width) (= width 1))) (list "ms-dos") (list "no-such-font"))) (defun x-display-pixel-width (&optional frame) (frame-width frame)) (defun x-display-pixel-height (&optional frame) (frame-height frame)) -(defun x-display-planes (&optional frame) 4) ;bg switched to 16 colors as well -(defun x-display-color-cells (&optional frame) 16) -(defun x-server-max-request-size (&optional frame) 1000000) ; ??? -(defun x-server-vendor (&optional frame) t "GNU") -(defun x-server-version (&optional frame) '(1 0 0)) -(defun x-display-screens (&optional frame) 1) -(defun x-display-mm-height (&optional frame) 245) ; Guess the size of my -(defun x-display-mm-width (&optional frame) 322) ; monitor, EZ... -(defun x-display-backing-store (&optional frame) 'not-useful) -(defun x-display-visual-class (&optional frame) 'static-color) +(defun x-display-planes (&optional _frame) 4) ;bg switched to 16 colors as well +(defun x-display-color-cells (&optional _frame) 16) +(defun x-server-max-request-size (&optional _frame) 1000000) ; ??? +(defun x-server-vendor (&optional _frame) t "GNU") +(defun x-server-version (&optional _frame) '(1 0 0)) +(defun x-display-screens (&optional _frame) 1) +(defun x-display-mm-height (&optional _frame) 245) ; Guess the size of my +(defun x-display-mm-width (&optional _frame) 322) ; monitor, EZ... +(defun x-display-backing-store (&optional _frame) 'not-useful) +(defun x-display-visual-class (&optional _frame) 'static-color) (fset 'x-display-save-under 'ignore) (fset 'x-get-resource 'ignore) @@ -193,110 +218,55 @@ the operating system.") ;; From lisp/term/w32-win.el ; ;;;; Selections -; -;;; 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-selection-value. -(defvar x-last-selected-text nil) - -(defcustom x-select-enable-clipboard t - "Non-nil means cutting and pasting uses the clipboard. -This is in addition to, but in preference to, the primary selection. - -Note that MS-Windows does not support selection types other than the -clipboard. (The primary selection that is set by Emacs is not -accessible to other programs on MS-Windows.) - -This variable is not used by the Nextstep port." - :type 'boolean - :group 'killing) - -(defun x-select-text (text) - "Select TEXT, a string, according to the window system. - -On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the -clipboard. If `x-select-enable-primary' is non-nil, put TEXT in -the primary selection. - -On Windows, make TEXT the current selection. If -`x-select-enable-clipboard' is non-nil, copy the text to the -clipboard as well. - -On Nextstep, put TEXT in the pasteboard." - (if x-select-enable-clipboard - (w16-set-clipboard-data text)) - (setq x-last-selected-text text)) - -;;; Return the value of the current selection. -;;; Consult the selection. 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 (w16-get-clipboard-data)) - (error (message "w16-get-clipboard-data:%s" c))) - (if (string= text "") (setq text nil)) - (cond - ((not text) nil) - ((eq text x-last-selected-text) nil) - ((string= text x-last-selected-text) - ;; Record the newer string, so subsequent calls can use the 'eq' test. - (setq x-last-selected-text text) - nil) - (t - (setq x-last-selected-text text)))))) - -;; x-selection-owner-p is used in simple.el. -(defun x-selection-owner-p (&optional type) - "Whether the current Emacs process owns the given X Selection. -The arg should be the name of the selection in question, typically one of -the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. -\(Those are literal upper-case symbol names, since that's what X expects.) -For convenience, the symbol nil is the same as `PRIMARY', -and t is the same as `SECONDARY'." - (if x-select-enable-clipboard - (let (text) - ;; Don't die if w16-get-clipboard-data signals an error. - (ignore-errors - (setq text (w16-get-clipboard-data))) - ;; We consider ourselves the owner of the selection if it does - ;; not exist, or exists and compares equal with the last text - ;; we've put into the Windows clipboard. - (cond - ((not text) t) - ((or (eq text x-last-selected-text) - (string= text x-last-selected-text)) - text) - (t nil))))) - -;; x-own-selection-internal and x-disown-selection-internal are used -;; in select.el:x-set-selection. -(defun x-own-selection-internal (type value) - "Assert an X selection of the given TYPE with the given VALUE. -TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. -\(Those are literal upper-case symbol names, since that's what X expects.) -VALUE is typically a string, or a cons of two markers, but may be -anything that the functions on `selection-converter-alist' know about." - (ignore-errors - (x-select-text value)) - value) - -(defun x-disown-selection-internal (selection &optional time) - "If we own the selection SELECTION, disown it. -Disowning it means there is no such selection." - (if (x-selection-owner-p selection) - t)) - -;; x-get-selection-internal is used in select.el -(defun x-get-selection-internal (selection type &optional time_stamp) - "Return text selected from some X window. -SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. -\(Those are literal upper-case symbol names, since that's what X expects.) -TYPE is the type of data desired, typically `STRING'. -TIME_STAMP is the time to use in the XConvertSelection call for foreign -selections. If omitted, defaults to the time for the last event." - (x-get-selection-value)) + +;; gui-get-selection is used in select.el +(cl-defmethod gui-backend-get-selection (_selection-symbol _target-type + &context (window-system pc)) + "Return the value of the current selection. +Consult the selection. Treat empty strings as if they were unset." + ;; Don't die if x-get-selection signals an error. + (with-demoted-errors "w16-get-clipboard-data:%s" + (w16-get-clipboard-data))) + +(declare-function w16-selection-exists-p "w16select.c") +;; gui-selection-owner-p is used in simple.el. +(cl-defmethod gui-backend-selection-exists-p (selection + &context (window-system pc)) + (w16-selection-exists-p selection)) + +(cl-defmethod gui-backend-selection-owner-p (selection + &context (window-system pc)) + (w16-selection-owner-p selection)) + +(defun w16-selection-owner-p (_selection) + ;; FIXME: Other systems don't obey select-enable-clipboard here. + (if select-enable-clipboard + (let ((text + ;; Don't die if w16-get-clipboard-data signals an error. + (with-demoted-errors "w16-get-clipboard-data: %S" + (w16-get-clipboard-data)))) + ;; We consider ourselves the owner of the selection + ;; if it does not exist, or exists and compares + ;; equal with the last text we've put into the + ;; Windows clipboard. + (cond + ((not text) t) + ((equal text gui--last-selected-text-clipboard) text) + (t nil))))) + +;; gui-set-selection is used in gui-set-selection. +(declare-function w16-set-clipboard-data "w16select.c" + (string &optional ignored)) +(cl-defmethod gui-backend-set-selection (selection value + &context (window-system pc)) + (if (not value) + (if (w16-selection-owner-p selection) + t) + ;; FIXME: Other systems don't obey + ;; gui-select-enable-clipboard here. + (with-demoted-errors "w16-set-clipboard-data: %S" + (w16-set-clipboard-data value)) + value)) ;; From src/fontset.c: (fset 'query-fontset 'ignore) @@ -344,15 +314,15 @@ This is used by `msdos-show-help'.") ;; Initialization. ;; --------------------------------------------------------------------------- -;; This function is run, by faces.el:tty-create-frame-with-faces, only -;; for the initial frame (on each terminal, but we have only one). +;; This function is run, by the tty method of `frame-creation-function' +;; (in faces.el), only for the initial frame (on each terminal, but we have +;; only one). ;; This works by setting the `terminal-initted' terminal parameter to -;; this function, the first time `tty-create-frame-with-faces' is -;; called on that terminal. `tty-create-frame-with-faces' is called -;; directly from startup.el and also by `make-frame' through -;; `frame-creation-function-alist'. `make-frame' will call this -;; function if `msdos-create-frame-with-faces' (see below) is not -;; found in `frame-creation-function-alist', which means something is +;; this function, the first time `frame-creation-function' is +;; called on that terminal. `frame-creation-function' is called +;; directly from startup.el and also by `make-frame'. +;; `make-frame' should call our own `frame-creation-function' method instead +;; (see below) so if terminal-init-internal is called it means something is ;; _very_ wrong, because "internal" terminal emulator should not be ;; turned on if our window-system is not `pc'. Therefore, the only ;; Right Thing for us to do here is scream bloody murder. @@ -362,7 +332,9 @@ Errors out because it is not supposed to be called, ever." (error "terminal-init-internal called for window-system `%s'" (window-system))) -(defun msdos-initialize-window-system () +;; window-system-initialization is called by startup.el:command-line. +(cl-defmethod window-system-initialization (&context (window-system pc) + &optional _display) "Initialization function for the `pc' \"window system\"." (or (eq (window-system) 'pc) (error @@ -401,20 +373,17 @@ Errors out because it is not supposed to be called, ever." (setq split-window-keep-point t) ;; 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) (menu-bar-enable-clipboard) (run-hooks 'terminal-init-msdos-hook)) -;; frame-creation-function-alist is examined by frame.el:make-frame. -(add-to-list 'frame-creation-function-alist - '(pc . msdos-create-frame-with-faces)) -;; window-system-initialization-alist is examined by startup.el:command-line. -(add-to-list 'window-system-initialization-alist - '(pc . msdos-initialize-window-system)) +;; frame-creation-function is called by frame.el:make-frame. +(cl-defmethod frame-creation-function (params &context (window-system pc)) + (msdos-create-frame-with-faces params)) + ;; We don't need anything beyond tty-handle-args for handling ;; command-line argument; see startup.el. -(add-to-list 'handle-args-function-alist '(pc . tty-handle-args)) +(cl-defmethod handle-args-function (args &context (window-system pc)) + (tty-handle-args args)) ;; ---------------------------------------------------------------------------