helpful-apropos about helpful HOT 14 OPEN

(let ((do-function (lambda (button)
		     (helpful-function (button-get button 'apropos-symbol))))
      (do-variable (lambda (button)
		     (helpful-variable (button-get button 'apropos-symbol)))))
  ;; :supertype only takes effect statically, at the time of
  ;; definition, so we can in fact redefine a button with itself
  ;; as its supertype
  (define-button-type 'apropos-function :supertype 'apropos-function 'action do-function)
  (define-button-type 'apropos-macro :supertype 'apropos-macro 'action do-function)
  (define-button-type 'apropos-command :supertype 'apropos-command 'action do-function)
  (define-button-type 'apropos-variable :supertype 'apropos-variable 'action do-variable)
  (define-button-type 'apropos-user-option :supertype 'apropos-user-option 'action do-variable))

;;; helpful-in-helm ---- Add helpful action to helm-sources  -*- lexical-binding: t; -*-

;;; Usage:

;;; Activate with:
;; (use-package helpful
;;;  :init
;;;  (use-package helm
;;;    :init
;;;    (add-hook 'after-init-hook #'helpful-in-helm-activate)))

;;; ... then use M-x helm-apropos as normal. Press tab to see
;;; "Helpful" persistant action and press ENTER to select it.

;;; Commentary:

;;; Implementation: I don't understand how to add a persistent action
;;; to helm-elisp stuff, so I went with a advice-add style
;;; modification.

;;; Code:

(require 'helm-elisp)


(defvar helpful-in-helm--persistent-action-text
  "Helpful: View in helpful.")

(defvar helpful-in-help--helm-apropos-sources
  '(helm-def-source--emacs-commands
    helm-def-source--emacs-functions
    helm-def-source--eieio-classes
    helm-def-source--eieio-generic
    helm-def-source--emacs-variables
    helm-def-source--emacs-faces)
  "List of helm source generator functions that return a helm-source alist.
The command `helm-apropos' uses these sources. We will modify the
\"action\" key in the alist to include a helm persistent action
that will call `helpful'.

You should modify this if you modify `helm-apropos-function-list'.
FIXME: Should be linked instead of copied.")

;; command interface

;;;###autoload
(defun helpful-in-helm-activate ()
  "Activate the functionality.
See the docs in`helpful-in-help--helm-apropos-sources'.
FIXME: should be a minor mode?"
  (interactive)
  ;; first deactivate the advice, if any, then activate
  (helpful-in-helm--do-init :deactivate)
  (helpful-in-helm--do-init :activate))

(defun helpful-in-helm-deactivate ()
  "Deactivate the functionality.
See the docs in`helpful-in-help--helm-apropos-sources'."
  (interactive)
  (helpful-in-helm--do-init :deactivate))

;; lib (internals)

(defun helpful-in-helm--do-init (action)
  "Activate/deactivate based on ACTION."
  (mapcar
     (lambda (gensrcfun)
       (cond ((eql action :deactivate)
              (advice-remove gensrcfun #'helpful-in-helm--add-action-helpful))
             (t
              (advice-add gensrcfun :filter-return #'helpful-in-helm--add-action-helpful))))
     helpful-in-help--helm-apropos-sources))


(defun helpful-in-helm--add-action-helpful (orgfun-retval)
  "Add a persistent action to a helm source that will call helpful.

This advice function will :filter-return the original function's
return val ORGFUN-RETVAL."
  (prog1 orgfun-retval
    (let* ((src orgfun-retval)
           (insert-idx 0)) ;; insert at front
      (helm-add-action-to-source helpful-in-helm--persistent-action-text
                                 #'helpful-in-help--lookup-str-as-symbol
                                 src
                                 insert-idx))))

(defun helpful-in-help--lookup-str-as-symbol (str-sym)
  "Internal function to call `helpful-symbol'<f> on STR-SYM."
  (helpful-symbol (intern str-sym)))


(provide 'helpful-in-helm)
;;helpful-in-helm.el ends here

(advice-add 'describe-function :override #'helpful-function)
(advice-add 'describe-variable :override #'helpful-variable)
;; for completeness, not relevant to the discussion
(advice-add 'describe-command  :override #'helpful-callable)
(advice-add 'describe-key      :override #'helpful-key)
(advice-add 'describe-symbol   :override #'helpful-symbol)

;; overrides in apropos to try to use helpful-* instead.

(require 'apropos)

(define-button-type 'apropos-function
  'apropos-label "Function"
  'apropos-short-label "f"
  'face 'apropos-function-button
  'help-echo "mouse-2, RET: Display more help on this function"
  'follow-link t
  'action (lambda (button)
            (helpful-function (button-get button 'apropos-symbol))))

(define-button-type 'apropos-macro
  'apropos-label "Macro"
  'apropos-short-label "m"
  'face 'apropos-function-button
  'help-echo "mouse-2, RET: Display more help on this macro"
  'follow-link t
  'action (lambda (button)
            (helpful-function (button-get button 'apropos-symbol))))

(define-button-type 'apropos-command
  'apropos-label "Command"
  'apropos-short-label "c"
  'face 'apropos-function-button
  'help-echo "mouse-2, RET: Display more help on this command"
  'follow-link t
  'action (lambda (button)
            (helpful-function (button-get button 'apropos-symbol))))

(define-button-type 'apropos-variable
  'apropos-label "Variable"
  'apropos-short-label "v"
  'face 'apropos-variable-button
  'help-echo "mouse-2, RET: Display more help on this variable"
  'follow-link t
  'action (lambda (button)
            (helpful-variable (button-get button 'apropos-symbol))))

(define-button-type 'apropos-user-option
  'apropos-label "User option"
  'apropos-short-label "o"
  'face 'apropos-user-option-button
  'help-echo "mouse-2, RET: Display more help on this user option"
  'follow-link t
  'action (lambda (button)
            (helpful-variable (button-get button 'apropos-symbol))))

;; (define-button-type 'apropos-face
;;   'apropos-label "Face"
;;   'apropos-short-label "F"
;;   'face '(font-lock-variable-name-face button)
;;   'help-echo "mouse-2, RET: Display more help on this face"
;;   'follow-link t
;;   'action (lambda (button)
;;             (describe-face (button-get button 'apropos-symbol))))
;;
;; (define-button-type 'apropos-group
;;   'apropos-label "Group"
;;   'apropos-short-label "g"
;;   'face 'apropos-misc-button
;;   'help-echo "mouse-2, RET: Display more help on this group"
;;   'follow-link t
;;   'action (lambda (button)
;;             (customize-group-other-window
;;              (button-get button 'apropos-symbol))))
;;
;; (define-button-type 'apropos-widget
;;   'apropos-label "Widget"
;;   'apropos-short-label "w"
;;   'face 'apropos-misc-button
;;   'help-echo "mouse-2, RET: Display more help on this widget"
;;   'follow-link t
;;   'action (lambda (button)
;;             (widget-browse-other-window (button-get button 'apropos-symbol))))
;;
;; (define-button-type 'apropos-plist
;;   'apropos-label "Properties"
;;   'apropos-short-label "p"
;;   'face 'apropos-misc-button
;;   'help-echo "mouse-2, RET: Display more help on this plist"
;;   'follow-link t
;;   'action (lambda (button)
;;             (apropos-describe-plist (button-get button 'apropos-symbol))))
;;
;; (define-button-type 'apropos-library
;;   'help-echo "mouse-2, RET: Display more help on this library"
;;   'follow-link t
;;   'action (lambda (button)
;;             (apropos-library (button-get button 'apropos-symbol))))