2016-10-09 - Prodigy Automatic Key Binding

prodigy-binder-hack.el

(defvar fn/prodigy-command-name-prefix "fmpv/"
    "The prefix when creating binding prodigy view commands.")

(defun fn/prodigy-switch-to-process-buffer (service)    
    "Just an wrapper for said function with SERVICE."
    (prodigy-switch-to-process-buffer service))

(defun fn/prodigy-prepared-switch-to-process-buffer (service)
    "Another wrapper to make specific functions for viewing SERVICE."    
    (lexical-let* ((service-name (plist-get service :name))
                   (command-name (or (plist-get service :bind-command-name)
                                     (symbol-name (gensym "prodigy-view-"))))        
                   (function-symbol (intern (format "%s%s" fn/prodigy-command-name-prefix command-name)))
                   (service service))
                  (fset function-symbol
                        `(lambda ()               
                                 ,(format "A prodigy view function for %s" service-name)
                                 (interactive)
                                 (fn/prodigy-switch-to-process-buffer (quote ,service))))      
                  function-symbol))

(defun fn/prodigy-define-service-bind-hook (define-service &rest args)    
    "When creating a service, check for a :bind keyword to create an automatic keybinding for it."
    (let ((result (apply define-service args)))
         (prog1
             result
             (let* ((service (car result))
                    (name (plist-get service :name))
                    (bind (plist-get service :bind))
                    (bind-map (or (plist-get service :bind-map) global-map)))
                   (when bind
                       (message "Creating binding for %s" name)
                       (define-key bind-map bind (fn/prodigy-prepared-switch-to-process-buffer service)))))))

(advice-add #'prodigy-define-service :around #'fn/prodigy-define-service-bind-hook)