* lisp/emacs-lisp/cl-generic.el: Add (major-mode MODE) context
(cl--generic-derived-specializers): New function. (cl--generic-derived-generalizer): New generalizer. (cl-generic-generalizers): New specializer (derived-mode MODE). (cl--generic-split-args): Apply the rewriter, if any. (cl-generic-define-context-rewriter): New macro. (major-mode): Use it to define a new context-rewriter, so we can write `(major-mode MODE)' instead of `(major-mode (derived-mode MODE))'. * lisp/frame.el (window-system): New context-rewriter so we can write `(window-system VAL)' instead of (window-system (eql VAL)). (cl--generic-split-args): Apply the rewriter, if any. (frame-creation-function): Use the new syntax. * lisp/term/x-win.el (window-system-initialization) (handle-args-function, frame-creation-function) (gui-backend-set-selection, gui-backend-selection-owner-p) (gui-backend-selection-exists-p, gui-backend-get-selection): * lisp/term/w32-win.el (window-system-initialization) (handle-args-function, frame-creation-function) (gui-backend-set-selection, gui-backend-get-selection) (gui-backend-selection-owner-p, gui-backend-selection-exists-p): * lisp/term/pc-win.el (gui-backend-get-selection) (gui-backend-selection-exists-p, gui-backend-selection-owner-p) (gui-backend-set-selection, window-system-initialization) (frame-creation-function, handle-args-function): * lisp/term/ns-win.el (window-system-initialization) (handle-args-function, frame-creation-function) (gui-backend-set-selection, gui-backend-selection-exists-p) (gui-backend-get-selection): * lisp/startup.el (handle-args-function): * lisp/term/xterm.el (gui-backend-get-selection) (gui-backend-set-selection): Use the new syntax.
This commit is contained in:
Stefan Monnier
parent
a4f754ca0b
commit
84dcdbeb74
8 changed files with 86 additions and 37 deletions
|
|
@ -266,6 +266,15 @@ BODY, if present, is used as the body of a default method.
|
|||
This macro can only be used within the lexical scope of a cl-generic method."
|
||||
(error "cl-generic-current-method-specializers used outside of a method"))
|
||||
|
||||
(defmacro cl-generic-define-context-rewriter (name args &rest body)
|
||||
"Define a special kind of context named NAME.
|
||||
Whenever a context specializer of the form (NAME . ACTUALS) appears,
|
||||
the specializer used will be the one returned by BODY."
|
||||
(declare (debug (&define name lambda-list def-body)) (indent defun))
|
||||
`(eval-and-compile
|
||||
(put ',name 'cl-generic--context-rewriter
|
||||
(lambda ,args ,@body))))
|
||||
|
||||
(eval-and-compile ;Needed while compiling the cl-defmethod calls below!
|
||||
(defun cl--generic-fgrep (vars sexp) ;Copied from pcase.el.
|
||||
"Check which of the symbols VARS appear in SEXP."
|
||||
|
|
@ -292,6 +301,11 @@ This macro can only be used within the lexical scope of a cl-generic method."
|
|||
((let 'context mandatory)
|
||||
(unless (consp arg)
|
||||
(error "Invalid &context arg: %S" arg))
|
||||
(let* ((name (car arg))
|
||||
(rewriter
|
||||
(and (symbolp name)
|
||||
(get name 'cl-generic--context-rewriter))))
|
||||
(if rewriter (setq arg (apply rewriter (cdr arg)))))
|
||||
(push `((&context . ,(car arg)) . ,(cadr arg)) specializers)
|
||||
nil)
|
||||
(`(,name . ,type)
|
||||
|
|
@ -1106,6 +1120,37 @@ The value returned is a list of elements of the form
|
|||
|
||||
(cl--generic-prefill-dispatchers 0 integer)
|
||||
|
||||
;;; Dispatch on major mode.
|
||||
|
||||
;; Two parts:
|
||||
;; - first define a specializer (derived-mode <mode>) to match symbols
|
||||
;; representing major modes, while obeying the major mode hierarchy.
|
||||
;; - then define a context-rewriter so you can write
|
||||
;; "&context (major-mode c-mode)" rather than
|
||||
;; "&context (major-mode (derived-mode c-mode))".
|
||||
|
||||
(defun cl--generic-derived-specializers (mode &rest _)
|
||||
;; FIXME: Handle (derived-mode <mode1> ... <modeN>)
|
||||
(let ((specializers ()))
|
||||
(while mode
|
||||
(push `(derived-mode ,mode) specializers)
|
||||
(setq mode (get mode 'derived-mode-parent)))
|
||||
(nreverse specializers)))
|
||||
|
||||
(cl-generic-define-generalizer cl--generic-derived-generalizer
|
||||
90 (lambda (name) `(and (symbolp ,name) (functionp ,name) ,name))
|
||||
#'cl--generic-derived-specializers)
|
||||
|
||||
(cl-defmethod cl-generic-generalizers ((_specializer (head derived-mode)))
|
||||
"Support for the `(derived-mode MODE)' specializers."
|
||||
(list cl--generic-derived-generalizer))
|
||||
|
||||
(cl-generic-define-context-rewriter major-mode (mode &rest modes)
|
||||
`(major-mode ,(if (consp mode)
|
||||
;;E.g. could be (eql ...)
|
||||
(progn (cl-assert (null modes)) mode)
|
||||
`(derived-mode ,mode . ,modes))))
|
||||
|
||||
;; Local variables:
|
||||
;; generated-autoload-file: "cl-loaddefs.el"
|
||||
;; End:
|
||||
|
|
|
|||
|
|
@ -33,8 +33,12 @@ 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)))
|
||||
(cl-generic-define-context-rewriter window-system (value)
|
||||
;; If `value' is a `consp', it's probably an old-style specializer,
|
||||
;; so just use it, and anyway `eql' isn't very useful on cons cells.
|
||||
`(window-system ,(if (consp value) value `(eql ,value))))
|
||||
|
||||
(cl-defmethod frame-creation-function (params &context (window-system 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
|
||||
|
|
|
|||
|
|
@ -720,7 +720,7 @@ 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)))
|
||||
(cl-defmethod handle-args-function (args &context (window-system nil))
|
||||
(tty-handle-args args))
|
||||
|
||||
(cl-defgeneric window-system-initialization (&optional _display)
|
||||
|
|
|
|||
|
|
@ -848,7 +848,7 @@ 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.
|
||||
(cl-defmethod window-system-initialization (&context (window-system (eql ns))
|
||||
(cl-defmethod window-system-initialization (&context (window-system ns)
|
||||
&optional _display)
|
||||
"Initialize Emacs for Nextstep (Cocoa / GNUstep) windowing."
|
||||
(cl-assert (not ns-initialized))
|
||||
|
|
@ -922,10 +922,10 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
|
|||
|
||||
;; Any display name is OK.
|
||||
(add-to-list 'display-format-alist '(".*" . ns))
|
||||
(cl-defmethod handle-args-function (args &context (window-system (eql ns)))
|
||||
(cl-defmethod handle-args-function (args &context (window-system ns))
|
||||
(x-handle-args args))
|
||||
|
||||
(cl-defmethod frame-creation-function (params &context (window-system (eql ns)))
|
||||
(cl-defmethod frame-creation-function (params &context (window-system ns))
|
||||
(x-create-frame-with-faces params))
|
||||
|
||||
(declare-function ns-own-selection-internal "nsselect.m" (selection value))
|
||||
|
|
@ -935,20 +935,20 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
|
|||
(declare-function ns-get-selection "nsselect.m" (selection-symbol target-type))
|
||||
|
||||
(cl-defmethod gui-backend-set-selection (selection value
|
||||
&context (window-system (eql ns)))
|
||||
&context (window-system 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)))
|
||||
&context (window-system ns))
|
||||
(ns-selection-owner-p selection))
|
||||
|
||||
(cl-defmethod gui-backend-selection-exists-p (selection
|
||||
&context (window-system (eql ns)))
|
||||
&context (window-system ns))
|
||||
(ns-selection-exists-p selection))
|
||||
|
||||
(cl-defmethod gui-backend-get-selection (selection-symbol target-type
|
||||
&context (window-system (eql ns)))
|
||||
&context (window-system ns))
|
||||
(ns-get-selection selection-symbol target-type))
|
||||
|
||||
(provide 'ns-win)
|
||||
|
|
|
|||
|
|
@ -221,7 +221,7 @@ the operating system.")
|
|||
|
||||
;; gui-get-selection is used in select.el
|
||||
(cl-defmethod gui-backend-get-selection (_selection-symbol _target-type
|
||||
&context (window-system (eql pc)))
|
||||
&context (window-system pc))
|
||||
"Return the value of the current selection.
|
||||
Consult the selection. Treat empty strings as if they were unset."
|
||||
;; Don't die if x-get-selection signals an error.
|
||||
|
|
@ -231,11 +231,11 @@ 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.
|
||||
(cl-defmethod gui-backend-selection-exists-p (selection
|
||||
&context (window-system (eql pc)))
|
||||
&context (window-system pc))
|
||||
(w16-selection-exists-p selection))
|
||||
|
||||
(cl-defmethod gui-backend-selection-owner-p (selection
|
||||
&context (window-system (eql pc)))
|
||||
&context (window-system pc))
|
||||
(w16-selection-owner-p selection))
|
||||
|
||||
(defun w16-selection-owner-p (_selection)
|
||||
|
|
@ -258,7 +258,7 @@ Consult the selection. Treat empty strings as if they were unset."
|
|||
(declare-function w16-set-clipboard-data "w16select.c"
|
||||
(string &optional ignored))
|
||||
(cl-defmethod gui-backend-set-selection (selection value
|
||||
&context (window-system (eql pc)))
|
||||
&context (window-system pc))
|
||||
(if (not value)
|
||||
(if (w16-selection-owner-p selection)
|
||||
t)
|
||||
|
|
@ -333,7 +333,7 @@ Errors out because it is not supposed to be called, ever."
|
|||
(window-system)))
|
||||
|
||||
;; window-system-initialization is called by startup.el:command-line.
|
||||
(cl-defmethod window-system-initialization (&context (window-system (eql pc))
|
||||
(cl-defmethod window-system-initialization (&context (window-system pc)
|
||||
&optional _display)
|
||||
"Initialization function for the `pc' \"window system\"."
|
||||
(or (eq (window-system) 'pc)
|
||||
|
|
@ -377,12 +377,12 @@ Errors out because it is not supposed to be called, ever."
|
|||
(run-hooks 'terminal-init-msdos-hook))
|
||||
|
||||
;; frame-creation-function is called by frame.el:make-frame.
|
||||
(cl-defmethod frame-creation-function (params &context (window-system (eql pc)))
|
||||
(cl-defmethod frame-creation-function (params &context (window-system pc))
|
||||
(msdos-create-frame-with-faces params))
|
||||
|
||||
;; We don't need anything beyond tty-handle-args for handling
|
||||
;; command-line argument; see startup.el.
|
||||
(cl-defmethod handle-args-function (args &context (window-system (eql pc)))
|
||||
(cl-defmethod handle-args-function (args &context (window-system pc))
|
||||
(tty-handle-args args))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -290,7 +290,7 @@ 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)
|
||||
|
||||
(cl-defmethod window-system-initialization (&context (window-system (eql w32))
|
||||
(cl-defmethod window-system-initialization (&context (window-system w32)
|
||||
&optional _display)
|
||||
"Initialize Emacs for W32 GUI frames."
|
||||
(cl-assert (not w32-initialized))
|
||||
|
|
@ -377,10 +377,10 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
|
|||
(setq w32-initialized t))
|
||||
|
||||
(add-to-list 'display-format-alist '("\\`w32\\'" . w32))
|
||||
(cl-defmethod handle-args-function (args &context (window-system (eql w32)))
|
||||
(cl-defmethod handle-args-function (args &context (window-system w32))
|
||||
(x-handle-args args))
|
||||
|
||||
(cl-defmethod frame-creation-function (params &context (window-system (eql w32)))
|
||||
(cl-defmethod frame-creation-function (params &context (window-system w32))
|
||||
(x-create-frame-with-faces params))
|
||||
|
||||
;;;; Selections
|
||||
|
|
@ -408,19 +408,19 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
|
|||
(get 'x-selections (or selection 'PRIMARY))))
|
||||
|
||||
(cl-defmethod gui-backend-set-selection (type value
|
||||
&context (window-system (eql w32)))
|
||||
&context (window-system w32))
|
||||
(w32--set-selection type value))
|
||||
|
||||
(cl-defmethod gui-backend-get-selection (type data-type
|
||||
&context (window-system (eql w32)))
|
||||
&context (window-system w32))
|
||||
(w32--get-selection type data-type))
|
||||
|
||||
(cl-defmethod gui-backend-selection-owner-p (selection
|
||||
&context (window-system (eql w32)))
|
||||
&context (window-system w32))
|
||||
(w32--selection-owner-p selection))
|
||||
|
||||
(cl-defmethod gui-backend-selection-exists-p (selection
|
||||
&context (window-system (eql w32)))
|
||||
&context (window-system w32))
|
||||
(w32-selection-exists-p selection))
|
||||
|
||||
(when (eq system-type 'windows-nt)
|
||||
|
|
@ -428,19 +428,19 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
|
|||
;; 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)))
|
||||
&context (window-system nil))
|
||||
(w32--set-selection type value))
|
||||
|
||||
(cl-defmethod gui-backend-get-selection (type data-type
|
||||
&context (window-system (eql nil)))
|
||||
&context (window-system nil))
|
||||
(w32--get-selection type data-type))
|
||||
|
||||
(cl-defmethod gui-backend-selection-owner-p (selection
|
||||
&context (window-system (eql nil)))
|
||||
&context (window-system nil))
|
||||
(w32--selection-owner-p selection))
|
||||
|
||||
(cl-defmethod gui-selection-exists-p (selection
|
||||
&context (window-system (eql nil)))
|
||||
&context (window-system nil))
|
||||
(w32-selection-exists-p selection)))
|
||||
|
||||
;; The "Windows" keys on newer keyboards bring up the Start menu
|
||||
|
|
|
|||
|
|
@ -1197,7 +1197,7 @@ This returns an error if any Emacs frames are X frames."
|
|||
(defvar x-display-name)
|
||||
(defvar x-command-line-resources)
|
||||
|
||||
(cl-defmethod window-system-initialization (&context (window-system (eql x))
|
||||
(cl-defmethod window-system-initialization (&context (window-system x)
|
||||
&optional display)
|
||||
"Initialize Emacs for X frames and open the first connection to an X server."
|
||||
(cl-assert (not x-initialized))
|
||||
|
|
@ -1327,27 +1327,27 @@ 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))
|
||||
(cl-defmethod handle-args-function (args &context (window-system (eql x)))
|
||||
(cl-defmethod handle-args-function (args &context (window-system x))
|
||||
(x-handle-args args))
|
||||
|
||||
(cl-defmethod frame-creation-function (params &context (window-system (eql x)))
|
||||
(cl-defmethod frame-creation-function (params &context (window-system x))
|
||||
(x-create-frame-with-faces params))
|
||||
|
||||
(cl-defmethod gui-backend-set-selection (selection value
|
||||
&context (window-system (eql x)))
|
||||
&context (window-system 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)))
|
||||
&context (window-system x))
|
||||
(x-selection-owner-p selection))
|
||||
|
||||
(cl-defmethod gui-backend-selection-exists-p (selection
|
||||
&context (window-system (eql x)))
|
||||
&context (window-system x))
|
||||
(x-selection-exists-p selection))
|
||||
|
||||
(cl-defmethod gui-backend-get-selection (selection-symbol target-type
|
||||
&context (window-system (eql x))
|
||||
&context (window-system x)
|
||||
&optional time-stamp terminal)
|
||||
(x-get-selection-internal selection-symbol target-type time-stamp terminal))
|
||||
|
||||
|
|
|
|||
|
|
@ -821,7 +821,7 @@ We run the first FUNCTION whose STRING matches the input events."
|
|||
|
||||
(cl-defmethod gui-backend-get-selection
|
||||
(type data-type
|
||||
&context (window-system (eql nil))
|
||||
&context (window-system nil)
|
||||
;; Only applies to terminals which have it enabled.
|
||||
((terminal-parameter nil 'xterm--get-selection) (eql t)))
|
||||
(unless (eq data-type 'STRING)
|
||||
|
|
@ -844,7 +844,7 @@ We run the first FUNCTION whose STRING matches the input events."
|
|||
|
||||
(cl-defmethod gui-backend-set-selection
|
||||
(type data
|
||||
&context (window-system (eql nil))
|
||||
&context (window-system nil)
|
||||
;; Only applies to terminals which have it enabled.
|
||||
((terminal-parameter nil 'xterm--set-selection) (eql t)))
|
||||
"Copy DATA to the X selection using the OSC 52 escape sequence.
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue