[emacs] Adding buttons to infobox

4 files changed, 45 insertions, 18 deletions

diff --git a/emacs/.emacs.d/lisp/my/my-gitlab.el b/emacs/.emacs.d/lisp/my/my-gitlab.el
index ad7f0ed..27f3344 100644
--- a/emacs/.emacs.d/lisp/my/my-gitlab.el
+++ b/emacs/.emacs.d/lisp/my/my-gitlab.el
@@ -73,9 +73,19 @@
          (string-match-p "^/[^/]+/[^/]+$" (url-filename urlobj)))))
 
 (require 'my-buffer)
+(require 'my-web)
+(require 'my-magit)
+(defun my-gitlab-format-url (url)
+  (concat url
+          " -- " (buttonize "clone"
+                            (lambda (_)
+                              (my-magit-clone url current-prefix-arg)))
+          " " (buttonize "context"
+                         (lambda (_)
+                           (funcall my-url-context-function url)))))
 
 (defvar my-gitlab-project-info-specs
-  `((http_url_to_repo . "Clone")
+  `((http_url_to_repo . ("URL" . my-gitlab-format-url))
     (name_with_namespace . "Name")
     (description . "Description")
     (created_at . ("Created at" . my-gitlab-format-time-string))
diff --git a/emacs/.emacs.d/lisp/my/my-magit.el b/emacs/.emacs.d/lisp/my/my-magit.el
index efb3c84..eabed05 100644
--- a/emacs/.emacs.d/lisp/my/my-magit.el
+++ b/emacs/.emacs.d/lisp/my/my-magit.el
@@ -32,23 +32,26 @@
 (require 'my-project)
 (require 'org)
 
-(defun my-magit-clone-org-source (arg)
-  (interactive "P")
-  (let* ((url (or (org-entry-get (point) "Source")
-                  (org-entry-get (point) "Website")))
-         (default-base-dir
-           (alist-get "3p" my-projects-root-dirs nil nil 'string=))
+(defun my-magit-clone (url prefix-arg)
+  (let* ((default-base-dir
+          (alist-get "3p" my-projects-root-dirs nil nil 'string=))
          (default-name
-           (progn (string-match "^.*/\\(.*?\\)\\(\\.git\\)?$" url)
-                  (match-string 1 url)))
+          (progn (string-match "^.*/\\(.*?\\)\\(\\.git\\)?$" url)
+                 (match-string 1 url)))
          (dir (read-file-name
-               (if arg "Clone to: " "Shallow clone to: ")
+               (if prefix-arg "Clone to: " "Shallow clone to: ")
                (concat default-base-dir "/")
                nil nil
                default-name)))
-    (if arg
+    (if prefix-arg
         (magit-clone-regular url dir nil)
-      (magit-clone-shallow url dir nil 1))
+      (magit-clone-shallow url dir nil 1))))
+
+(defun my-magit-clone-org-source (arg)
+  (interactive "P")
+  (let* ((url (or (org-entry-get (point) "Source")
+                  (org-entry-get (point) "Website"))))
+    (my-magit-clone url arg)
     (org-set-property "Local-source"
                       (format "<file:%s>" dir))))
 
diff --git a/emacs/.emacs.d/lisp/my/my-web.el b/emacs/.emacs.d/lisp/my/my-web.el
index 472cab6..6c3cd92 100644
--- a/emacs/.emacs.d/lisp/my/my-web.el
+++ b/emacs/.emacs.d/lisp/my/my-web.el
@@ -161,6 +161,9 @@ Useful for bypassing some paywalls."
   (my-url-as-googlebot
    (my-fetch-browse url no-overwrite)))
 
+(require 'hmm)
+(defvar my-url-context-function 'hmm-url "Context function for urls.")
+
 (defun my-mastodon-url-p (url)
   "Guess if a url is a mastodon post.
 e.g. https://hostux.social/@fsf/113709722998924141
diff --git a/emacs/.emacs.d/lisp/my/my-ytdl.el b/emacs/.emacs.d/lisp/my/my-ytdl.el
index 2811793..bf917ce 100644
--- a/emacs/.emacs.d/lisp/my/my-ytdl.el
+++ b/emacs/.emacs.d/lisp/my/my-ytdl.el
@@ -94,14 +94,25 @@
              (string-match-p "^/watch\\?v=.*" (url-filename urlobj)))
         (equal "youtu.be" (url-host urlobj)))))
 
+(require 'hmm)
+(defvar my-ytdl-player 'hmm-external-mpv "Function to play ytdl urls.")
+
+(defun my-ytdl-video-render-info (info url)
+  (setf (alist-get 'webpage_url info)
+        (concat (alist-get 'webpage_url info)
+                " -- " (buttonize "play" (lambda (_)
+                                           (funcall my-ytdl-player url)))
+                " " (buttonize "context"
+                               (lambda (_)
+                                 (funcall my-url-context-function url)))))
+  (infobox-render
+   (infobox-translate info (infobox-default-specs info))
+   `(my-ytdl-video-infobox ,url)
+   (called-interactively-p 'interactive)))
+
 (defun my-ytdl-video-infobox (url)
   (interactive "sytdl video url: ")
-  (let* ((info (my-ytdl-video-info url))
-         (specs (infobox-default-specs info)))
-    (infobox-render
-     (infobox-translate info specs)
-     `(my-ytdl-video-infobox ,url)
-     (called-interactively-p 'interactive))))
+  (my-ytdl-video-render-info (my-ytdl-video-info url) url))
 
 ;;; fixme: autoload
 (defun my-ytdl-video (urls)