~/vendor/whisperx/.venv/bin/whisperx --compute_type int8 --highlight_words True --print_progress True "$1"

{"segments": [{"start": 0.427, "end": 7.751, "text": " I often need to... I sometimes need to replace or navigate by symbols.", "words": [{"word": "I", "start": 0.427, "end": 0.507, "score": 0.994}, {"word": "often", "start": 0.587, "end": 0.887, "score": 0.856}, {"word": "need", "start": 0.987, "end": 1.227, "score": 0.851}, {"word": "to...", "start": 1.267, "end": 1.508, "score": 0.738}, {"word": "I", "start": 4.329, "end": 4.429, "score": 0.778}, ...]}, ...]}

(defun my-subed-word-tsv-from-whisperx-json (file)
  (interactive "FJSON: ")
  (let* ((json-array-type 'list)
         (json-object-type 'alist)
         (data (json-read-file file))
         (filename (concat (file-name-sans-extension file) ".tsv"))
         (base (seq-mapcat
                (lambda (segment)
                  (seq-map (lambda (word)
                             (let-alist word
                               (list nil
                                     (and .start (* 1000 .start))
                                     (and .end (* 1000 .end))
                                     .word)))
                           (alist-get 'words segment)))
                (alist-get 'segments data)))
         (current base)
         (last-end 0))
     ;; numbers at the end of a sentence sometimes don't end up with times
     ;; so we need to fix them
    (while current
      (unless (elt (car current) 1)           ; start
        (setf (elt (car current) 1) (1+ last-end)))
      (unless (elt (car current) 2)
        (setf (elt (car current) 2) (1- (elt (cadr current) 1))))
      (setq
       last-end (elt (car current) 2)
       current (cdr current)))
    (subed-create-file
     filename
     base
     t
     'subed-tsv-mode)
    (find-file filename)))

(defun my-subed-load-word-data-from-whisperx-highlights (file)
  "Return a list of word cues from FILE.
FILE should be a VTT or SRT file produced by whisperx with the
--highlight_words True option."
  (seq-keep (lambda (sub)
              (when (string-match "<u>\\(.+?\\)</u>" (elt sub 3))
                (setf (elt sub 3) (match-string 1 (elt sub 3)))
                sub))
            (subed-parse-file file)))

(defun my-subed-word-tsv-from-whisperx-highlights (file)
  (interactive "FVTT: ")
  (with-current-buffer (find-file-noselect (concat (file-name-nondirectory file) ".tsv"))
    (erase-buffer)
    (subed-tsv-mode)
    (subed-auto-insert)
    (mapc (lambda (sub) (apply #'subed-append-subtitle nil (cdr sub)))
          (my-subed-load-word-data-from-whisperx-highlights file))
    (switch-to-buffer (current-buffer))))

(defvar my-subed-merge-close-subtitles-threshold 500)
(defun my-subed-merge-close-subtitles (threshold)
  "Merge subtitles with the following one if there is less than THRESHOLD msecs gap between them."
  (interactive (list (read-number "Threshold in msecs: " my-subed-merge-close-subtitles-threshold)))
  (goto-char (point-min))
  (while (not (eobp))
    (let ((end (subed-subtitle-msecs-stop))
          (next-start (save-excursion
                        (and (subed-forward-subtitle-time-start)
                             (subed-subtitle-msecs-stop)))))
      (if (and end next-start (< (- next-start end) threshold))
          (subed-merge-with-next)
        (or (subed-forward-subtitle-end) (goto-char (point-max)))))))

(global-hl-line-mode 1)

(defun my-suggest-other-faces (func &rest args)
  (if global-hl-line-mode
      (progn
        (global-hl-line-mode -1)
        (prog1 (apply func args)
          (global-hl-line-mode 1)))
    (apply func args)))
(advice-add #'face-at-point :around #'my-suggest-other-faces)

(use-package org
  :config
  (add-to-list
   'org-capture-templates
   '("w" "Emacs News" entry (file+headline "~/sync/orgzly/news.org" "Collect Emacs News")
     "* %a  :news:

#+begin_quote
%:text
#+end_quote

"
     :prepend t :immediate-finish t)))
(defun my-mastodon-save-toot-for-emacs-news ()
  (interactive)
  ;; boost if not already boosted
  (unless (get-text-property
           (car
            (mastodon-tl--find-property-range 'byline (point)))
           'boosted-p)
    (mastodon-toot--toggle-boost-or-favourite 'boost))
  ;; store a link and capture the note
  (org-capture nil "w"))

(use-package mastodon
  :bind (:map mastodon-mode-map ("w" . my-mastodon-save-toot-for-emacs-news)))

(defun my-emacs-news-summarize-mastodon-items ()
  (interactive)
  (while (not (eobp))
    (let* ((info (my-mastodon-get-note-info))
           (title (when (car (plist-get info :links))
                    (my-page-title (car (plist-get info :links)))))
           (summary (read-string
                     (if title
                         (format "Summary (%s): " title)
                       "Summary: ")
                     title)))
      (org-cut-subtree)
      (unless (string= summary "")
        (insert "- " (org-link-make-string
                      (or (car (plist-get info :links))
                          (plist-get info :url))
                      summary)
                (if (and (car (plist-get info :links))
                         (plist-get info :handle))
                    (concat " (" (org-link-make-string (plist-get info :url)
                                                       (plist-get info :handle))
                            ")")
                  "")
                "\n")))))
(defun my-mastodon-get-note-info ()
  "Return (:handle ... :url ... :links ... :text) for the current subtree."
  (let ((url (org-entry-get (point) "ITEM"))
        beg end
        handle)
    (save-excursion
      (org-back-to-heading)
      (org-end-of-meta-data)
      (setq beg (point))
      (setq end (org-end-of-subtree))
      (when (string-match "https://\\(.+?\\)/\\(@.+?\\)/" url)
        (setq handle (concat
                      (match-string 2 url) "@" (match-string 1 url))))

      (list
       :handle handle
       :url (if (string-match org-link-bracket-re url) (match-string 1 url) url)
       :links (mapcar (lambda (o) (org-element-property :raw-link o))
                      (my-org-get-links-in-region beg end))
       :text (string-trim (buffer-substring-no-properties beg end))))))

(ert-deftest my-mastodon-get-note-info ()
 (should
  (equal
   (with-temp-buffer
     (insert "** SOMEDAY https://mastodon.online/@jcastp/111762105597746747         :news:
:PROPERTIES:
:CREATED:  [2024-01-22 Mon 05:51]
:END:

jcastp@mastodon.online - I've shared my emacs config: https://codeberg.org/jcastp/emacs.d

After years of reading other's configs, copying really useful snippets, and tinkering a little bit myself, I wanted to give something back, although I'm still an amateur (and it shows, but I want to improve!)

If you can find there something you can use, then I'm happy to be useful to the community.

#emacs
")
     (org-mode)
     (my-mastodon-get-note-info))
   '(:handle "@jcastp@mastodon.online"
             :url
             "https://mastodon.online/@jcastp/111762105597746747"
             :links
             ("https://codeberg.org/jcastp/emacs.d")
             :text
             "jcastp@mastodon.online - I've shared my emacs config: https://codeberg.org/jcastp/emacs.d\n\nAfter years of reading other's configs, copying really useful snippets, and tinkering a little bit myself, I wanted to give something back, although I'm still an amateur (and it shows, but I want to improve!)\n\nIf you can find there something you can use, then I'm happy to be useful to the community.\n\n#emacs"))))

(defun my-mastodon-fetch-posts-after (base-url after-date)
  "Page backwards through BASE-URL using max_id for all the posts after AFTER-DATE."
  (require 'plz)
  (require 'mastodon-http)
  (let ((results [])
        (url base-url)
        (use-mastodon-el (not (string-match "^http" base-url)))
        (json-array-type 'list)
        page filtered)
    (while url
      (setq page (if use-mastodon-el
                     (mastodon-http--get-json (mastodon-http--api url) nil :silent)
                   (seq-map (lambda (o)
                              (cons (cons 'external t) o))
                            (plz 'get url :as #'json-read)))
            filtered (seq-filter (lambda (o) (string< after-date (assoc-default 'created_at o)))
                                 page))
      (if filtered
          (progn
            (setq results (seq-concatenate 'vector filtered results)
                  url (concat base-url (if (string-match "\\?" base-url) "&" "?")
                              "max_id=" (number-to-string (1- (string-to-number (assoc-default 'id (elt (last page) 0)))))))
            (message "%s %s" (assoc-default 'created_at (elt (last page) 0)) url))
        (setq url nil)))
    results))

(defun my-mastodon-combined-tag-timeline (later-than tag servers)
  "Display items after LATER-THAN about TAG from SERVERS and the current mastodon.el account."
  (interactive (list
                (org-read-date nil nil nil nil nil "-Mon")
                "#emacs"
                '("mastodon.social" "emacs.ch" "fosstodon.org")))
  (require 'mastodon)
  (require 'mastodon-tl)
  (require 'mastodon-toot)
  (let* ((limit 40)
         (sources (cons (format "timelines/tag/emacs?count=%d" limit)
                        (mapcar (lambda (s)
                                  (format "https://%s/api/v1/timelines/tag/emacs?count=%d" s limit))
                                servers)))
         (combined
          (sort
           (seq-reduce (lambda (prev val)
                         (seq-union prev
                                    (my-mastodon-fetch-posts-after val later-than)
                                    (lambda (a b) (string= (assoc-default 'uri a)
                                                           (assoc-default 'uri b)))))
                       sources [])
           (lambda (a b)
             (string< (assoc-default 'created_at b)
                      (assoc-default 'created_at a))))))
    (with-current-buffer (get-buffer-create "*Combined*")
      (let ((inhibit-read-only t))
        (erase-buffer)
        (mastodon-tl--timeline combined)
        (mastodon-mode))
      (setq mastodon-tl--buffer-spec `(account ,(cons mastodon-active-user mastodon-instance-url) buffer-name ,(buffer-name)))
      (display-buffer (current-buffer)))))

(defun my-mastodon-lookup-toot ()
  (interactive)
  (mastodon-url-lookup (mastodon-toot--toot-url)))

(defun my-text-property-update-at-point (pos prop value)
  (let ((start (previous-single-property-change (or pos (point)) prop))
        (end (next-single-property-change (or pos (point)) prop)))
    (put-text-property (or start (point-min))
                       (or end (point-max))
                       prop value)))

(defun my-mastodon-update-external-item-id (&rest _)
  (when (mastodon-tl--field 'external (mastodon-tl--property 'item-json))
    ;; ask the server to resolve it
    (let* ((response (mastodon-http--get-json (format "%s/api/v2/search" mastodon-instance-url)
                                              `(("q" . ,(mastodon-toot--toot-url))
                                                ("resolve" . "t"))))
           (id (alist-get 'id (seq-first (assoc-default 'statuses response))))
           (inhibit-read-only t)
           (json (get-text-property (point) 'item-json)))
      (when (and id json)
        (my-text-property-update-at-point (point) 'base-item-id id)
        (my-text-property-update-at-point (point) 'item-json
                                          (progn
                                            (setf (alist-get 'id json) id)
                                            (setf (alist-get 'external json) nil)
                                            json))))))

(with-eval-after-load 'mastodon-tl
  (advice-add #'mastodon-toot--action :before #'my-mastodon-update-external-item-id)
  (advice-add #'mastodon-toot--reply :before #'my-mastodon-update-external-item-id)
  (advice-add #'mastodon-tl--thread :before #'my-mastodon-update-external-item-id))