;;; weechat-image --- Image preview ;; -*- lexical-binding: t -*- ;; Copyright (C) 2013 RĂ¼diger Sonderfeld ;; Author: RĂ¼diger Sonderfeld ;; Moritz Ulrich ;; Aristid Breitkreuz ;; Keywords: irc chat network weechat ;; URL: https://github.com/the-kenny/weechat.el ;; 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 . ;;; Commentary: ;; ;; TODO: resize, make buffer more beautiful, test test test ;;; Code: ;; (require 'weechat) ;;; Customize: ;; (defgroup weechat-image nil "Image previews for WeeChat." :link '(url-link "https://github.com/the-kenny/weechat.el") :prefix "weechat-image" :group 'weechat) (defcustom weechat-image-url-regex "\\.\\(png\\|jpe?g\\|gif\\|svg\\)" "Regexp to match image URLs. This gets called on a URL matched with `thing-at-point' and `url'." :type 'regexp :group 'weechat-image) (defcustom weechat-image-url-blacklist-regex "/\\(Datei\\|File\\):" "Blacklist for image URLs. E.g., for Wikipedia links starting with File:. They do not link directly to the image." :type 'regexp :group 'weechat-image) (defcustom weechat-image-display-func #'weechat-image-insert-inline "Function to call to insert image. The Function should accept the following parameter (URL IMAGE BUFFER MARKER)." :type '(choice (const :tag "Inline" weechat-image-insert-inline) (const :tag "Other Buffer" weechat-image-insert-other-buffer) (function :tag "Call function")) :group 'weechat-image) (defcustom weechat-image-buffer "*WeeChat Image Buffer*" "Buffer used if `weechat-image-display-func' is set to ``Other Buffer''." :type 'string :group 'weechat-image) (defcustom weechat-image-use-imagemagick (fboundp 'imagemagick-types) ;; TODO is there a better way to identify if emacs has imagemagick support? "Use ImageMagick to load images." :type 'boolean :group 'weechat-image) (defcustom weechat-image-size-limit (* 1024 1024) ;; 1M "Size limit for images." :type '(choice (const :tag "No limit" nil) (integer :tag "Size limit in bytes")) :group 'weechat-image) (defcustom weechat-image-max-width (/ (frame-pixel-width nil) 2) "Max image width. If `weechate-image-size' is non-nil the image is resized. Be aware that `weechat-image-size-limit' is checked before." :type '(choice (const :tag "No limit" nil) (integer :tag "Max width in pixel")) :group 'weechat-image) (defcustom weechat-image-max-height nil "Max image height. If `weechate-image-size' is non-nil the image is resized. Be aware that `weechat-image-size-limit' is checked before." :type '(choice (const :tag "No limit" nil) (integer :tag "Max height in pixel")) :group 'weechat-image) (defcustom weechat-image-resize weechat-image-use-imagemagick "Resize image if it's larger than `weechat-image-max-width' and `weechat-image-max-height'. This only works if imagemagick is used. See `weechat-image-use-imagemagick'." :type 'boolean :group 'weechat-image) (defcustom weechat-image-time-format "%Y-%m-%dT%T%z" ;; ISO 8601 "Timestamp format used in `weechat-image-buffer'. See `format-time-string'." :type 'string :group 'weechat-image) (defun weechat-image--remove (button) "Remove image associated with BUTTON." (let ((start (button-get button 'weechat-image-begin)) (end (button-get button 'weechat-image-end))) (remove-images start end) (delete-region (1- (overlay-start button)) (overlay-end button)) (delete-overlay button) (save-excursion (save-restriction (narrow-to-region (line-beginning-position) (line-end-position)) (let ((inhibit-read-only t)) (weechat-image--add-preview-button)))))) (defun weechat-image-insert-inline (url image buffer marker) "Insert IMAGE after MARKER in buffer." (with-current-buffer buffer (goto-char marker) (let ((button (button-at marker))) (delete-region (overlay-start button) (overlay-end button)) (delete-overlay button)) (let ((button-start (point)) button-end image-start) (insert "[-]") (setq button-end (point)) (end-of-line) (setq image-start (point)) (put-image image image-start) (make-button button-start button-end 'action #'weechat-image--remove 'help-wecho "Remove Preview" 'follow-link t 'weechat-image-begin image-start 'weechat-image-end (point)))) (message "Inserted inline %s %s %s" url buffer marker)) (defun weechat-image-view-next () "Go to next image." (interactive) (search-forward "URL:" nil t)) (defun weechat-image-view-previous () "Go to previous image." (interactive) (search-backward "URL:" nil t)) (defun weechat-image-view-remove-entry () "Remove current entry." (interactive) (save-excursion (let ((beg (if (looking-at "^URL:") (point) (search-backward "URL:" nil t))) (end (progn (end-of-line) (search-forward "URL:" nil t)))) (if end (setq end (- end 4)) (setq end (point-max))) (let ((inhibit-read-only t)) (remove-images beg end) (delete-region beg end))))) (defun weechat-image-view-clear () "Clear image view buffer." (interactive) (when (and (called-interactively-p 'interactive) (y-or-n-p "Clear buffer? ")) (let ((inhibit-read-only t)) (remove-images (point-min) (point-max)) (erase-buffer)))) (defvar weechat-image-view-mode-map (let ((map (make-sparse-keymap))) (define-key map "p" #'weechat-image-view-previous) (define-key map "n" #'weechat-image-view-next) (define-key map "c" #'weechat-image-view-clear) (define-key map "k" #'weechat-image-view-remove-entry) map) "Keymap for `weechat-image-view-mode'.") (easy-menu-define weechat-image-view-mode-menu weechat-image-view-mode-map "WeeChat Image" '("WeeChatImage" ["Previous Image" weechat-image-view-previous t] ["Next Image" weechat-image-view-next t] ["Remove Image" weechat-image-view-remove-entry t] ["Clear Buffer" weechat-image-view-clear t])) (define-derived-mode weechat-image-view-mode special-mode "WeechatImage" "Mode for the weechat-image viewer \{weechat-image-view-mode-map}" :group 'weechat-image) (defun weechat-image-insert-other-buffer (url image buffer marker) "Insert IMAGE into `weechat-image-buffer'." (with-current-buffer (get-buffer-create weechat-image-buffer) (weechat-image-view-mode) (goto-char (point-max)) (let ((inhibit-read-only t)) (unless (bolp) (insert "\n")) (insert "URL: ") (insert-button url 'action (lambda (button) (browse-url (button-get button 'weechat-image-url))) 'help-echo "Browse URL" 'follow-link t 'weechat-image-url url) (insert "\n") (let ((channel-name (buffer-name buffer))) (insert "Channel: ") (insert-button channel-name 'action (lambda (button) (let ((buf (button-get button 'weechat-image-buffer)) (mark (button-get button 'weechat-image-marker))) (when (buffer-live-p buf) (switch-to-buffer buf) (with-current-buffer buf (goto-char mark))))) 'help-echo "Goto buffer" 'follow-link t 'weechat-image-buffer buffer 'weechat-image-marker marker) (insert "\n")) (let (nick date) (with-current-buffer buffer (goto-char marker) (beginning-of-line) (setq nick (get-text-property (point) 'weechat-nick)) (setq date (get-text-property (point) 'weechat-date))) (when date (insert "Date: " (format-time-string weechat-image-time-format date) "\n")) (when nick (insert "By: ") (insert-button nick 'action (lambda (button) (let ((buf (button-get button 'weechat-image-buffer)) (nick (button-get button 'weechat-image-nick))) (with-current-buffer buf (weechat-nick-action nick)))) 'help-echo "Nick Actions" 'follow-link t 'weechat-image-buffer buffer 'weechat-image-nick nick) (insert "\n"))) (put-image image (point)) (insert "\n"))) (message "Added new image to %s" weechat-image-buffer) (switch-to-buffer weechat-image-buffer)) (defun weechat-image-resize (image what px) "Resize IMAGE. WHAT should be either `:width' or `:height' and PX is the new size in pixel. This function is a no-op if `weechat-image-use-imagemagick' is nil." (if weechat-image-use-imagemagick (or (create-image (plist-get (cdr image) :data) 'imagemagick t what px) image) image)) (defun weechat-image--get-image (_status url buffer marker) (goto-char (point-min)) (unless (looking-at "^HTTP/.+ 200 OK$") (kill-buffer) (error "Error while fetching image `%s'" url)) (unless (search-forward "\n\n" nil t) (kill-buffer) (error "Error while fetching image `%s'. Malformed http reply" url)) (when (and weechat-image-size-limit (> (- (point-max) (point)) weechat-image-size-limit)) (kill-buffer) (error "Image %s is too large (%s bytes)" url (- (point-max) (point)))) (let* ((image (create-image (buffer-substring (point) (point-max)) (if weechat-image-use-imagemagick 'imagemagick nil) t)) (size (image-size image 'pixels))) (unless image (kill-buffer) (error "Image type not supported or not an image.")) (when (and weechat-image-max-width (> (car size) weechat-image-max-width)) (if weechat-image-resize (setq image (weechat-image-resize image :width weechat-image-max-width)) (kill-buffer) (error "Image %s is too wide (%s px)" url (car size)))) (when (and weechat-image-max-height (> (cdr size) weechat-image-max-height)) (if weechat-image-resize (setq image (weechat-image-resize image :height weechat-image-max-width)) (kill-buffer) (error "Image %s is too heigh (%s px)" url (cdr size)))) (kill-buffer) (funcall weechat-image-display-func url image buffer marker))) (defun weechat-image--do-preview (button) (let ((url (button-get button 'weechat-image-url)) (buffer (button-get button 'weechat-image-buffer)) (marker (button-get button 'weechat-image-marker))) (url-queue-retrieve url #'weechat-image--get-image (list url buffer marker)))) (defun weechat-image--add-preview-button () "Add preview buttons after image urls." (goto-char (point-min)) (search-forward "http" nil t) (let ((url (thing-at-point 'url))) (when (and url (s-matches? weechat-image-url-regex url) (not (s-matches? weechat-image-url-blacklist-regex url))) (end-of-thing 'url) (insert " ") (insert-button "[+]" 'action #'weechat-image--do-preview 'help-echo "Preview Image" 'follow-link t 'weechat-image-marker (point) 'weechat-image-buffer (current-buffer) 'weechat-image-url url) (unless (or (eolp) (looking-at "[[:space:]]")) (insert " "))))) (add-hook 'weechat-insert-modify-hook #'weechat-image--add-preview-button) (provide 'weechat-image) ;;; weechat-image.el ends here