;; -*- lexical-binding: nil; -*-
;; This file:
;;   http://anggtwu.net/elisp/2025-modern-button.el.html
;;   http://anggtwu.net/elisp/2025-modern-button.el
;;          (find-angg "elisp/2025-modern-button.el")
;; Author: Eduardo Ochs <eduardoochs@gmail.com>
;;
;; Some tools to inspect buttons in "*Help*" buffers.
;; (load (buffer-file-name))

;; «.macro»			(to "macro")
;; «.macro-test»		(to "macro-test")
;; «.test»			(to "test")
;; «.test-2»			(to "test-2")
;; «.find-ebutton-links»	(to "find-ebutton-links")


;; See: (find-efunction 'button-at)
;;      (find-efunction 'copy-marker)
(defun ee-set-button (&optional verbose)
  "Set `ee-button' to the button at point.
This function just sets `ee-button' to a marker pointing to the current
position in the current buffer - it doesn't check that it is a button."
  (interactive (list t))
  (setq ee-button (copy-marker (point) t))
  (if verbose (message "ee-button is now %S" ee-button))
  ee-button)

(defvar ee-button nil "See `ee-set-button' and `find-ebutton-links'.")



;; «macro»  (to ".macro")
;; Skel: (find-let*-macro-links "button" "b" "buf pos bp cat catp")
(defmacro ee-let*-macro-button (b &rest code)
  "An internal function used by `find-ebutton-links'."
  (declare (indent 1))
  `(let* ((b         ,b)
          (buf       (marker-buffer b))
          (pos       (marker-position b))
          (bp        (with-current-buffer buf (text-properties-at pos)))
          (cat       (plist-get bp 'category))
	  (catp      (symbol-plist cat))
	  (props0    (append bp catp))
	  (props1    (cl-loop for (k v) on props0 by 'cddr
			      collect (list k v)))
	  (props2    (ee-sort-pairs props1))
	  (badkeys   '(button evaporate face keymap mouse-face rear-nonsticky))
	  (props3    (cl-loop for (k v) in props2
			      if (not (member k badkeys))
			      collect (list k v)))
	  (helpfun   (car (alist-get 'help-function props2)))
	  (helpargs  (car (alist-get 'help-args     props2)))
	  (helpargsq (mapcar 'ee-add-quote helpargs))
	  (helpcall  (cons helpfun helpargsq)))
     ,@code))

(defun ee-button-buffer      () (ee-let*-macro-button ee-button buf))
(defun ee-button-helpcall    () (ee-let*-macro-button ee-button helpcall))
(defun ee-button-buffer-name () (buffer-name (ee-button-buffer)))
(defun find-button-buffer    () (find-ebuffer (ee-button-buffer)))
(defun find-2a-button        () (find-2a nil '(find-button-buffer)))
(defun find-3a-button    (sexp) (find-3a nil '(find-button-buffer) sexp))



;; «macro-test»  (to ".macro-test")
;; Preparation:
;;
;;   (cl-defstruct mybutton a b c)
;;   (find-2a nil '(find-etypedescr 'mybutton))
;;
;; Then: go to the window at the right,
;;       run `M-x ee-set-button' on a button,
;;       go back to this window, and
;;       run each sexp below with `M-e'.
;;
'("Note that this block is commented out!"

* (setq b ee-button)
* (ee-let*-macro-button b bp)
* (ee-let*-macro-button b bp)
* (ee-let*-macro-button b pos)
* (ee-let*-macro-button b cat)
* (ee-let*-macro-button b catp)
* (ee-let*-macro-button b props0)
* (ee-let*-macro-button b props1)
* (ee-let*-macro-button b props2)
* (ee-let*-macro-button b props3)
* (ee-let*-macro-button b helpfun)
* (ee-let*-macro-button b helpargs)
* (ee-let*-macro-button b helpargsq)
* (ee-let*-macro-button b `(,helpfun ,helpargs))
* (ee-let*-macro-button b `(,helpfun ,(car helpargs)))
* (ee-let*-macro-button b `(,helpfun ',(car helpargs)))
* (ee-let*-macro-button b (find-3h '(find-eppp props2)))
* (ee-let*-macro-button b (find-3h '(find-eppp props3)))
* (ee-let*-macro-button b (find-3h '(find-epp helpcall)))

)





;; «find-ebutton-links»  (to ".find-ebutton-links")
;; Skel: (find-find-links-links-new "ebutton" "setbutton" "buffername")
;; Test: (find-ebutton-links)
;;
(defun find-ebutton-links (&optional setbutton &rest pos-spec-list)
"Visit a temporary buffer containing hyperlinks for ebutton."
  (interactive (list :setbutton))
  (if setbutton (ee-set-button))
  (let* ((buffername (ee-button-buffer-name)))
    (apply
     'find-elinks-elisp
     `((find-ebutton-links nil ,@pos-spec-list)
       (find-ebutton-links :setbutton ,@pos-spec-list)
       ;; Convention: the first sexp always regenerates the buffer.
       (find-efunction 'find-ebutton-links)
       ""
       ,(ee-template0 "\
(find-3a-button '(find-epp (ee-button-helpcall)))
(find-3a-button '(find-eppp (ee-button-helpcall)))
(find-3a-button '(find-eppp (ee-let*-macro-button ee-button props1)))
(find-3a-button '(find-eppp (ee-let*-macro-button ee-button props2)))
(find-3a-button '(find-eppp (ee-let*-macro-button ee-button props3)))

ee-button
(with-current-buffer (ee-button-buffer) (rename-buffer {(ee-S buffername)}))

(with-current-buffer (ee-button-buffer) help-xref-stack)
(with-current-buffer (ee-button-buffer) help-xref-forward-stack)
(with-current-buffer (ee-button-buffer) help-xref-stack-item)
")
       )
     pos-spec-list)))




;; Test: (cl-defstruct mybutton a b c)
;;       (find-2a nil '(find-etypedescr 'mybutton))
;;       (find-3h '(find-eppp '(2 3 4)))
(defun find-3h (sexp) (find-3a nil '(find-ebuffer "*Help*") sexp))




;; «test-2»  (to ".test-2")
;; Preparation:
;;
;;   (ee-kill-buffer "*Help*")
;;   (find-2a nil '(find-efunctiondescr 'cl-print-object))
;;   (eeks 0.5 0.5 "C-x o  M-<  6*TAB  M-x ee-set-button RET")
;;   (eeks 0.2 0.2 "C-x o  M-<  6*TAB  M-x ee-set-button RET")
'(
  (ee-let*-macro-button b helpcall)
  (setq hc (ee-let*-macro-button b helpcall))
  (find-3h '(find-eppp hc))

  (help-function-def--button-function
   '(cl-print-object nil cl-structure-object t)
   "/home/edrx/bigsrc/emacs31/lisp/emacs-lisp/cl-print.el"
    'cl-defmethod)

  ;; (find-efunction 'help-function-def--button-function)
  ;; (find-efunction 'find-function-search-for-symbol)
  ;; (find-egrep "grep --color=auto -nH --null -e help-function-def--button-function *.el */*.el")
  ;; (find-egrep "grep --color=auto -nH --null -e Implementations: *.el */*.el")

  (setq loc (find-function-search-for-symbol
	     '(cl-print-object nil cl-structure-object t)
	     'cl-defmethod
	     "/home/edrx/bigsrc/emacs31/lisp/emacs-lisp/cl-print.el"))

  (setq loc (find-function-search-for-symbol
	     '(cl-print-object nil cl-structure-object t)
	     'cl-defmethod
	     "/home/edrx/bigsrc/emacs31/lisp/emacs-lisp/cl-print.el"))

)