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'.
This commit is contained in:
Stefan Monnier
parent
dc4484ec6d
commit
919281ddb2
13 changed files with 218 additions and 198 deletions
|
|
@ -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))
|
||||
|
||||
(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-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))
|
||||
|
||||
(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)
|
||||
(cl-defmethod handle-args-function (args &context (window-system (eql x)))
|
||||
(x-handle-args args))
|
||||
|
||||
(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 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."
|
|||
|
||||
;; FIXME: This defines the gui method for all terminals, even tho it only
|
||||
;; supports a subset of them.
|
||||
(gui-method-define gui-set-selection nil #'xterm--set-selection)
|
||||
|
||||
(defun xterm--set-selection (type data)
|
||||
(cl-defmethod gui-backend-set-selection (type data &context (window-system (eql nil)))
|
||||
"Copy DATA to the X selection using the OSC 52 escape sequence.
|
||||
|
||||
TYPE specifies which selection to set; it must be either
|
||||
|
|
|
|||
|
|
@ -385,18 +385,12 @@ Updated by Christian Limpach (chris@nice.ch)
|
|||
|
||||
|
||||
DEFUN ("ns-selection-exists-p", Fns_selection_exists_p, Sns_selection_exists_p,
|
||||
0, 2, 0, doc: /* Whether there is an owner for the given X selection.
|
||||
0, 1, 0, doc: /* Whether there is an owner for the given X selection.
|
||||
SELECTION should be the name of the selection in question, typically
|
||||
one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. (X expects
|
||||
these literal upper-case names.) The symbol nil is the same as
|
||||
`PRIMARY', and t is the same as `SECONDARY'.
|
||||
|
||||
TERMINAL should be a terminal object or a frame specifying the X
|
||||
server to query. If omitted or nil, that stands for the selected
|
||||
frame's display, or the first available X display.
|
||||
|
||||
On Nextstep, TERMINAL is unused. */)
|
||||
(Lisp_Object selection, Lisp_Object terminal)
|
||||
`PRIMARY', and t is the same as `SECONDARY'. */)
|
||||
(Lisp_Object selection)
|
||||
{
|
||||
id pb;
|
||||
NSArray *types;
|
||||
|
|
@ -416,20 +410,14 @@ Updated by Christian Limpach (chris@nice.ch)
|
|||
|
||||
|
||||
DEFUN ("ns-selection-owner-p", Fns_selection_owner_p, Sns_selection_owner_p,
|
||||
0, 2, 0,
|
||||
0, 1, 0,
|
||||
doc: /* 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'.
|
||||
|
||||
TERMINAL should be a terminal object or a frame specifying the X
|
||||
server to query. If omitted or nil, that stands for the selected
|
||||
frame's display, or the first available X display.
|
||||
|
||||
On Nextstep, TERMINAL is unused. */)
|
||||
(Lisp_Object selection, Lisp_Object terminal)
|
||||
and t is the same as `SECONDARY'. */)
|
||||
(Lisp_Object selection)
|
||||
{
|
||||
check_window_system (NULL);
|
||||
CHECK_SYMBOL (selection);
|
||||
|
|
@ -442,22 +430,12 @@ Updated by Christian Limpach (chris@nice.ch)
|
|||
|
||||
|
||||
DEFUN ("ns-get-selection", Fns_get_selection,
|
||||
Sns_get_selection, 2, 4, 0,
|
||||
Sns_get_selection, 2, 2, 0,
|
||||
doc: /* Return text selected from some X window.
|
||||
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'.
|
||||
|
||||
TIME-STAMP is the time to use in the XConvertSelection call for foreign
|
||||
selections. If omitted, defaults to the time for the last event.
|
||||
|
||||
TERMINAL should be a terminal object or a frame specifying the X
|
||||
server to query. If omitted or nil, that stands for the selected
|
||||
frame's display, or the first available X display.
|
||||
|
||||
On Nextstep, TIME-STAMP and TERMINAL are unused. */)
|
||||
(Lisp_Object selection_name, Lisp_Object target_type,
|
||||
Lisp_Object time_stamp, Lisp_Object terminal)
|
||||
TARGET-TYPE is the type of data desired, typically `STRING'. */)
|
||||
(Lisp_Object selection_name, Lisp_Object target_type)
|
||||
{
|
||||
Lisp_Object val = Qnil;
|
||||
|
||||
|
|
@ -488,16 +466,16 @@ Updated by Christian Limpach (chris@nice.ch)
|
|||
NXSecondaryPboard = @"Secondary";
|
||||
|
||||
// This is a memory loss, never released.
|
||||
pasteboard_changecount =
|
||||
[[NSMutableDictionary
|
||||
dictionaryWithObjectsAndKeys:
|
||||
[NSNumber numberWithLong:0], NSGeneralPboard,
|
||||
[NSNumber numberWithLong:0], NXPrimaryPboard,
|
||||
[NSNumber numberWithLong:0], NXSecondaryPboard,
|
||||
[NSNumber numberWithLong:0], NSStringPboardType,
|
||||
[NSNumber numberWithLong:0], NSFilenamesPboardType,
|
||||
[NSNumber numberWithLong:0], NSTabularTextPboardType,
|
||||
nil] retain];
|
||||
pasteboard_changecount
|
||||
= [[NSMutableDictionary
|
||||
dictionaryWithObjectsAndKeys:
|
||||
[NSNumber numberWithLong:0], NSGeneralPboard,
|
||||
[NSNumber numberWithLong:0], NXPrimaryPboard,
|
||||
[NSNumber numberWithLong:0], NXSecondaryPboard,
|
||||
[NSNumber numberWithLong:0], NSStringPboardType,
|
||||
[NSNumber numberWithLong:0], NSFilenamesPboardType,
|
||||
[NSNumber numberWithLong:0], NSTabularTextPboardType,
|
||||
nil] retain];
|
||||
}
|
||||
|
||||
void
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue