diff options
Diffstat (limited to 'sx-question-print.el')
| -rw-r--r-- | sx-question-print.el | 146 |
1 files changed, 114 insertions, 32 deletions
diff --git a/sx-question-print.el b/sx-question-print.el index abf3236..88100bd 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -63,7 +63,7 @@ Some faces of this mode might be defined in the `sx-user' group." :type 'string :group 'sx-question-mode) -(defcustom sx-question-mode-header-author-format "\nAuthor: %d %r" +(defcustom sx-question-mode-header-author-format "\nAuthor: %d %r" "String used to display the question author at the header. % constructs have special meaning here. See `sx-user--format'." :type 'string @@ -74,7 +74,7 @@ Some faces of this mode might be defined in the `sx-user' group." "Face used on the question date in the question buffer." :group 'sx-question-mode-faces) -(defcustom sx-question-mode-header-date "\nAsked on: " +(defcustom sx-question-mode-header-date "\nPosted on: " "String used before the question date at the header." :type 'string :group 'sx-question-mode) @@ -95,12 +95,12 @@ Some faces of this mode might be defined in the `sx-user' group." "Face used for downvoted score in the question buffer." :group 'sx-question-mode-faces) -(defcustom sx-question-mode-header-tags "\nTags: " +(defcustom sx-question-mode-header-tags "\nTags: " "String used before the question tags at the header." :type 'string :group 'sx-question-mode) -(defcustom sx-question-mode-header-score "\nScore: " +(defcustom sx-question-mode-header-score "\nScore: " "String used before the question score at the header." :type 'string :group 'sx-question-mode) @@ -131,6 +131,16 @@ the editor's name." :type 'string :group 'sx-question-mode) +(defface sx-question-mode-accepted + '((t :foreground "ForestGreen" :inherit sx-question-mode-title)) + "Face used for accepted answers in the question buffer." + :group 'sx-question-mode-faces) + +(defcustom sx-question-mode-answer-accepted-title "Accepted Answer" + "Title used at the start of accepted \"Answer\" section." + :type 'string + :group 'sx-question-mode) + (defcustom sx-question-mode-comments-title " Comments" "Title used at the start of \"Comments\" sections." :type 'string @@ -148,13 +158,39 @@ replaced with the comment." :type 'boolean :group 'sx-question-mode) +(defconst sx-question-mode--sort-methods + (let ((methods + '(("Higher-scoring" . sx-answer-higher-score-p) + ("Newer" . sx-answer-newer-p) + ("More active" . sx-answer-more-active-p)))) + (append (mapcar (lambda (x) (cons (concat (car x) " first") (cdr x))) + methods) + (mapcar (lambda (x) (cons (concat (car x) " last") + (sx--invert-predicate (cdr x)))) + methods)))) + (defcustom sx-question-mode-answer-sort-function #'sx-answer-higher-score-p "Function used to sort answers in the question buffer." - :type '(choice - (const :tag "Higher-scoring first" sx-answer-higher-score-p) - (const :tag "Newer first" sx-answer-newer-p) - (const :tag "More active first" sx-answer-more-active-p)) + :type + (cons 'choice + (mapcar (lambda (x) `(const :tag ,(car x) ,(cdr x))) + 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) @@ -188,22 +224,29 @@ DATA can represent a question or an answer." (insert sx-question-mode-header-title) (insert-text-button ;; Questions have title, Answers don't - (or .title sx-question-mode-answer-title) + (cond (.title) + ((eq .is_accepted t) sx-question-mode-answer-accepted-title) + (t sx-question-mode-answer-title)) ;; Section level 'sx-question-mode--section (if .title 1 2) 'sx-button-copy .share_link + 'face (if (eq .is_accepted t) 'sx-question-mode-accepted + 'sx-question-mode-title) :type 'sx-question-mode-title) + ;; Sections can be hidden with overlays (sx--wrap-in-overlay '(sx-question-mode--section-content t) + ;; Author (insert (sx-user--format (propertize sx-question-mode-header-author-format 'face 'sx-question-mode-header) .owner)) + + ;; Date (sx-question-mode--insert-header - ;; Date sx-question-mode-header-date (concat (sx-time-seconds-to-date .creation_date) @@ -212,13 +255,17 @@ DATA can represent a question or an answer." (sx-time-since .last_edit_date) (sx-user--format "%d" .last_editor)))) 'sx-question-mode-date) + + ;; Score and upvoted/downvoted status. (sx-question-mode--insert-header sx-question-mode-header-score - (format "%s" .score) - (cond - ((eq .upvoted t) 'sx-question-mode-score-upvoted) - ((eq .downvoted t) 'sx-question-mode-score-downvoted) - (t 'sx-question-mode-score))) + (format "%s%s" .score + (cond ((eq .upvoted t) "↑") ((eq .downvoted t) "↓") (t ""))) + (cond ((eq .upvoted t) 'sx-question-mode-score-upvoted) + ((eq .downvoted t) 'sx-question-mode-score-downvoted) + (t 'sx-question-mode-score))) + + ;; Tags (when .title ;; Tags (sx-question-mode--insert-header @@ -313,7 +360,7 @@ 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://...") @@ -322,7 +369,7 @@ E.g.: ;; Done at compile time. (rx (or (and "[" (optional (group-n 6 "meta-")) "tag:" (group-n 5 (+ (not (any " ]")))) "]") - (and "[" (group-n 1 (1+ (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") "://") "" @@ -366,7 +413,9 @@ 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) @@ -387,23 +436,56 @@ E.g.: (when (stringp url) (replace-match "") (sx-question-mode--insert-link - (or (if sx-question-mode-pretty-links text full-text) url) + (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--insert-link (text url) - "Return a link propertized version of string TEXT. +(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. |