From 84dcdbeb740222a9e3da636b87a2b757acc11334 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 29 Oct 2015 11:06:31 -0400 Subject: * 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. --- lisp/emacs-lisp/cl-generic.el | 45 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 0d7ef5b2e61..aae517e8ea7 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -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 ) 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 ... ) + (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: -- cgit v1.2.3