From 5888c37335dfb3732ec6abc65dbadf0537f57a64 Mon Sep 17 00:00:00 2001 From: Nathan Weizenbaum Date: Tue, 17 Aug 2010 15:07:03 -0700 Subject: [PATCH 1/2] Major changes to the extension API. As discussed in http://groups.google.com/group/magit/t/6a302dc5cdc05d42, this remodels the extension API with an eye towards using existing Emacs extension points (such as hooks and keymaps) directly, rather than abstracting them through an additional layer. This will also hopefully make it easier for users to do their own customization without making a full-fledged extension. --- magit-svn.el | 27 +++++------ magit-topgit.el | 30 +++++------- magit.el | 120 +++++++++++++++++------------------------------- 3 files changed, 64 insertions(+), 113 deletions(-) diff --git a/magit-svn.el b/magit-svn.el index 5aab5bd3..1ad0db45 100644 --- a/magit-svn.el +++ b/magit-svn.el @@ -155,11 +155,12 @@ If USE-CACHE is non nil, use the cached information." (when (magit-svn-enabled) (magit-run-git-async "svn" "fetch"))) -(defvar magit-svn-extension-keys - `((,(kbd "N r") . magit-svn-rebase) - (,(kbd "N c") . magit-svn-dcommit) - (,(kbd "N f") . magit-svn-remote-update) - (,(kbd "N s") . magit-svn-find-rev))) +(define-prefix-command 'magit-svn-prefix 'magit-svn-map) +(define-key magit-svn-map (kbd "r") 'magit-svn-rebase) +(define-key magit-svn-map (kbd "c") 'magit-svn-dcommit) +(define-key magit-svn-map (kbd "f") 'magit-svn-remote-update) +(define-key magit-svn-map (kbd "s") 'magit-svn-find-rev))) +(define-key magit-map (kbd "N") 'magit-svn-prefix) (easy-menu-define magit-svn-extension-menu nil @@ -168,18 +169,14 @@ If USE-CACHE is non nil, use the cached information." ["Rebase" magit-svn-rebase (magit-svn-enabled)] ["Fetch" magit-svn-remote-update (magit-svn-enabled)] ["Commit" magit-svn-dcommit (magit-svn-enabled)])) +(easy-menu-add-item 'magit-mode-menu '("Extensions") magit-svn-extension-menu) -(defvar magit-svn-extension-inserters - '((:after unpulled-commits (lambda () (magit-insert-svn-unpulled t))) - (:after unpushed-commits (lambda () (magit-insert-svn-unpushed t))))) +(add-hook magit-after-insert-unpulled-commits + (lambda () (magit-insert-svn-unpulled t))) +(add-hook magit-after-insert-unpushed-commits + (lambda () (magit-insert-svn-unpushed t))) -(defvar magit-svn-extension - (make-magit-extension :keys magit-svn-extension-keys - :menu magit-svn-extension-menu - :insert magit-svn-extension-inserters - :remote-string 'magit-svn-remote-string)) - -(magit-install-extension magit-svn-extension) +(add-hook 'magit-remote-string-hook 'magit-svn-remote-string) (provide 'magit-svn) ;;; magit-svn.el ends here diff --git a/magit-topgit.el b/magit-topgit.el index 17d42c83..1bc94a37 100644 --- a/magit-topgit.el +++ b/magit-topgit.el @@ -73,27 +73,19 @@ "Topics:" 'magit-topgit-wash-topics "branch" "-v")) -(defvar magit-topgit-extension-inserters - '((:after stashes magit-insert-topics))) +(magit-add-action (item info "discard") + ((topic) + (when (yes-or-no-p "Discard topic? ") + (magit-run* (list magit-topgit-executable "delete" "-f" info) + nil nil nil t)))) -(defvar magit-topgit-extension-actions - '(("discard" ((topic) - (when (yes-or-no-p "Discard topic? ") - (magit-run* (list magit-topgit-executable "delete" "-f" info) - nil nil nil t)))) - ("visit" ((topic) - (magit-checkout info))))) +(magit-add-action (item info "visit") + ((topic) + (magit-checkout info))) -(defvar magit-topgit-extension-commands - '((create-branch . magit-topgit-create-branch) - (pull . magit-topgit-pull))) - -(defvar magit-topgit-extension - (make-magit-extension :actions magit-topgit-extension-actions - :insert magit-topgit-extension-inserters - :commands magit-topgit-extension-commands)) - -(magit-install-extension magit-topgit-extension) +(add-hook 'magit-after-insert-stashes 'magit-insert-topics) +(add-hook 'magit-create-branch-command-hook 'magit-topgit-create-branch) +(add-hook 'magit-pull-command-hook 'magit-topgit-pull) (provide 'magit-topgit) ;;; magit-topgit.el ends here diff --git a/magit.el b/magit.el index 17887bb5..b0a2f99c 100644 --- a/magit.el +++ b/magit.el @@ -359,10 +359,6 @@ Many Magit faces inherit from this one by default." (make-variable-buffer-local 'magit-submode) (put 'magit-submode 'permanent-local t) -(eval-when-compile - (defun magit-dynamic-clauses-helper (clauses context) - `(((magit-dynamic-clauses ,clauses ,context) t)))) - (defun magit-use-region-p () (if (fboundp 'use-region-p) (use-region-p) @@ -1236,8 +1232,8 @@ TITLE is the displayed title of the section." (defmacro magit-define-inserter (sym arglist &rest body) (declare (indent defun)) (let ((fun (intern (format "magit-insert-%s" sym))) - (before (intern (format "magit-insert-%s:before-hook" sym))) - (after (intern (format "magit-insert-%s:after-hook" sym))) + (before (intern (format "magit-before-insert-%s-hook" sym))) + (after (intern (format "magit-after-insert-%s-hook" sym))) (doc (format "Insert items for `%s'." sym))) `(defun ,fun ,arglist ,doc @@ -1287,23 +1283,6 @@ TITLE is the displayed title of the section." (equal (car prefix) (car list)) (magit-prefix-p (cdr prefix) (cdr list)))))) -(defun magit-inline-clause (clause context) - (if (eq (car clause) t) - clause - (let ((prefix (reverse (car clause))) - (body (cdr clause))) - `((magit-prefix-p ',prefix ,context) - ,@body)))) - -(defun magit-dynamic-clauses (clauses context) - (let* ((c (car clauses)) - (prefix (reverse (car c))) - (body (cadr c))) - (cond ((magit-prefix-p prefix context) - (eval body)) - (t - (magit-dynamic-clauses (cdr clauses) context))))) - (defmacro magit-section-case (head &rest clauses) "Make different action depending of current section. @@ -1313,42 +1292,65 @@ HEAD is (SECTION INFO &optional OPNAME), OPNAME is a string that will be used to describe current action, CLAUSES is a list of CLAUSE, each clause is (SECTION-TYPE &BODY) -where SECTION-TYPE describe section where BODY will be run." +where SECTION-TYPE describe section where BODY will be run. + +This returns non-nil if some section matches. If no section +matches, this returns nil if no OPNAME was given and throws an +error otherwise." (declare (indent 1)) (let ((section (car head)) (info (cadr head)) (type (make-symbol "*type*")) (context (make-symbol "*context*")) - (extra (make-symbol "*extra*")) (opname (caddr head))) `(let* ((,section (magit-current-section)) (,info (magit-section-info ,section)) (,type (magit-section-type ,section)) - (,context (magit-section-context-type ,section)) - (,extra (magit-get-extensions-actions ,opname))) + (,context (magit-section-context-type ,section))) (cond ,@(mapcar (lambda (clause) (if (eq (car clause) t) - clause + `(,@clause t) (let ((prefix (reverse (car clause))) (body (cdr clause))) `((magit-prefix-p ',prefix ,context) - ,@body)))) + ,@body + t)))) clauses) - ,@(magit-dynamic-clauses-helper extra context) - ,@(if opname - `(((not ,type) - (error "Nothing to %s here" ,opname)) - (t - (error "Can't %s a %s" - ,opname - (or (get ,type 'magit-description) - ,type))))))))) + ,@(when opname + `(((run-hook-with-args-until-success + ,(make-symbol (format "magit-%s-action-hook" opname))) + t) + ((not ,type) + (error "Nothing to %s here" ,opname)) + (t + (error "Can't %s a %s" + ,opname + (or (get ,type 'magit-description) + ,type))))))))) (defmacro magit-section-action (head &rest clauses) (declare (indent 1)) `(magit-with-refresh (magit-section-case ,head ,@clauses))) +(defmacro magit-add-action (head &rest clauses) + "Add additional actions to a pre-existing operator. +The syntax is identical to `magit-section-case', except that +OPNAME is mandatory and specifies the operation to which to add +the actions." + (declare (indent 1)) + (let ((section (car head)) + (info (cadr head)) + (type (caddr head))) + `(add-hook ,(make-symbol (format "magit-%s-action-hook" type)) + (lambda () + ,(macroexpand + ;; Don't pass in the opname so we don't recursively + ;; run the hook again, and so we don't throw an + ;; error if no action matches. + `(magit-section-case (,section ,info) + ,@clauses)))))) + (defun magit-wash-sequence (func) "Run FUNC until end of buffer is reached. @@ -1359,7 +1361,7 @@ FUNC should leave point at the end of the modified region" (defmacro magit-define-command (sym arglist &rest body) (declare (indent defun)) (let ((fun (intern (format "magit-%s" sym))) - (hook (intern (format "magit-%s:functions" sym))) + (hook (intern (format "magit-%s-command-hook" sym))) (doc (format "Command for `%s'." sym)) (inter nil) (instr body)) @@ -4289,46 +4291,6 @@ With prefix force the removal even it it hasn't been merged." (magit-list-buffers)) 'string=))) -;; Extensions - -(defvar magit-active-extensions '()) - -(defstruct magit-extension - keys menu actions insert remote-string commands) - -(defun magit-install-extension (ext) - (add-to-list 'magit-active-extensions ext) - (let ((keys (magit-extension-keys ext)) - (menu (magit-extension-menu ext)) - (actions (magit-extension-actions ext)) - (insert (magit-extension-insert ext)) - (remote-string (magit-extension-remote-string ext)) - (commands (magit-extension-commands ext))) - (when keys - (mapc (lambda (x) (define-key magit-mode-map (car x) (cdr x))) - keys)) - (when menu - (easy-menu-add-item 'magit-mode-menu '("Extensions") menu)) - (when insert - (mapc (lambda (x) - (destructuring-bind (position reference hook) x - (add-hook (intern (format "magit-insert-%s%s-hook" - reference position)) - hook))) - insert)) - (when remote-string - (add-hook 'magit-remote-string-hook remote-string)) - (when commands - (mapc (lambda (x) - (add-hook (intern (format "magit-%s:functions" (car x))) - (cdr x))) - commands)))) - -(defun magit-get-extensions-actions (action) - (mapcar (lambda (ext) - (cadr (assoc action (magit-extension-actions ext)))) - magit-active-extensions)) - (provide 'magit) ;;; magit.el ends here From dc7dc90808ee1fdb943247e4c79691d83228d108 Mon Sep 17 00:00:00 2001 From: Nathan Weizenbaum Date: Tue, 17 Aug 2010 16:50:47 -0700 Subject: [PATCH 2/2] Properly quote hook names. --- magit.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/magit.el b/magit.el index b0a2f99c..c4969850 100644 --- a/magit.el +++ b/magit.el @@ -1318,7 +1318,7 @@ error otherwise." clauses) ,@(when opname `(((run-hook-with-args-until-success - ,(make-symbol (format "magit-%s-action-hook" opname))) + ',(make-symbol (format "magit-%s-action-hook" opname))) t) ((not ,type) (error "Nothing to %s here" ,opname)) @@ -1342,7 +1342,7 @@ the actions." (let ((section (car head)) (info (cadr head)) (type (caddr head))) - `(add-hook ,(make-symbol (format "magit-%s-action-hook" type)) + `(add-hook ',(make-symbol (format "magit-%s-action-hook" type)) (lambda () ,(macroexpand ;; Don't pass in the opname so we don't recursively