;;; rcirc-image.el --- Display images in IRC buffers inline  -*- lexical-binding: t; -*-

;; Copyright (C) 2023, 2024  Philip Kaludercic

;; Author: Philip Kaludercic <philipk@posteo.net>
;; Keywords: comm, irc

;; 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 <https://www.gnu.org/licenses/>.

;;; Commentary:

;; This will display links to images inline in IRC buffers.  To
;; enabled, evaluate the following:
;;
;; (add-to-list 'rcirc-markup-text-functions #'rcirc-image-markup t)

;;; Code:

(defgroup rcirc-image '()
  "Display images in IRC buffers inline."
  :prefix "rcirc-image-"
  :group 'rcirc)

(defcustom rcirc-image-permitted-regexp
  (rx "https://"
      (or (: "cdn.discordapp.com/attachments/" (+ (or alnum "/")))
	  (: "matrix-irc.snt.utwente.nl/_matrix/media/v3/download/"
	     (+ (or alnum "/" "?" "=")))
	  (: "i.imgur.com/" (+ alnum))
	  (: "paste.rs/" (+ alnum))
	  (: "files.catbox.moe/" (+ alnum)))
      "." (or "png" "jpg" "jpeg" "gif" "webp" "svg")
      (* "?" (* (+ (or alnum "%")) (? "=" (or alnum "%") (? "&")))))
  "List of regular expressions of permitted image hosts."
  :type 'regexp)

(defcustom rcirc-image-properties '(:max-width 600)
  "Property list of image descriptors to use.
See the info node `(elisp) Image Descriptors' for further details."
  :type 'plist)

(defun rcirc-image-url-handler (status buf start end)
  "Callback for `rcirc-image-markup' to insert an image.
STATUS is defined by `url-retrieve', START and END are the range
of the URL that the image is to replace in the buffer BUF."
  (unless (assq :error status)
    (goto-char (point-min))
    (forward-paragraph)
    (let ((image (apply #'create-image
			(buffer-substring (1+ (point)) (point-max))
			nil t rcirc-image-properties)))
      (with-current-buffer buf
	(add-text-properties
	 start end
	 (list 'display image
	       'face 'default
	       'rear-nonsticky t
	       'inhibit-isearch t
               'keymap image-map)))))
  (kill-buffer))

;;;###autoload
(defun rcirc-image-markup (&rest _ignored)
  "Display an image inline instead of a URL.
This function can be added to `rcirc-markup-text-functions'."
  (goto-char (point-max))
  (while (search-backward-regexp rcirc-image-permitted-regexp nil t)
    (url-retrieve
     (match-string-no-properties 0)
     #'rcirc-image-url-handler
     (list (current-buffer) (match-beginning 0) (match-end 0)))))

(defun rcirc-image-display ()
  "Display all images in the current message."
  (interactive)
  (save-excursion
    (when-let ((match (text-property-search-forward 'rcirc-text)))
      (with-restriction
	(prop-match-beginning match)
	(prop-match-end match)
	(goto-char (point-max))
	(rcirc-image-markup)))))

(provide 'rcirc-image)
;;; rcirc-image.el ends here