forked from emacs-circe/circe
-
Notifications
You must be signed in to change notification settings - Fork 0
/
circe-display-images.el
207 lines (175 loc) · 8.44 KB
/
circe-display-images.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
;;; circe-display-images.el --- Display images in the channel -*- lexical-binding: t -*-
;; Copyright (C) 2017 Nathan Aclander
;; Author: Nathan Aclander <[email protected]>
;; This file is part of Circe.
;; 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, write to the Free Software
;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
;; 02110-1301 USA
;;; Commentary:
;; This Circe modules adds the ability to display various image types when
;; they are linked in a channel. Images are inserted on new lines after
;; the message containing the URLs. This module requires ImageMagcik.
;; To use it, put the following into your .emacs:
;; (require 'circe-display-images)
;; (enable-circe-display-images)
;;; Code:
(require 'circe)
(require 'url)
;;;###autoload
(defun enable-circe-display-images ()
"Enable the Display Images module for Circe.
This module displays various image types when they are linked in a channel"
(interactive)
(dolist (buf (buffer-list))
(with-current-buffer buf
(when (eq major-mode 'circe-channel-mode)
(add-circe-display-images))))
(add-hook 'circe-channel-mode-hook
'add-circe-display-images))
(defun disable-circe-display-images ()
"Disable the Display Images module for Circe.
See `enable-circe-display-images'."
(interactive)
(dolist (buf (buffer-list))
(with-current-buffer buf
(when (eq major-mode 'circe-channel-mode)
(remove-circe-display-images))))
(remove-hook 'circe-channel-mode-hook
'add-circe-display-images))
(defun add-circe-display-images ()
"Add `circe-display-images' to `lui-pre-output-hook'."
(add-hook 'lui-pre-output-hook 'circe-display-images))
(defun remove-circe-display-images ()
"Remove `circe-display-images' from `lui-pre-output-hook'."
(remove-hook 'lui-pre-output-hook 'circe-display-images))
(defgroup circe-display-images nil
"Image display properties for Circe"
:prefix "circe-display-images"
:group 'circe)
(defcustom circe-display-images-image-regex
"\\(https?://[^ ]*?\\.\\(?:png\\|jpg\\|jpeg\\|svg\\|gif\\)\\)"
"Regex used to find images in channel messages. This regex needs to be
greedy to match multiple images on the same line."
:group 'circe-display-images
:type 'string)
(defcustom circe-display-images-max-height 400
"The image's maximum allowed height. Images will be scaled down if they
are larger than this"
:group 'circe-display-images
:type 'integer)
(defcustom circe-display-images-background nil
"Background used for the images background, if image supports transparency.
Defaults to the frame's background color."
:group 'circe-display-images
:type 'string)
(defcustom circe-display-images-animate-gifs nil
"Animate any gifs that are displayed. This might slow down Emacs."
:group 'circe-display-images
:type 'boolean)
(defvar-local circe-display-images-text-property-map (make-hash-table
:test 'equal)
"A hash map used to manage display transitions.
The keys are urls, and the values are a plist with an `:image-property', and a
`:display-image-p'. `:image-property' is the display property of the image, and
`:display-image-p' is a flag telling us whether the image is currently visible
or not. This map serves to keep track of display transitions, and as a mapping
between the URL and its downloaded image.
Unfortunately we can't map from URL to the image position in the buffer
because 1) the lui library can move text around when executing the
`lui-post-output-hooks' and 2) as we toggle images, that also changes other
images' position in the buffer.")
(defun circe-display-images-toggle-image-at-point ()
"Toggle the image corresponding to the url at point.
This function iterates through all display properties in the buffer. We look
for a match with the display property we got from our property map, with the
url-at-point as the key. When we find a match, we either remove or add back
the image. See `circe-display-images-text-property-map' for more details."
;; Giant thank you to Malabarba who's S-O answer I slightly modified:
;; https://emacs.stackexchange.com/a/566
(interactive)
(let*
((inhibit-read-only t)
(url (thing-at-point-url-at-point))
(image-data(gethash url circe-display-images-text-property-map))
(display-image-p (plist-get image-data :display-image-p))
(image-property-of-url (plist-get image-data :image-property))
(from (if display-image-p 'display 'display-backup))
(to (if display-image-p 'display-backup 'display))
(current-pos (point-min))
left current-image-property)
(while (and current-pos (/= current-pos (point-max)))
;; Find the next image property in the buffer.
(if (get-text-property current-pos from)
(setq left current-pos)
(setq left (next-single-property-change current-pos from)))
(if (or (null left) (= left (point-max)))
(setq current-pos nil)
(setq current-image-property (get-text-property left from))
(setq current-pos (or (next-single-property-change left from)
(point-max)))
;; Swap the images if our current image matches the image from the URL.
(when (equal image-property-of-url current-image-property)
(add-text-properties
left current-pos (list from nil to current-image-property)))))
;; Make sure to invert the :display-image-p flag after processing all
;; images.
(puthash url `(:image-property ,image-property-of-url
:display-image-p ,(not display-image-p))
circe-display-images-text-property-map)))
(defun circe-display-images-insert-image-from-url (url)
"Attempt to download the image from URL, and insert it."
(let ((buffer (url-retrieve-synchronously url)))
(when buffer
(unwind-protect
(let* ((data (with-current-buffer buffer
(goto-char (point-min))
(search-forward "\n\n")
(buffer-substring (point) (point-max))))
(img (circe-create-image data)))
(when img
(insert-image img)
;; Store the image so that we can toggle it on and off later. We
;; know the image is 1 behind us, since we just inserted it.
(let* ((image-property
(get-text-property (- (point) 1) 'display)))
(puthash url
`(:image-property ,image-property :display-image-p t)
circe-display-images-text-property-map))
;; This is safely a no-op if the image isn't a gif.
(when circe-display-images-animate-gifs
(image-animate img))))
(kill-buffer buffer)))))
(defconst circe-image-type (if (image-type-available-p 'imagemagick) 'imagemagick nil)
"Imagemagick image type if Emacs was compiled with support for ImageMagick, otherwise nil")
(defun circe-create-image (data)
"Attempt to create image using Imagemagick type if available, otherwise guess type"
(create-image data circe-image-type t
:max-height circe-display-images-max-height
:background circe-display-images-background))
(defun circe-display-images-urls-in-body ()
"Return all urls that match the circe-display-images-image-regex"
(let (urls)
(while (re-search-forward circe-display-images-image-regex nil t)
(setq urls (cons (match-string-no-properties 1) urls)))
(reverse urls)))
(defun circe-display-images ()
"Replace image link with downloaded image on this lui output line"
(let ((body (text-property-any (point-min) (point-max)
'lui-format-argument 'body)))
(when body
(goto-char body)
(dolist (url (circe-display-images-urls-in-body))
(newline)
(circe-display-images-insert-image-from-url url)
(newline)))))
(provide 'circe-display-images)
;;; circe-display-images.el ends here