[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 919281d: Replace gui-method macros with cl-generic
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] master 919281d: Replace gui-method macros with cl-generic with &context |
|
Date: |
Sat, 23 May 2015 15:32:38 +0000 |
branch: master
commit 919281ddb2eec5b5503c246dfad902d44aa25644
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>
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'.
---
lisp/emacs-lisp/edebug.el | 2 +-
lisp/frame.el | 40 ++++++++----------------
lisp/menu-bar.el | 25 +++++++++------
lisp/select.el | 35 ++++++++++-----------
lisp/server.el | 17 ++++++----
lisp/simple.el | 6 ++--
lisp/startup.el | 29 +++++++++--------
lisp/term/ns-win.el | 35 ++++++++++++++-------
lisp/term/pc-win.el | 73 +++++++++++++++++++++++---------------------
lisp/term/w32-win.el | 52 +++++++++++++++++++++++--------
lisp/term/x-win.el | 40 ++++++++++++++++--------
lisp/term/xterm.el | 4 +--
src/nsselect.m | 60 ++++++++++++-------------------------
13 files changed, 219 insertions(+), 199 deletions(-)
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index b5da3cc..b5b68d2 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -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)
diff --git a/lisp/frame.el b/lisp/frame.el
index 0c1fb38..077687e 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -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)
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 2ace316..a1b6d95 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -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."
diff --git a/lisp/select.el b/lisp/select.el
index f68d3d6..74b48d1 100644
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -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.
diff --git a/lisp/server.el b/lisp/server.el
index 29d2160..2007635 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -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.
diff --git a/lisp/simple.el b/lisp/simple.el
index 49a95ae..4ef45c5 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -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).
diff --git a/lisp/startup.el b/lisp/startup.el
index cb8a6a9..a24198b 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -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))
diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el
index e642ab5..f603f3e 100644
--- a/lisp/term/ns-win.el
+++ b/lisp/term/ns-win.el
@@ -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)
diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el
index dd4a8ae..b6c7222 100644
--- a/lisp/term/pc-win.el
+++ b/lisp/term/pc-win.el
@@ -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))
;; ---------------------------------------------------------------------------
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index b0667e6..8bbc3dd 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -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
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index f929288..39145ff 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -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)
diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el
index 667e4ce..4e48e80 100644
--- a/lisp/term/xterm.el
+++ b/lisp/term/xterm.el
@@ -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
diff --git a/src/nsselect.m b/src/nsselect.m
index 1544b16..918fb55 100644
--- a/src/nsselect.m
+++ b/src/nsselect.m
@@ -385,18 +385,12 @@ Disowning it means there is no such selection. */)
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 @@ On Nextstep, TERMINAL is unused. */)
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 @@ On Nextstep, TERMINAL is unused. */)
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 @@ nxatoms_of_nsselect (void)
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
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master 919281d: Replace gui-method macros with cl-generic with &context,
Stefan Monnier <=