* helm-source.el: Add classes for type function and command.

Add accessors for all defined types.

* helm-misc.el: Rewrite lacarte using helm-source classes.

2 files changed, 88 insertions, 21 deletions

diff --git a/helm-misc.el b/helm-misc.el
index 043a0462..c436bbd8 100644
--- a/helm-misc.el
+++ b/helm-misc.el
@@ -187,19 +187,7 @@ http://www.emacswiki.org/cgi-bin/wiki/download/linkd.el")
 ;;; LaCarte
 ;;
 ;;
-(defun helm-create-lacarte-source (name &optional maps)
-  "Create lacarte source named NAME for MAPS.
-MAPS is like in `lacarte-get-overall-menu-item-alist'.
-See
-    http://www.emacswiki.org/cgi-bin/wiki/download/lacarte.el"
-  `((name . ,name)
-    (init . (lambda () (require 'lacarte)))
-    (candidates . (lambda ()
-                    (with-helm-current-buffer
-                      (delete '(nil) (lacarte-get-overall-menu-item-alist ,@maps)))))
-    (candidate-transformer . helm-lacarte-candidate-transformer)
-    (candidate-number-limit . 9999)
-    (type . command)))
+(declare-function lacarte-get-overall-menu-item-alist "ext:lacarte.el" (&optional MAPS))
 
 (defun helm-lacarte-candidate-transformer (cands)
   (mapcar (lambda (cand)
@@ -211,17 +199,39 @@ See
               cand))
           cands))
 
-(defvar helm-source-lacarte (helm-create-lacarte-source "Lacarte")
-  "Helm interface for lacarte.el.
-See
-    http://www.emacswiki.org/cgi-bin/wiki/download/lacarte.el")
+(defclass helm-lacarte (helm-source-sync helm-type-command)
+    ((init :initform (lambda () (require 'lacarte)))
+     (candidates :initform 'helm-lacarte-get-candidates)
+     (candidate-transformer :initform 'helm-lacarte-candidate-transformer)
+     (candidate-number-limit :initform 9999)))
+
+(defun helm-lacarte-get-candidates (&optional maps)
+  "Extract candidates for menubar using lacarte.el.
+See http://www.emacswiki.org/cgi-bin/wiki/download/lacarte.el.
+Optional argument MAPS is a list specifying which keymaps to use: it
+can contain the symbols `local', `global', and `minor', mean the
+current local map, current global map, and all current minor maps."
+  (with-helm-current-buffer
+    ;; FIXME: do we still need to remove possible '(nil) candidates.
+    (lacarte-get-overall-menu-item-alist maps)))
 
 ;;;###autoload
-(defun helm-browse-menubar ()
-  "Helm interface to the menubar using lacarte.el."
-  (interactive)
+(defun helm-browse-menubar (arg)
+  "Helm interface to the menubar using lacarte.el.
+With no prefix arg call the local current major-mode menu,
+with one prefix arg call the global menu,
+with two prefix args call the menu for the possible minor-mode in effect."
+  (interactive "P")
   (require 'lacarte)
-  (helm :sources 'helm-source-lacarte :buffer "*helm lacarte*"))
+  (helm :sources (helm-make-source "Lacarte" 'helm-lacarte
+                   :candidates (lambda ()
+                                 (helm-lacarte-get-candidates
+                                  (cond ((equal arg '(4))
+                                         '(global))
+                                        ((equal arg '(16))
+                                         '(minor))
+                                        (t '(local))))))
+        :buffer "*helm lacarte*"))
 
 (defun helm-call-interactively (cmd-or-name)
   "Execute CMD-OR-NAME as Emacs command.
diff --git a/helm-source.el b/helm-source.el
index 3357115d..08c63aba 100644
--- a/helm-source.el
+++ b/helm-source.el
@@ -747,6 +747,35 @@
                                                      helm-buffers-sort-transformer
                                                      helm-highlight-buffers)))
 
+;; Functions
+(defclass helm-type-function (helm-source) ()
+  "A class to define helm type function.")
+
+(defmethod helm--setup-source :before ((source helm-type-function))
+  (oset source :action (helm-make-actions
+                         "Describe command" 'describe-function
+                         "Add command to kill ring" 'helm-kill-new
+                          "Go to command's definition" 'find-function
+                          "Debug on entry" 'debug-on-entry
+                          "Cancel debug on entry" 'cancel-debug-on-entry
+                          "Trace function" 'trace-function
+                          "Trace function (background)" 'trace-function-background
+                          "Untrace function" 'untrace-function))
+  (oset source :action-transformer 'helm-transform-function-call-interactively)
+  (oset source :candidate-transformer 'helm-mark-interactive-functions)
+  (oset source :coerce 'helm-symbolify))
+
+;; Commands
+(defclass helm-type-command (helm-source) ()
+  "A class to define helm type command.")
+
+(defmethod helm--setup-source :before ((source helm-type-command))
+  (oset source :action (append (helm-make-actions
+                                "Call interactively" 'helm-call-interactively)
+                               (helm-actions-from-type-function)))
+  (oset source :coerce 'helm-symbolify)
+  (oset source :persistent-action 'describe-function))
+
 
 ;;; Error functions
 ;;
@@ -773,6 +802,7 @@ Argument NAME is a string which define the source name, so no need to use
 the keyword :name in your source, NAME will be used instead.
 Argument CLASS is an eieio class object.
 Arguments ARGS are keyword value pairs as defined in CLASS."
+  (declare (indent 2))  
   (let ((source (apply #'make-instance class name args)))
     (oset source :name name)
     (helm--setup-source source)
@@ -837,9 +867,20 @@ an eieio class."
           (delq nil (append (list transformer) action-transformers)))))
 
 ;;; Methods to access types slots.
+;;
+;;
 (defmethod helm-source-get-action-from-type ((object helm-type-file))
   (oref object :action))
 
+(defmethod helm-source-get-action-from-type ((object helm-type-buffer))
+  (oref object :action))
+
+(defmethod helm-source-get-action-from-type ((object helm-type-bookmark))
+  (oref object :action))
+
+(defmethod helm-source-get-action-from-type ((object helm-type-function))
+  (oref object :action))
+
 
 ;;; Methods to build sources.
 ;;
@@ -951,6 +992,22 @@ Args ARGS are keywords provided by `helm-source-dummy'."
 (defun helm-build-type-file ()
   (helm-make-type 'helm-type-file))
 
+(defun helm-actions-from-type-function ()
+  (let ((source (make-instance 'helm-type-function)))
+    (helm--setup-source source)
+    (helm-source-get-action-from-type source)))
+
+(defun helm-build-type-function ()
+  (helm-make-type 'helm-type-function))
+
+(defun helm-actions-from-type-command ()
+  (let ((source (make-instance 'helm-type-command)))
+    (helm--setup-source source)
+    (helm-source-get-action-from-type source)))
+
+(defun helm-build-type-command ()
+  (helm-make-type 'helm-type-command))
+
 (provide 'helm-source)
 
 ;; Local Variables: