aboutsummaryrefslogtreecommitdiff
path: root/sx-question-print.el
diff options
context:
space:
mode:
authorArtur Malabarba <bruce.connor.am@gmail.com>2015-02-26 22:19:05 -0300
committerArtur Malabarba <bruce.connor.am@gmail.com>2015-02-26 22:19:05 -0300
commit7df79a35edcb79e7caca4a0d50fcec54d5f68fef (patch)
treecc2bcb61f4350dce6a5b5ecba12218f25645275f /sx-question-print.el
parent83538b215f75256b86987b999504a2d87d0db307 (diff)
parentf4ba0e2a11581477e412c276080a049d19351361 (diff)
Merge branch 'master' into question-mode-line
Diffstat (limited to 'sx-question-print.el')
-rw-r--r--sx-question-print.el146
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.