Commit 919281dd authored by Stefan Monnier's avatar Stefan Monnier

Replace gui-method macros with cl-generic with &context

* lisp/frame.el (gui-method--name, gui-method, gui-method-define)
(gui-method-declare, gui-call): Remove.
(frame-creation-function): Use cl-defgeneric.
(make-frame): Adjust callers.

* lisp/menu-bar.el (menu-bar-edit-menu):
Use gui-backend-selection-exists-p.

* lisp/select.el (x-get-clipboard): Use gui-backend-get-selection.
(gui-backend-get-selection): New cl-generic to replace
gui-get-selection method.
(gui-backend-set-selection): New cl-generic to replace
gui-set-selection method.
(gui-selection-owner-p): New cl-generic to replace
gui-selection-owner-p method.
(gui-backend-selection-exists-p): New cl-generic to replace
gui-selection-exists-p method.  Adjust all callers.

* lisp/server.el (server-create-window-system-frame): Don't ignore
window-system spec even when unsupported.

* lisp/simple.el (deactivate-mark): Use new gui-backend-* functions.

* lisp/startup.el (handle-args-function, window-system-initialization):
Use cl-defgeneric.
(command-line): Adjust calls accordingly.

* lisp/term/ns-win.el (ns-window-system-initialization): Turn into
a window-system-initialization method.
(handle-args-function, frame-creation-function): Use cl-defmethod.
(gui-set-selection, gui-selection-owner-p, gui-selection-exists-p)
(gui-get-selection): Use cl-defmethod on the new functions instead.

* lisp/term/pc-win.el (w16-get-selection-value): Turn into
a gui-backend-get-selection method.
(gui-selection-exists-p, gui-selection-owner-p, gui-set-selection):
Use cl-defmethod on the new functions instead.
(msdos-window-system-initialization): Turn into
a window-system-initialization method.
(frame-creation-function, handle-args-function): Use cl-defmethod.

* lisp/term/w32-win.el (w32-window-system-initialization): Turn into
a window-system-initialization method.
(handle-args-function, frame-creation-function): Use cl-defmethod.
(gui-set-selection, gui-selection-owner-p, gui-selection-exists-p)
(gui-get-selection): Use cl-defmethod on the new functions instead.

* lisp/term/x-win.el (x-window-system-initialization): Turn into
a window-system-initialization method.
(handle-args-function, frame-creation-function): Use cl-defmethod.
(gui-set-selection, gui-selection-owner-p, gui-selection-exists-p)
(gui-get-selection): Use cl-defmethod on the new functions instead.

* lisp/term/xterm.el (xterm--set-selection): Turn into
a gui-backend-set-selection method.

