Org-mode custom youtube link syntax

Question

I would like to define a custom org-mode link, which accepts the following syntax:

[[yt:<video ID>]]

and produces an image link equivalent to this:

[[https://youtu.be/<video ID>][http://img.youtube.com/vi/<video ID>/0.jpg]]

Any ideas?

Answer 1

The abbreviated link type can easily be defined with org-set-link-parameters. That handles url's like yt:<video ID> but not image overlays for org links like [[https://youtu.be/<video ID>][http://img.youtube.com/vi/<video ID>/0.jpg]].

The regular expression for image overlays is hard-coded in org-display-inline-images.

Thus you need to add the generation of the image overlays for yt links to that function. One way to do that is an :after-advice.

One can re-use a large part of org-display-inline-images for that job. Best was a refactoring of org-display-inline-images. (This function should definitively be split into several functions.) But, that would be a task for the org-devs.

I've taken a section out of org-display-inline-images to do the job. You can copy that stuff into your init-file, restart emacs and voila you get what you ask for.

This is a simple variant. Maybe, one could add file-caching for the retrieved youtube-images.

(require 'org)
(require 'org-element)

(defcustom org-yt-url-protocol "yt"
  "Protocol identifier for youtube links."
  :group 'org-yt
  :type 'string)

(defun org-yt-follow (video-id)
  "Open youtube with VIDEO-ID."
  (browse-url (concat "https://youtu.be/" video-id)))

(org-link-set-parameters org-yt-url-protocol :follow #'org-yt-follow)

(defun org-image-update-overlay (file link &optional data-p refresh)
  "Create image overlay for FILE associtated with org-element LINK.
        If DATA-P is non-nil FILE is not a file name but a string with the image data.
        See also `create-image'.
        This function is almost a duplicate of a part of `org-display-inline-images'."
  (when (or data-p (file-exists-p file))
    (let ((width
           ;; Apply `org-image-actual-width' specifications.
           (cond
            ((not (image-type-available-p 'imagemagick)) nil)
            ((eq org-image-actual-width t) nil)
            ((listp org-image-actual-width)
             (or
              ;; First try to find a width among
              ;; attributes associated to the paragraph
              ;; containing link.
              (let ((paragraph
                     (let ((e link))
                       (while (and (setq e (org-element-property
                                            :parent e))
                                   (not (eq (org-element-type e)
                                            'paragraph))))
                       e)))
                (when paragraph
                  (save-excursion
                    (goto-char (org-element-property :begin paragraph))
                    (when
                        (re-search-forward
                         "^[ \t]*#\\+attr_.*?: +.*?:width +\\(\\S-+\\)"
                         (org-element-property
                          :post-affiliated paragraph)
                         t)
                      (string-to-number (match-string 1))))))
              ;; Otherwise, fall-back to provided number.
              (car org-image-actual-width)))
            ((numberp org-image-actual-width)
             org-image-actual-width)))
          (old (get-char-property-and-overlay
                (org-element-property :begin link)
                'org-image-overlay)))
      (if (and (car-safe old) refresh)
          (image-refresh (overlay-get (cdr old) 'display))
        (let ((image (create-image file
                                   (and width 'imagemagick)
                                   data-p
                                   :width width)))
          (when image
            (let* ((link
                    ;; If inline image is the description
                    ;; of another link, be sure to
                    ;; consider the latter as the one to
                    ;; apply the overlay on.
                    (let ((parent
                           (org-element-property :parent link)))
                      (if (eq (org-element-type parent) 'link)
                          parent
                        link)))
                   (ov (make-overlay
                        (org-element-property :begin link)
                        (progn
                          (goto-char
                           (org-element-property :end link))
                          (skip-chars-backward " \t")
                          (point)))))
              (overlay-put ov 'display image)
              (overlay-put ov 'face 'default)
              (overlay-put ov 'org-image-overlay t)
              (overlay-put
               ov 'modification-hooks
               (list 'org-display-inline-remove-overlay))
              (push ov org-inline-image-overlays))))))))

(defun org-yt-get-image (url)
  "Retrieve image from url."
  (let ((image-buf (url-retrieve-synchronously url)))
    (when image-buf
      (with-current-buffer image-buf
        (goto-char (point-min))
        (when (looking-at "HTTP/")
          (delete-region (point-min)
                         (progn (re-search-forward "\n[\n]+")
                                (point))))
        (setq image-data (buffer-substring-no-properties (point-min) (point-max)))))))

(defconst org-yt-video-id-regexp "[-_[:alnum:]]\\{10\\}[AEIMQUYcgkosw048]"
  "Regexp matching youtube video id's taken from `https://webapps.stackexchange.com/questions/54443/format-for-id-of-youtube-video'.")

(defun org-yt-display-inline-images (&optional include-linked refresh beg end)
  "Like `org-display-inline-images' but for yt-links."
  (when (display-graphic-p)
    (org-with-wide-buffer
     (goto-char (or beg (point-min)))
     (let ((re (format "\\[\\[%s:\\(%s\\)\\]\\]" org-yt-url-protocol org-yt-video-id-regexp)))
       (while (re-search-forward re end t)
         (let ((video-id (match-string 1))
               (el (save-excursion (goto-char (match-beginning 1)) (org-element-context)))
               image-data)
           (when el
             (setq image-data 
                   (or (let ((old (get-char-property-and-overlay
                                   (org-element-property :begin el)
                                   'org-image-overlay)))
                         (and old
                              (car-safe old)
                              (overlay-get (cdr old) 'display)))
                       (org-yt-get-image (format "http://img.youtube.com/vi/%s/0.jpg" video-id))))
             (when image-data
               (org-image-update-overlay image-data el t t)))))))))

(advice-add #'org-display-inline-images :after #'org-yt-display-inline-images)

Test environment:

• emacs version 25.3.1
• org-mode version 9.0.9 (installed from melpa), (also works with version 9.1.6)

Test:

• Start emacs with emacs -Q
• Run M-x package-initialize RET
• Copy above code to the *scratch* buffer
• Call there M-x eval-buffer RET
• Call C-x b test.org RET M-x org-mode RET

• Insert following org code into that buffer

  [[yt:papuvlVeZg8]]
  
  [[yt:_ha3o-YcnhA]]
  
  [[yt:s43sptuwkvA]]
  
  [[yt:cxjvTXo9WWM]]
  
  [[yt:W6e1TctNyw8]]
  

• Call M-x org-display-inline-images RET (that is also needed for standard inline images)