diff options
Diffstat (limited to 'sx-question-print.el')
| -rw-r--r-- | sx-question-print.el | 131 |
1 files changed, 94 insertions, 37 deletions
diff --git a/sx-question-print.el b/sx-question-print.el index 4f50560..c350d8c 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -79,11 +79,6 @@ Some faces of this mode might be defined in the `sx-user' group." :type 'string :group 'sx-question-mode) -(defface sx-question-mode-tags - '((t :underline nil :inherit font-lock-function-name-face)) - "Face used on the question tags in the question buffer." - :group 'sx-question-mode-faces) - (defface sx-question-mode-score '((t)) "Face used for the score in the question buffer." @@ -173,6 +168,21 @@ replaced with the comment." sx-question-mode--sort-methods)) :group 'sx-question-mode) +(defcustom sx-question-mode-use-images + (eval-when-compile + (image-type-available-p 'imagemagick)) + "Non-nil if SX should download and display images. +By default, this is `t' if the `imagemagick' image type is +available (checked with `image-type-available-p'). If this image +type is not available, images won't work." + :type 'boolean + :group 'sx-question-mode) + +(defcustom sx-question-mode-image-max-width 550 + "Maximum width, in pixels, of images in the question buffer." + :type 'integer + :group 'sx-question-mode) + ;;; Functions ;;;; Printing the general structure @@ -239,8 +249,8 @@ DATA can represent a question or an answer." ;; Tags (sx-question-mode--insert-header sx-question-mode-header-tags - (mapconcat #'sx-question--tag-format .tags " ") - 'sx-question-mode-tags)) + (sx-tag--format-tags .tags .site_par) + nil)) ;; Body (insert "\n" (propertize sx-question-mode-separator @@ -315,7 +325,10 @@ where `value' is given `face' as its face. (while args (insert (propertize (pop args) 'face 'sx-question-mode-header) - (propertize (pop args) 'face (pop args))))) + (let ((header (pop args)) + (face (pop args))) + (if face (propertize header 'face face) + header))))) ;;;; Printing and Font-locking the content (body) @@ -326,14 +339,16 @@ where `value' is given `face' as its face. (defconst sx-question-mode--reference-regexp (rx line-start (0+ blank) "[%s]:" (0+ blank) - (group-n 1 (1+ (not blank)))) + (group-n 1 (1+ (not (any blank "\n\r"))))) "Regexp used to find the url of labeled links. E.g.: [1]: https://...") (defconst sx-question-mode--link-regexp ;; Done at compile time. - (rx (or (and "[" (group-n 1 (1+ (not (any "]")))) "]" + (rx (or (and "[" (optional (group-n 6 "meta-")) "tag:" + (group-n 5 (+ (not (any " ]")))) "]") + (and (opt "!") "[" (group-n 1 (1+ (not (any "]")))) "]" (or (and "(" (group-n 2 (1+ (not (any ")")))) ")") (and "[" (group-n 3 (1+ (not (any "]")))) "]"))) (group-n 4 (and (and "http" (opt "s") "://") "" @@ -377,37 +392,79 @@ E.g.: ;;; Handling links (defun sx-question-mode--process-links-in-buffer () - "Turn all markdown links in this buffer into compact format." + "Turn all markdown links in this buffer into compact format. +Image links are downloaded and displayed, if +`sx-question-mode-use-images' is non-nil." (save-excursion (goto-char (point-min)) (while (search-forward-regexp sx-question-mode--link-regexp nil t) - (let* ((text (match-string-no-properties 1)) - (url (or (match-string-no-properties 2) - (match-string-no-properties 4) - (sx-question-mode-find-reference - (match-string-no-properties 3) - text))) - (full-text (match-string-no-properties 0))) - (when (stringp url) - (replace-match "") - (sx-question-mode--insert-link - (or (if sx-question-mode-pretty-links text full-text) url) - url)))))) - -(defun sx-question-mode--insert-link (text url) - "Return a link propertized version of string TEXT. + ;; Tags are tag-buttons. + (let ((tag (match-string-no-properties 5))) + (if (and tag (> (length tag) 0)) + (progn (replace-match "") + ;; `match-string' 6 is the "meta-" prefix. + (sx-tag--insert tag (match-string 6))) + ;; Other links are link-buttons. + (let* ((text (match-string-no-properties 1)) + (url (or (match-string-no-properties 2) + (match-string-no-properties 4) + (sx-question-mode-find-reference + (match-string-no-properties 3) + text))) + (full-text (match-string-no-properties 0))) + (when (stringp url) + (replace-match "") + (sx-question-mode--insert-link + (if (and sx-question-mode-use-images (eq ?! (elt full-text 0))) + ;; Is it an image? + (sx-question-mode--create-image url) + ;; Or a regular link + (or (if sx-question-mode-pretty-links text full-text) url)) + url)))))))) + +(defun sx-question-mode--create-image (url) + "Get and create an image from URL. +Its size is bound by `sx-question-mode-image-max-width' and +`window-body-width'." + (let* ((image + (create-image (sx-request-get-url url) 'imagemagick t)) + (image-width (car (image-size image 'pixels)))) + (append image + (list :width (min sx-question-mode-image-max-width + (window-body-width nil 'pixel) + image-width))))) + +(defun sx-question-mode--insert-link (text-or-image url) + "Return a link propertized version of TEXT-OR-IMAGE. URL is used as 'help-echo and 'url properties." - (insert-text-button - text - ;; Mouse-over - 'help-echo - (format sx-button--link-help-echo - (propertize (sx--shorten-url url) - 'face 'font-lock-function-name-face)) - ;; For visiting and stuff. - 'sx-button-url url - 'sx-button-copy url - :type 'sx-button-link)) + ;; For now, the only way to handle nested links is to remove them. + (when (eq (char-before) ?\[) + (insert "a") + (forward-char -2) + (if (looking-at sx-question-mode--link-regexp) + (replace-match "") + (forward-char 1) + (delete-char 1))) + (let ((imagep (not (stringp text-or-image)))) + ;; Images need to be at the start of a line. + (when (and imagep (not (looking-at-p "^"))) + (insert "\n")) + (apply #'insert-text-button + (if imagep " " text-or-image) + ;; Mouse-over + 'help-echo + (format sx-button--link-help-echo + (propertize (sx--shorten-url url) + 'face 'font-lock-function-name-face)) + ;; For visiting and stuff. + 'sx-button-url url + 'sx-button-copy url + :type 'sx-button-link + ;; The last argument of `apply' is a list. + (when imagep + `(face default display ,text-or-image))) + ;; Images need to be at the end of a line too. + (insert "\n"))) (defun sx-question-mode-find-reference (id &optional fallback-id) "Find url identified by reference ID in current buffer. |