* src/nsselect.m (Fns_selection_exists_p): Remove unused arg `terminal'.
(Fns_selection_owner_p): Remove unused arg `terminal'.
(Fns_get_selection): Remove unused args `time_stamp' and `terminal'.
parent dc4484ec
......@@ -561,7 +561,7 @@ already is one.)"
(defun edebug-install-read-eval-functions ()
(interactive)
(add-function :around load-read-function #'edebug--read)
(advice-add 'eval-defun :override 'edebug-eval-defun))
(advice-add 'eval-defun :override #'edebug-eval-defun))
(defun edebug-uninstall-read-eval-functions ()
(interactive)
......
......@@ -27,35 +27,20 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
;; Dispatch tables for GUI methods.
(defun gui-method--name (base)
(intern (format "%s-alist" base)))
(defmacro gui-method (name &optional type)
(macroexp-let2 nil type (or type `window-system)
`(alist-get ,type ,(gui-method--name name)
(lambda (&rest _args)
(error "No method %S for %S frame" ',name ,type)))))
(defmacro gui-method-define (name type fun)
`(setf (gui-method ,name ',type) ,fun))
(defmacro gui-method-declare (name &optional tty-fun doc)
(declare (doc-string 3) (indent 2))
`(defvar ,(gui-method--name name)
,(if tty-fun `(list (cons nil ,tty-fun))) ,doc))
(defmacro gui-call (name &rest args)
`(funcall (gui-method ,name) ,@args))
(gui-method-declare frame-creation-function
#'tty-create-frame-with-faces
(cl-defgeneric frame-creation-function (params)
"Method for window-system dependent functions to create a new frame.
The window system startup file should add its frame creation
function to this method, which should take an alist of parameters
as its argument.")
(cl-defmethod frame-creation-function (params
&context (window-system (eql nil)))
;; It's tempting to get rid of tty-create-frame-with-faces and turn it into
;; this method (i.e. move this method to faces.el), but faces.el is loaded
;; much earlier from loadup.el (before cl-generic and even before
;; cl-preloaded), so we'd first have to reorder that part.
(tty-create-frame-with-faces params))
(defvar window-system-default-frame-alist nil
"Window-system dependent default frame parameters.
The value should be an alist of elements (WINDOW-SYSTEM . ALIST),
......@@ -687,7 +672,8 @@ the new frame according to its own rules."
frame)
(unless (get w 'window-system-initialized)
(funcall (gui-method window-system-initialization w) display)
(let ((window-system w)) ;Hack attack!
(window-system-initialization display))
(setq x-display-name display)
(put w 'window-system-initialized t))
......@@ -704,8 +690,8 @@ the new frame according to its own rules."
;; (setq frame-size-history '(1000))
(setq frame
(funcall (gui-method frame-creation-function w) params))
(setq frame (let ((window-system w)) ;Hack attack!
(frame-creation-function params)))
(normal-erase-is-backspace-setup-frame frame)
;; Inherit the original frame's parameters.
(dolist (param frame-inherited-parameters)
......
......@@ -474,13 +474,15 @@
:enable (and (cdr yank-menu) (not buffer-read-only))
:help "Choose a string from the kill ring and paste it"))
(bindings--define-key menu [paste]
'(menu-item "Paste" yank
:enable (and (or
(gui-call gui-selection-exists-p 'CLIPBOARD)
(if (featurep 'ns) ; like paste-from-menu
(cdr yank-menu)
kill-ring))
(not buffer-read-only))
`(menu-item "Paste" yank
:enable (funcall
',(lambda ()
(and (or
(gui-backend-selection-exists-p 'CLIPBOARD)
(if (featurep 'ns) ; like paste-from-menu
(cdr yank-menu)
kill-ring))
(not buffer-read-only))))
:help "Paste (yank) text most recently cut/copied"))
(bindings--define-key menu [copy]
;; ns-win.el said: Substitute a Copy function that works better
......@@ -523,9 +525,12 @@
'(and mark-active (not buffer-read-only)))
(put 'clipboard-kill-ring-save 'menu-enable 'mark-active)
(put 'clipboard-yank 'menu-enable
'(and (or (gui-call gui-selection-exists-p 'PRIMARY)
(gui-call gui-selection-exists-p 'CLIPBOARD))
(not buffer-read-only)))
`(funcall ',(lambda ()
(and (or (gui-backend-selection-exists-p 'PRIMARY)
(gui-backend-selection-exists-p 'CLIPBOARD))
(not buffer-read-only)))))
(defvar gui-select-enable-clipboard)
(defun clipboard-yank ()
"Insert the clipboard contents, or the last stretch of killed text."
......
......@@ -231,7 +231,7 @@ The value nil is the same as the list (UTF8_STRING COMPOUND_TEXT STRING)."
(defun x-get-clipboard ()
"Return text pasted to the clipboard."
(declare (obsolete gui-get-selection "25.1"))
(gui-call gui-get-selection 'CLIPBOARD 'STRING))
(gui-backend-get-selection 'CLIPBOARD 'STRING))
(defun gui-get-primary-selection ()
"Return the PRIMARY selection, or the best emulation thereof."
......@@ -248,37 +248,36 @@ The value nil is the same as the list (UTF8_STRING COMPOUND_TEXT STRING)."
;;; Lower-level, backend dependent selection handling.
(gui-method-declare gui-get-selection #'ignore
(cl-defgeneric gui-backend-get-selection (_selection-symbol _target-type)
"Return selected text.
Called with 2 arguments: (SELECTION-SYMBOL TARGET-TYPE)
SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
\(Those are literal upper-case symbol names, since that's what X expects.)
TARGET-TYPE is the type of data desired, typically `STRING'.")
TARGET-TYPE is the type of data desired, typically `STRING'."
nil)
(gui-method-declare gui-set-selection #'ignore
(cl-defgeneric gui-backend-set-selection (_selection _value)
"Method to assert a selection of type SELECTION and value VALUE.
SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
If VALUE is nil and we own the selection SELECTION, disown it instead.
Disowning it means there is no such selection.
\(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.
anything that the functions on `selection-converter-alist' know about."
nil)
Called with 2 args: (SELECTION VALUE).")
(gui-method-declare gui-selection-owner-p #'ignore
(cl-defgeneric gui-backend-selection-owner-p (_selection)
"Whether the current Emacs process owns the given X Selection.
Called with one argument: (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.)")
\(Those are literal upper-case symbol names, since that's what X expects.)"
nil)
(gui-method-declare gui-selection-exists-p #'ignore
(cl-defgeneric gui-backend-selection-exists-p (_selection)
"Whether there is an owner for the given X Selection.
Called with one argument: (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.)")
\(Those are literal upper-case symbol names, since that's what X expects.)"
nil)
(defun gui-get-selection (&optional type data-type)
"Return the value of an X Windows selection.
......@@ -294,8 +293,8 @@ all upper-case names. The most often used ones, in addition to
DATA-TYPE is usually `STRING', but can also be one of the symbols
in `selection-converter-alist', which see. This argument is
ignored on NS, MS-Windows and MS-DOS."
(let ((data (gui-call gui-get-selection (or type 'PRIMARY)
(or data-type 'STRING))))
(let ((data (gui-backend-get-selection (or type 'PRIMARY)
(or data-type 'STRING))))
(when (and (stringp data)
(setq data-type (get-text-property 0 'foreign-selection data)))
(let ((coding (or next-selection-coding-system
......@@ -351,7 +350,7 @@ are not available to other programs."
valid))
(signal 'error (list "invalid selection" data)))
(or type (setq type 'PRIMARY))
(gui-call gui-set-selection type data)
(gui-backend-set-selection type data)
data)
(define-obsolete-function-alias 'x-set-selection 'gui-set-selection "25.1")
......@@ -511,7 +510,7 @@ two markers or an overlay. Otherwise, it is nil."
(apply 'vector all)))
(defun xselect-convert-to-delete (selection _type _value)
(gui-call gui-set-selection selection nil)
(gui-backend-set-selection selection nil)
;; A return value of nil means that we do not know how to do this conversion,
;; and replies with an "error". A return value of NULL means that we have
;; done the conversion (and any side-effects) but have no value to return.
......
......@@ -651,8 +651,8 @@ server or call `M-x server-force-delete' to forcibly disconnect it.")
:name server-name
:server t
:noquery t
:sentinel 'server-sentinel
:filter 'server-process-filter
:sentinel #'server-sentinel
:filter #'server-process-filter
;; We must receive file names without being decoded.
;; Those are decoded by server-process-filter according
;; to file-name-coding-system. Also don't get
......@@ -840,9 +840,6 @@ This handles splitting the command if it would be bigger than
(w (or (cdr (assq 'window-system parameters))
(window-system-for-display display))))
(unless (assq w window-system-initialization-alist)
(setq w nil))
;; Special case for ns. This is because DISPLAY may not be set at all
;; which in the ns case isn't an error. The variable display then becomes
;; the fully qualified hostname, which make-frame-on-display below
......@@ -850,7 +847,12 @@ This handles splitting the command if it would be bigger than
;; It may also be a valid X display, but if Emacs is compiled for ns, it
;; can not make X frames.
(if (featurep 'ns-win)
(setq w 'ns display "ns"))
(setq w 'ns display "ns")
;; FIXME! Not sure what this was for, and not sure how it should work
;; in the cl-defmethod new world!
;;(unless (assq w window-system-initialization-alist)
;; (setq w nil))
)
(cond (w
;; Flag frame as client-created, but use a dummy client.
......@@ -1168,7 +1170,8 @@ The following commands are accepted by the client:
(setq file (expand-file-name file dir))
(push (cons file filepos) files)
(server-log (format "New file: %s %s"
file (or filepos "")) proc))
file (or filepos ""))
proc))
(setq filepos nil))
;; -eval EXPR: Evaluate a Lisp expression.
......
......@@ -4808,14 +4808,14 @@ run `deactivate-mark-hook'."
;; the region prior to the last command modifying the buffer.
;; Set the selection to that, or to the current region.
(cond (saved-region-selection
(if (gui-call gui-selection-owner-p 'PRIMARY)
(if (gui-backend-selection-owner-p 'PRIMARY)
(gui-set-selection 'PRIMARY saved-region-selection))
(setq saved-region-selection nil))
;; If another program has acquired the selection, region
;; deactivation should not clobber it (Bug#11772).
((and (/= (region-beginning) (region-end))
(or (gui-call gui-selection-owner-p 'PRIMARY)
(null (gui-call gui-selection-exists-p 'PRIMARY))))
(or (gui-backend-selection-owner-p 'PRIMARY)
(null (gui-backend-selection-exists-p 'PRIMARY))))
(gui-set-selection 'PRIMARY
(funcall region-extract-function nil)))))
(when mark-active (force-mode-line-update)) ;Refresh toolbar (bug#16382).
......
......@@ -355,7 +355,7 @@ is not allowed, since it would not work anyway. The only way to set
this variable usefully is to set it while building and dumping Emacs."
:type '(choice (const :tag "none" nil) string)
:group 'initialization
:initialize 'custom-initialize-default
:initialize #'custom-initialize-default
:set (lambda (_variable _value)
(error "Customizing `site-run-file' does not work")))
......@@ -422,7 +422,7 @@ Warning Warning!!! Pure space overflow !!!Warning Warning
"Directory containing the Emacs TUTORIAL files."
:group 'installation
:type 'directory
:initialize 'custom-initialize-delay)
:initialize #'custom-initialize-delay)
(defun normal-top-level-add-subdirs-to-load-path ()
"Add all subdirectories of `default-directory' to `load-path'.
......@@ -707,19 +707,21 @@ It is the default value of the variable `top-level'."
(defconst tool-bar-images-pixel-height 24
"Height in pixels of images in the tool-bar.")
(gui-method-declare handle-args-function #'tty-handle-args
(cl-defgeneric handle-args-function (args)
"Method for processing window-system dependent command-line arguments.
Window system startup files should add their own function to this
method, which should parse the command line arguments. Those
pertaining to the window system should be processed and removed
from the returned command line.")
(cl-defmethod handle-args-function (args &context (window-system (eql nil)))
(tty-handle-args args))
(gui-method-declare window-system-initialization #'ignore
(cl-defgeneric window-system-initialization (&optional _display)
"Method for window-system initialization.
Window-system startup files should add their own implementation
to this method. The function should take no arguments,
and initialize the window system environment to prepare for
opening the first frame (e.g. open a connection to an X server).")
to this method. The function should initialize the window system environment
to prepare for opening the first frame (e.g. open a connection to an X server)."
nil)
(defun tty-handle-args (args)
"Handle the X-like command-line arguments \"-fg\", \"-bg\", \"-name\", etc."
......@@ -958,12 +960,11 @@ please check its value")
(error "Unsupported window system `%s'" initial-window-system))
;; Process window-system specific command line parameters.
(setq command-line-args
(funcall
(gui-method handle-args-function initial-window-system)
command-line-args))
(let ((window-system initial-window-system)) ;Hack attack!
(handle-args-function command-line-args)))
;; Initialize the window system. (Open connection, etc.)
(funcall
(gui-method window-system-initialization initial-window-system))
(let ((window-system initial-window-system)) ;Hack attack!
(window-system-initialization))
(put initial-window-system 'window-system-initialized t))
;; If there was an error, print the error message and exit.
(error
......@@ -1026,8 +1027,8 @@ please check its value")
;; switch color support on or off in mid-session by setting the
;; tty-color-mode frame parameter.
;; Exception: the `pc' ``window system'' has only 16 fixed colors,
;; and they are already set at this point by a suitable function in
;; window-system-initialization-alist.
;; and they are already set at this point by a suitable method of
;; window-system-initialization.
(or (eq initial-window-system 'pc)
(tty-register-default-colors))
......
......@@ -848,7 +848,8 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
;; Do the actual Nextstep Windows setup here; the above code just
;; defines functions and variables that we use now.
(defun ns-initialize-window-system (&optional _display)
(cl-defmethod window-system-initialization (&context (window-system (eql ns))
&optional _display)
"Initialize Emacs for Nextstep (Cocoa / GNUstep) windowing."
(cl-assert (not ns-initialized))
......@@ -921,10 +922,11 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
;; Any display name is OK.
(add-to-list 'display-format-alist '(".*" . ns))
(gui-method-define handle-args-function ns #'x-handle-args)
(gui-method-define frame-creation-function ns #'x-create-frame-with-faces)
(gui-method-define window-system-initialization ns
#'ns-initialize-window-system)
(cl-defmethod handle-args-function (args &context (window-system (eql ns)))
(x-handle-args args))
(cl-defmethod frame-creation-function (params &context (window-system (eql ns)))
(x-create-frame-with-faces params))
(declare-function ns-own-selection-internal "nsselect.m" (selection value))
(declare-function ns-disown-selection-internal "nsselect.m" (selection))
......@@ -935,13 +937,22 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(declare-function ns-get-selection "nsselect.m"
(selection-symbol target-type &optional time-stamp terminal))
(gui-method-define gui-set-selection ns
(lambda (selection value)
(if value (ns-own-selection-internal selection value)
(ns-disown-selection-internal selection))))
(gui-method-define gui-selection-owner-p ns #'ns-selection-owner-p)
(gui-method-define gui-selection-exists-p ns #'ns-selection-exists-p)
(gui-method-define gui-get-selection ns #'ns-get-selection)
(cl-defmethod gui-backend-set-selection (selection value
&context (window-system (eql ns)))
(if value (ns-own-selection-internal selection value)
(ns-disown-selection-internal selection)))
(cl-defmethod gui-backend-selection-owner-p (selection
&context (window-system (eql ns)))
(ns-selection-owner-p selection))
(cl-defmethod gui-backend-selection-exists-p (selection
&context (window-system (eql ns)))
(ns-selection-exists-p selection))
(cl-defmethod gui-backend-get-selection (selection-symbol target-type
&context (window-system (eql ns)))
(ns-get-selection selection-symbol target-type))
(provide 'ns-win)
......
......@@ -218,8 +218,10 @@ the operating system.")
;; From lisp/term/w32-win.el
;
;;;; Selections
;
(defun w16-get-selection-value (_selection-symbol _target-type)
;; gui-get-selection is used in select.el
(cl-defmethod gui-backend-get-selection (_selection-symbol _target-type
&context (window-system (eql 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.
......@@ -228,8 +230,13 @@ Consult the selection. Treat empty strings as if they were unset."
(declare-function w16-selection-exists-p "w16select.c")
;; gui-selection-owner-p is used in simple.el.
(gui-method-define gui-selection-exists-p pc #'w16-selection-exists-p)
(gui-method-define gui-selection-owner-p pc #'w16-selection-owner-p)
(cl-defmethod gui-backend-selection-exists-p (selection
&context (window-system (eql pc)))
(w16-selection-exists-p selection))
(cl-defmethod gui-backend-selection-owner-p (selection
&context (window-system (eql pc)))
(w16-selection-owner-p selection))
(defun w16-selection-owner-p (_selection)
;; FIXME: Other systems don't obey select-enable-clipboard here.
......@@ -250,19 +257,16 @@ Consult the selection. Treat empty strings as if they were unset."
;; gui-set-selection is used in gui-set-selection.
(declare-function w16-set-clipboard-data "w16select.c"
(string &optional ignored))
(gui-method-define gui-set-selection pc
(lambda (selection value)
(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)))
;; gui-get-selection is used in select.el
(gui-method-define gui-get-selection pc #'w16-get-selection-value)
(cl-defmethod gui-backend-set-selection (selection value
&context (window-system (eql 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)
......@@ -310,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.
......@@ -328,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 (&optional _display)
;; window-system-initialization is called by startup.el:command-line.
(cl-defmethod window-system-initialization (&context (window-system (eql pc))
&optional _display)
"Initialization function for the `pc' \"window system\"."
(or (eq (window-system) 'pc)
(error
......@@ -370,17 +376,14 @@ Errors out because it is not supposed to be called, ever."
(menu-bar-enable-clipboard)
(run-hooks 'terminal-init-msdos-hook))
;; frame-creation-function-alist is examined by frame.el:make-frame.
(gui-method-define frame-creation-function
pc #'msdos-create-frame-with-faces)
;; window-system-initialization-alist is examined by startup.el:command-line.
(gui-method-define window-system-initialization
pc #'msdos-initialize-window-system)
;; frame-creation-function is called by frame.el:make-frame.
(cl-defmethod frame-creation-function (params &context (window-system (eql pc)))
(msdos-create-frame-with-faces params))
;; We don't need anything beyond tty-handle-args for handling
;; command-line argument; see startup.el.
(gui-method-define handle-args-function pc #'tty-handle-args)
(cl-defmethod handle-args-function (args &context (window-system (eql pc)))
(tty-handle-args args))
;; ---------------------------------------------------------------------------
......
......@@ -290,7 +290,8 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(declare-function x-parse-geometry "frame.c" (string))
(defvar x-command-line-resources)
(defun w32-initialize-window-system (&optional _display)
(cl-defmethod window-system-initialization (&context (window-system (eql w32))
&optional _display)
"Initialize Emacs for W32 GUI frames."
(cl-assert (not w32-initialized))
......@@ -376,11 +377,11 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(setq w32-initialized t))
(add-to-list 'display-format-alist '("\\`w32\\'" . w32))
(gui-method-define handle-args-function w32 #'x-handle-args)
(gui-method-define frame-creation-function w32
#'x-create-frame-with-faces)
(gui-method-define window-system-initialization w32
#'w32-initialize-window-system)
(cl-defmethod handle-args-function (args &context (window-system (eql w32)))
(x-handle-args args))
(cl-defmethod frame-creation-function (params &context (window-system (eql w32)))
(x-create-frame-with-faces params))
;;;; Selections
......@@ -406,18 +407,41 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(and (memq selection '(nil PRIMARY SECONDARY))
(get 'x-selections (or selection 'PRIMARY))))
(gui-method-define gui-set-selection w32 #'w32--set-selection)
(gui-method-define gui-get-selection w32 #'w32--get-selection)
(cl-defmethod gui-backend-set-selection (type value
&context (window-system (eql w32)))
(w32--set-selection type value))
(cl-defmethod gui-backend-get-selection (type data-type
&context (window-system (eql w32)))
(w32--get-selection type data-type))
(cl-defmethod gui-backend-selection-owner-p (selection
&context (window-system (eql w32)))
(w32--selection-owner-p selection))
(gui-method-define gui-selection-owner-p w32 #'w32--selection-owner-p)
(gui-method-define gui-selection-exists-p w32 #'w32-selection-exists-p)
(cl-defmethod gui-backend-selection-exists-p (selection
&context (window-system (eql w32)))
(w32-selection-exists-p selection))
(when (eq system-type 'windows-nt)
;; Make copy&pasting in w32's console interact with the system's clipboard!
(gui-method-define gui-set-selection nil #'w32--set-selection)
(gui-method-define gui-get-selection nil #'w32--get-selection)
(gui-method-define gui-selection-owner-p nil #'w32--selection-owner-p)
(gui-method-define gui-selection-exists-p nil #'w32-selection-exists-p))
;; We could move those cl-defmethods outside of the `when' and use
;; "&context (system-type (eql windows-nt))" instead!
(cl-defmethod gui-backend-set-selection (type value
&context (window-system (eql nil)))
(w32--set-selection type value))
(cl-defmethod gui-backend-get-selection (type data-type
&context (window-system (eql nil)))
(w32--get-selection type data-type))
(cl-defmethod gui-backend-selection-owner-p (selection
&context (window-system (eql nil)))
(w32--selection-owner-p selection))
(cl-defmethod gui-selection-exists-p (selection
&context (window-system (eql nil)))
(w32-selection-exists-p selection)))
;; The "Windows" keys on newer keyboards bring up the Start menu
;; whether you want it or not - make Emacs ignore these keystrokes
......
......@@ -29,8 +29,7 @@
;; Beginning in Emacs 23, the act of loading this file should not have
;; the side effect of initializing the window system or processing
;; command line arguments (this file is now loaded in loadup.el). See
;; the variables `handle-args-function-alist' and
;; `window-system-initialization-alist' for more details.
;; `handle-args-function' and `window-system-initialization' for more details.
;; startup.el will then examine startup files, and eventually call the hooks
;; which create the first window(s).
......@@ -1206,7 +1205,8 @@ This returns an error if any Emacs frames are X frames."
(defvar x-display-name)
(defvar x-command-line-resources)
(defun x-initialize-window-system (&optional display)
(cl-defmethod window-system-initialization (&context (window-system (eql x))
&optional display)
"Initialize Emacs for X frames and open the first connection to an X server."
(cl-assert (not x-initialized))
......@@ -1335,17 +1335,29 @@ This returns an error if any Emacs frames are X frames."
(selection-symbol target-type &optional time-stamp terminal))
(add-to-list 'display-format-alist '("\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" . x))
(gui-method-define handle-args-function x #'x-handle-args)
(gui-method-define frame-creation-function x #'x-create-frame-with-faces)
(gui-method-define window-system-initialization x #'x-initialize-window-system)
(gui-method-define gui-set-selection x
(lambda (selection value)
(if value (x-own-selection-internal selection value)
(x-disown-selection-internal selection))))
(gui-method-define gui-selection-owner-p x #'x-selection-owner-p)
(gui-method-define gui-selection-exists-p x #'x-selection-exists-p)
(gui-method-define gui-get-selection x #'x-get-selection-internal)
(cl-defmethod handle-args-function (args &context (window-system (eql x)))
(x-handle-args args))
(cl-defmethod frame-creation-function (params &context (window-system (eql x)))
(x-create-frame-with-faces params))
(cl-defmethod gui-backend-set-selection (selection value
&context (window-system (eql x)))
(if value (x-own-selection-internal selection value)
(x-disown-selection-internal selection)))
(cl-defmethod gui-backend-selection-owner-p (selection
&context (window-system (eql x)))
(x-selection-owner-p selection))
(cl-defmethod gui-backend-selection-exists-p (selection
&context (window-system (eql x)))
(x-selection-exists-p selection))
(cl-defmethod gui-backend-get-selection (selection-symbol target-type
&context (window-system (eql x))
&optional time-stamp terminal)
(x-get-selection-internal selection-symbol target-type time-stamp terminal))
;; Initiate drag and drop
(add-hook 'after-make-frame-functions 'x-dnd-init-frame)
......
......@@ -787,9 +787,7 @@ We run the first FUNCTION whose STRING matches the input events."