Merge branch 'generate-header-line-from-keymap' into delete-command

9 files changed, 196 insertions, 78 deletions

diff --git a/sx-button.el b/sx-button.el
index 9f6d3b3..d32314d 100644
--- a/sx-button.el
+++ b/sx-button.el
@@ -77,23 +77,23 @@ This is usually a link's URL, or the content of a code block."
                        (point) 'sx-button-copy-type)
                       content)))))
 
-(defun sx-button-edit-this (text-or-marker &optional major-mode)
-  "Open a temp buffer populated with the string TEXT-OR-MARKER using MAJOR-MODE.
+(defun sx-button-edit-this (text-or-marker &optional majormode)
+  "Open a temp buffer populated with the string TEXT-OR-MARKER using MAJORMODE.
 When given a marker (or interactively), use the 'sx-button-copy
 and the 'sx-mode text-properties under the marker. These are
 usually part of a code-block."
   (interactive (list (point-marker)))
   ;; Buttons receive markers.
   (when (markerp text-or-marker)
-    (setq major-mode (get-text-property text-or-marker 'sx-mode))
+    (setq majormode (get-text-property text-or-marker 'sx-mode))
     (unless (setq text-or-marker 
                   (get-text-property text-or-marker 'sx-button-copy))
       (sx-message "Nothing of interest here.")))
   (with-current-buffer (pop-to-buffer (generate-new-buffer
                                        "*sx temp buffer*"))
     (insert text-or-marker)
-    (when major-mode
-      (funcall major-mode))))
+    (when majormode
+      (funcall majormode))))
 
 (defun sx-button-follow-link (&optional pos)
   "Follow link at POS.  If POS is nil, use `point'."
diff --git a/sx-compose.el b/sx-compose.el
index eb5e2eb..ae13fb6 100644
--- a/sx-compose.el
+++ b/sx-compose.el
@@ -193,8 +193,7 @@ tags.  Return a list of already inserted tags."
            'noerror)
     (error "No Tags header found"))
   (save-match-data
-    (split-string (match-string 1) (rx (any space ",;"))
-                  'omit-nulls (rx space))))
+    (sx--split-string (match-string 1) (rx (any space ",;")))))
 
 (defun sx-compose--check-tags ()
   "Check if tags in current compose buffer are valid."
@@ -313,8 +312,7 @@ other keywords are read from the header "
           (unless (search-forward-regexp "^Tags : *\\([^[:space:]].*\\) *$"
                                          header-end 'noerror)
             (error "No Tags header found"))
-          (push (cons 'tags (split-string (match-string 1)
-                                          "[[:space:],;]" 'omit-nulls))
+          (push (cons 'tags (sx--split-string (match-string 1) "[[:space:],;]"))
                 keywords)
           ;; And erase the header so it doesn't get sent.
           (delete-region
diff --git a/sx-inbox.el b/sx-inbox.el
index 21589fb..3048509 100644
--- a/sx-inbox.el
+++ b/sx-inbox.el
@@ -127,11 +127,7 @@ These are identified by their links.")
   (setq tabulated-list-format
         [("Type" 30 t nil t) ("Date" 10 t :right-align t) ("Title" 0)])
   (setq mode-line-format sx-inbox--mode-line)
-  (setq header-line-format sx-inbox--header-line)
-  ;; @TODO: This will no longer be necessary once we properly
-  ;; refactor sx-question-list-mode.
-  (remove-hook 'tabulated-list-revert-hook
-    #'sx-question-list--update-mode-line t))
+  (setq header-line-format sx-inbox--header-line))
 
 
 ;;; Keybinds
diff --git a/sx-question-list.el b/sx-question-list.el
index 6786ca2..7d43ac9 100644
--- a/sx-question-list.el
+++ b/sx-question-list.el
@@ -323,7 +323,8 @@ into consideration.  The same holds for `sx-question-list--order'.
 
 \\{sx-question-list-mode-map}"
   (hl-line-mode 1)
-  (sx-question-list--update-mode-line)
+  (setq mode-line-format
+        sx-question-list--mode-line-format)
   (setq sx-question-list--pages-so-far 0)
   (setq tabulated-list-format
         [("  V" 3 t :right-align t)
@@ -335,8 +336,6 @@ into consideration.  The same holds for `sx-question-list--order'.
   (setq tabulated-list-sort-key nil)
   (add-hook 'tabulated-list-revert-hook
     #'sx-question-list-refresh nil t)
-  (add-hook 'tabulated-list-revert-hook
-    #'sx-question-list--update-mode-line nil t)
   (setq header-line-format sx-question-list--header-line))
 
 (defcustom sx-question-list-date-sort-method 'last_activity_date
@@ -391,14 +390,14 @@ Non-interactively, DATA is a question alist."
   ;; "Unanswered", etc.
   "Variable describing current tab being viewed.")
 
-(defvar sx-question-list--total-count 0
-  "Holds the total number of questions in the current buffer.")
-(make-variable-buffer-local 'sx-question-list--total-count)
-
 (defconst sx-question-list--mode-line-format
-  '("  "
-    mode-name
-    " "
+  '("   "
+    (:propertize
+     (:eval (mapconcat #'capitalize
+                       (split-string sx-question-list--site "\\.")
+                       " "))
+     face mode-line-buffer-id)
+    " " mode-name ": "
     (:propertize sx-question-list--current-tab
                  face mode-line-buffer-id)
     " ["
@@ -409,7 +408,7 @@ Non-interactively, DATA is a question alist."
     ", "
     "Total: "
     (:propertize
-     (:eval (int-to-string sx-question-list--total-count))
+     (:eval (int-to-string (length tabulated-list-entries)))
      face mode-line-buffer-id)
     "] ")
   "Mode-line construct to use in question-list buffers.")
@@ -420,15 +419,6 @@ Non-interactively, DATA is a question alist."
    (cl-count-if-not
     #'sx-question--read-p sx-question-list--dataset)))
 
-(defun sx-question-list--update-mode-line ()
-  "Fill the mode-line with useful information."
-  ;; All the data we need is right in the buffer.
-  (when (derived-mode-p 'sx-question-list-mode)
-    (setq mode-line-format
-          sx-question-list--mode-line-format)
-    (setq sx-question-list--total-count
-          (length tabulated-list-entries))))
-
 (defvar sx-question-list--site nil
   "Site being displayed in the *question-list* buffer.")
 (make-variable-buffer-local 'sx-question-list--site)
diff --git a/sx-question-mode.el b/sx-question-mode.el
index fd7f026..c91d13e 100644
--- a/sx-question-mode.el
+++ b/sx-question-mode.el
@@ -174,13 +174,14 @@ property."
     ("d" sx-downvote "downvote")
     ("q" quit-window)
     ("SPC" scroll-up-command)
-    ("c" sx-comment "comment")
-    ("a" sx-answer "answer")
     ("e" sx-edit "edit")
     ("S" sx-search)
     ("*" sx-favorite "star")
     ("K" sx-delete "Delete")
     ("s" sx-switchto-map "switch-to")
+    ("O" sx-question-mode-order-by "Order")
+    ("c" sx-comment "comment")
+    ("a" sx-answer "answer")
     ("TAB" forward-button "Navigate")
     ("<S-iso-lefttab>" backward-button)
     ("<S-tab>" backward-button)
@@ -247,6 +248,18 @@ query the api."
   (unless (derived-mode-p 'sx-question-mode)
     (error "Not in `sx-question-mode'")))
 
+(defun sx-question-mode-order-by (sort)
+  "Order answers in the current buffer by the method SORT.
+Sets `sx-question-list--order' and then calls
+`sx-question-list-refresh' with `redisplay'."
+  (interactive
+   (list (let ((order (sx-completing-read "Order answers by: "
+                       (mapcar #'car sx-question-mode--sort-methods))))
+           (cdr-safe (assoc-string order sx-question-mode--sort-methods)))))
+  (when (and sort (functionp sort))
+    (setq sx-question-mode-answer-sort-function sort)
+    (sx-question-mode-refresh 'no-update)))
+
 (provide 'sx-question-mode)
 ;;; sx-question-mode.el ends here
 
diff --git a/sx-question-print.el b/sx-question-print.el
index 39aad20..5799c96 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)
 
 
@@ -192,22 +228,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)
@@ -216,13 +259,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
@@ -320,7 +367,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://...")
@@ -329,7 +376,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") "://") ""
@@ -373,7 +420,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)
@@ -394,23 +443,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.
diff --git a/sx-request.el b/sx-request.el
index 8f672ec..d7fd058 100644
--- a/sx-request.el
+++ b/sx-request.el
@@ -221,29 +221,34 @@ Currently returns nil."
   "https://raw.githubusercontent.com/vermiculus/sx.el/data/data/%s.el"
   "Url of the \"data\" directory inside the SX `data' branch.")
 
-(defun sx-request-get-data (file)
-  "Fetch and return data stored online by SX.
-FILE is a string or symbol, the name of the file which holds the
-desired data, relative to `sx-request--data-url-format'.  For
-instance, `tags/emacs' returns the list of tags on Emacs.SE."
+(defun sx-request-get-url (url)
+  "Fetch and return data stored online at URL."
   (let* ((url-automatic-caching t)
          (url-inhibit-uncompression t)
-         (request-url (format sx-request--data-url-format file))
          (url-request-method "GET")
          (url-request-extra-headers
           '(("Content-Type" . "application/x-www-form-urlencoded")))
-         (response-buffer (url-retrieve-synchronously request-url)))
+         (response-buffer (url-retrieve-synchronously url)))
     (if (not response-buffer)
         (error "Something went wrong in `url-retrieve-synchronously'")
       (with-current-buffer response-buffer
         (progn
           (goto-char (point-min))
+          (unless (string-match "200" (thing-at-point 'line))
+            (error "Page not found."))
           (if (not (search-forward "\n\n" nil t))
               (error "Headers missing; response corrupt")
-            (when (looking-at-p "Not Found") (error "Page not found."))
-            (prog1 (read (current-buffer))
+            (prog1 (buffer-substring (point) (point-max))
               (kill-buffer (current-buffer)))))))))
 
+(defun sx-request-get-data (file)
+  "Fetch and return data stored online by SX.
+FILE is a string or symbol, the name of the file which holds the
+desired data, relative to `sx-request--data-url-format'.  For
+instance, `tags/emacs' returns the list of tags on Emacs.SE."
+  (read (sx-request-get-url
+         (format sx-request--data-url-format file))))
+
 
 ;;; Support Functions
 (defun sx-request--build-keyword-arguments (alist &optional kv-sep)
diff --git a/sx.el b/sx.el
index fd4d79e..2e8f8db 100644
--- a/sx.el
+++ b/sx.el
@@ -189,6 +189,11 @@ If ALIST doesn't have a `site' property, one is created using the
 
 
 ;;; Utility Functions
+(defun sx--split-string (string &optional separators)
+  "Split STRING into substrings bounded by matches for SEPARATORS."
+  (mapcar (lambda (s) (replace-regexp-in-string "\\` +\\| +\\'" "" s))
+    (split-string string separators 'omit-nulls)))
+
 (defun sx-completing-read (&rest args)
   "Like `completing-read', but possibly use ido.
 All ARGS are passed to `completing-read' or `ido-completing-read'."
@@ -204,7 +209,7 @@ is intentionally skipped."
      (while (and ;; We're not at the end.
              (cdr-safe tail)
              ;; We're not at the right place.
-             (,(or predicate #'<) x (cadr tail)))
+             (funcall (or ,predicate #'<) x (cadr tail)))
        (setq tail (cdr tail)))
      (setcdr tail (cons x (cdr tail)))))
 
@@ -339,6 +344,12 @@ GET-FUNC and performs the actual comparison."
   "Return non-nil if DATA represents a deleted object."
   (eq (car data) 'deleted))
 
+(defun sx--invert-predicate (predicate)
+  "Return PREDICATE function with arguments inverted.
+For instance (sx--invert-predicate #'<) is the same as #'>.
+Note this is not the same as negating PREDICATE."
+  (lambda (&rest args) (apply predicate (reverse args))))
+
 
 ;;; Printing request data
 (defvar sx--overlays nil
diff --git a/test/test-api.el b/test/test-api.el
index b7d5dbb..faf2e0a 100644
--- a/test/test-api.el
+++ b/test/test-api.el
@@ -14,3 +14,26 @@
 (ert-deftest test-method-get-all ()
   "Tests sx-method interface to `sx-request-all-items'"
   (should (< 250 (length (sx-method-call 'sites :get-all t)))))
+
+(ert-deftest request-get-url ()
+  (should (sx-request-get-url "http://google.com"))
+  (should-error (sx-request-get-url "http://github.com/Bruce-Connor/does-not-exist"))
+  (when sx-question-mode-use-images
+    (should
+     ;; If image is not recognized, this returns nil.
+     (create-image (sx-request-get-url "https://raw.githubusercontent.com/vermiculus/sx.el/master/list-and-question.png")
+                   'imagemagick t
+                   :width sx-question-mode-image-max-width)))
+  ;; In case imagemacgick is not available, let's try png so we at
+  ;; least test the function.
+  (when (image-type-available-p 'png)
+    (should
+     (create-image (sx-request-get-url "https://raw.githubusercontent.com/vermiculus/sx.el/master/list-and-question.png")
+                   'png t
+                   :width sx-question-mode-image-max-width))))
+
+(ert-deftest request-get-data ()
+  (should-error (sx-request-get-data "tags/emacs-does-not-exist"))
+  (let ((emacs-tags (sx-request-get-data 'tags/emacs)))
+    (should (> (length emacs-tags) 450))
+    (should (not (cl-remove-if #'stringp emacs-tags)))))