diff options
| -rw-r--r-- | sx-button.el | 10 | ||||
| -rw-r--r-- | sx-compose.el | 6 | ||||
| -rw-r--r-- | sx-inbox.el | 6 | ||||
| -rw-r--r-- | sx-question-list.el | 30 | ||||
| -rw-r--r-- | sx-question-mode.el | 13 | ||||
| -rw-r--r-- | sx-question-print.el | 103 | ||||
| -rw-r--r-- | sx-request.el | 23 | ||||
| -rw-r--r-- | sx.el | 13 | ||||
| -rw-r--r-- | test/test-api.el | 23 |
9 files changed, 162 insertions, 65 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 6bae225..def490b 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -303,7 +303,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) @@ -315,8 +316,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 @@ -395,14 +394,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) " [" @@ -413,7 +412,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.") @@ -424,15 +423,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 6125416..846ad7f 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -214,6 +214,7 @@ Letters do not insert themselves; instead, they are commands. ("v" sx-visit-externally) ("u" sx-upvote) ("d" sx-downvote) + ("O" sx-question-mode-order-by) ("q" quit-window) (" " scroll-up-command) ("a" sx-answer) @@ -256,6 +257,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 62253a7..88100bd 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -158,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) @@ -334,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://...") @@ -343,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") "://") "" @@ -387,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) @@ -408,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. 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) @@ -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))))) @@ -335,6 +340,12 @@ GET-FUNC and performs the actual comparison." "Return STRING with consecutive whitespace squashed together." (replace-regexp-in-string "[ \r\n]+" " " string)) +(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))))) |