9da3ffee41
This is a massive diff that I had to do in a hurry - when leaving Urbint. I'm pretty sure that most of these are updating Emacs packages, but I'm not positive.
197 lines
8.1 KiB
EmacsLisp
197 lines
8.1 KiB
EmacsLisp
;;; circe-display-images.el --- Display images in the channel -*- lexical-binding: t -*-
|
|
|
|
;; Copyright (C) 2017 Nathan Aclander
|
|
|
|
;; Author: Nathan Aclander <nathan.aclander@gmail.com>
|
|
|
|
;; 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)
|
|
|
|
(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)
|
|
|
|
(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)
|
|
|
|
(defcustom circe-display-images-animate-gifs nil
|
|
"Animate any gifs that are displayed. This might slow down Emacs."
|
|
:group 'circe-display-images)
|
|
|
|
(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 (url-get-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 (create-image
|
|
data 'imagemagick t
|
|
:max-height circe-display-images-max-height
|
|
:background circe-display-images-background)))
|
|
(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)))))
|
|
|
|
(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
|