-
Notifications
You must be signed in to change notification settings - Fork 10
/
org-yt.el
329 lines (292 loc) · 12.5 KB
/
org-yt.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
;;; org-yt.el --- Org youtube links. -*- lexical-binding: t; -*-
;; Copyright (C) 2018 U-ESI-INTERNAL\TOZ
;; Author: U-ESI-INTERNAL\TOZ <[email protected]>
;; Keywords: multimedia
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Idea from https://emacs.stackexchange.com/questions/38098/org-mode-custom-youtube-link-syntax
;;; Code:
(require 'org)
(require 'org-element)
(defcustom org-yt-url-protocol "yt"
"Protocol identifier for youtube links."
:group 'org-yt
:type 'string)
(defcustom org-yt-cache-directory (expand-file-name "yt-cache" user-emacs-directory)
"Directory used to cache thumbnails."
:group 'org-yt
:type 'string
)
(defcustom org-yt-use-cache t
"When not nil, maintain a cache of downloaded thumbnails."
:group 'org-yt
:type 'boolean
)
(defcustom org-yt-cache-limit 100
"Maximal number of cached thumbnail image files."
:group 'org-yt
:type '(choice :format "%{%t%}: %[Cache Limit Type%] %v" :label "Enable/Disable Cache Limit" :tag "Delimit Cache Size" (const :tag "Unlimited" nil) (number :tag "Number of Images")))
;;; End of Customizations
(defconst org-yt-image-file-extension "jpg"
"Extension for Youtube thumbnail image files.")
(defun org-yt-image-link (video-id)
"Return image link for VIDEO-ID as string."
(format "https://img.youtube.com/vi/%s/0.%s" video-id org-yt-image-file-extension))
(defun org-yt-video-link (video-id)
"Return video link for VIDEO-ID as string."
(concat "https://youtu.be/" video-id))
(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.
If REFRESH is non-nil don't download the file but refresh the image.
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
((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 (image-type-available-p 'imagemagick)
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)
ov)))))))
(defun org-yt-get-image (video-id)
"Retrieve thumbnail image for VIDEO-ID."
(condition-case err
(let* ((url (org-yt-image-link video-id))
(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))))
(buffer-substring-no-properties (point-min) (point-max)))))
(error
(message "Retrieving thumbnail for video [%s] [%s]" video-id err)
nil
)))
(defun org-yt-image-cache-file-name (video-id)
"Return absolute cache file name for VIDEO-ID."
(expand-file-name (format "%s.%s" video-id org-yt-image-file-extension) org-yt-cache-directory))
(defun org-yt-image-in-cache (video-id)
"Retrieve thumbnail for VIDEO-ID from cache."
;; try it, does it work, good.
;; Not? file not in cache or an error. there is nothing we can do
(condition-case nil
(with-temp-buffer
(set-buffer-multibyte nil)
(insert-file-contents-literally (org-yt-image-cache-file-name video-id))
(let (
(thumbnail(buffer-string))
)
;; make sure we got something
(if (> (string-bytes thumbnail) 0)
thumbnail
nil)))
(error nil)))
(cl-defun org-yt-old-images-in-cache (&optional (max-cache-size org-yt-cache-limit))
"Determine the oldest images exceeding the cache limit.
The age of images is determined by their access time.
The cache limit is given by MAX-CACHE-SIZE.
The default for MAX-CACHE-SIZE is `org-yt-cache-limit'.
Return nil when `org-yt-cache-limit' is not a positive number."
(when (and (numberp max-cache-size)
(> max-cache-size 0))
(nthcdr max-cache-size
(sort
(directory-files
org-yt-cache-directory
t
(format "\\.%s\\'" (regexp-quote org-yt-image-file-extension)))
(lambda (fn1 fn2)
(time-less-p
(file-attribute-access-time (file-attributes fn2))
(file-attribute-access-time (file-attributes fn1))))))))
;; Test:
;; (org-yt-cache-old-images 2)
(defun org-yt-image-to-cache (video-id image)
"Save the thumbnail IMAGE for VIDEO-ID to the cache.
Always returns IMAGE, even if the save operation fails."
;; but only do if there is data
(when (> (string-bytes image) 0)
(condition-case err
(progn
;; create directory if it does not exist
(unless (file-directory-p org-yt-cache-directory)
(make-directory org-yt-cache-directory t)
)
(with-temp-buffer
(insert image)
(write-region (point-min) (point-max)
(org-yt-image-cache-file-name video-id)))
)
(error
(message "Unable to write video thumbnail for video [%s] to cache [%s]... continuing" video-id err)
)))
(dolist (old-file (org-yt-old-images-in-cache))
(delete-file old-file))
image)
(defun org-yt-get-image-for-id (video-id)
"Retrieve thumbnail for VIDEO-ID.
Try cache first."
(if org-yt-use-cache
(or (org-yt-image-in-cache video-id)
(org-yt-image-to-cache video-id (org-yt-get-image video-id)))
(org-yt-get-image video-id)
)
)
(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-follow (video-id)
"Open youtube with VIDEO-ID."
(browse-url (org-yt-video-link video-id)))
(defun org-yt-image-data-fun (_protocol link _description)
"Get image corresponding to LINK from youtube.
Use this as :image-data-fun property in `org-link-properties'.
See `org-display-user-inline-images' for a description of :image-data-fun."
(when (string-match org-yt-video-id-regexp link)
(org-yt-get-image-for-id link)))
(org-link-set-parameters org-yt-url-protocol
:follow #'org-yt-follow
:image-data-fun #'org-yt-image-data-fun)
(require 'subr-x)
(defun org-display-user-inline-images (&optional _include-linked _refresh beg end)
"Like `org-display-inline-images' but for image data links.
_INCLUDE-LINKED and _REFRESH are ignored.
Restrict to region between BEG and END if both are non-nil.
Image data links have a :image-data-fun parameter.
\(See `org-link-set-parameters'.)
The value of the :image-data-fun parameter is a function
taking the PROTOCOL, the LINK, and the DESCRIPTION as arguments.
If that function returns nil the link is not interpreted as image.
Otherwise the return value is the image data string to be displayed.
Note that only bracket links are allowed as image data links
with one of the formats
[[PROTOCOL:LINK]]
or
[[PROTOCOL:LINK][DESCRIPTION]]
are recognized."
(interactive)
(when (and (called-interactively-p 'any)
(use-region-p))
(setq beg (region-beginning)
end (region-end)))
(when (display-graphic-p)
(org-with-wide-buffer
(goto-char (or beg (point-min)))
(when-let ((image-data-link-parameters
(cl-loop for link-par-entry in org-link-parameters
with fun
when (setq fun (plist-get (cdr link-par-entry) :image-data-fun))
collect (cons (car link-par-entry) fun)))
(image-data-link-re (regexp-opt (mapcar 'car image-data-link-parameters)))
(re (format "\\[\\[\\(%s\\):\\([^]]+\\)\\]\\(?:\\[\\([^]]+\\)\\]\\)?\\]"
image-data-link-re)))
(while (re-search-forward re end t)
(let* ((protocol (match-string-no-properties 1))
(link (match-string-no-properties 2))
(description (match-string-no-properties 3))
(image-data-link (assoc-string protocol image-data-link-parameters))
(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)))
(funcall (cdr image-data-link) protocol link description)))
(when image-data
(let ((ol (org-image-update-overlay image-data el t t)))
(when (and ol description)
(overlay-put ol 'after-string description)))))))))))
(advice-add #'org-display-inline-images :after #'org-display-user-inline-images)
;; Export
(defun org-yt-export (video-id description backend ext-plist)
"Export youtube video with VIDEO-ID to BACKEND.
If DESCRIPTION is a string put it below the video.
EXT-PLIST is the data channel for the export backend."
(let* ((video-link (org-yt-video-link video-id)))
(org-export-string-as
(concat
(format "[[%s][%s]]" video-link (org-yt-image-link video-id))
(when description
(format " [[%s][%s]]" video-link description)))
backend
t
ext-plist)))
(org-link-set-parameters "yt" :export #'org-yt-export)
(provide 'org-yt)
;;; org-yt.el ends here