diff options
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-display-images.el')
| -rw-r--r-- | configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-display-images.el | 197 |
1 files changed, 197 insertions, 0 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-display-images.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-display-images.el new file mode 100644 index 000000000000..6c9e29a251e8 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-display-images.el @@ -0,0 +1,197 @@ +;;; 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 |