diff options
| -rw-r--r-- | sx-compose.el | 13 | ||||
| -rw-r--r-- | sx-interaction.el | 64 | ||||
| -rw-r--r-- | sx-question-mode.el | 20 | ||||
| -rw-r--r-- | sx-question.el | 20 | ||||
| -rw-r--r-- | sx.el | 150 | ||||
| -rw-r--r-- | test/test-util.el | 26 |
6 files changed, 210 insertions, 83 deletions
diff --git a/sx-compose.el b/sx-compose.el index 3047a97..eb5e2eb 100644 --- a/sx-compose.el +++ b/sx-compose.el @@ -140,10 +140,15 @@ contents to the API, then calls `sx-compose-after-send-functions'." (interactive) (when (run-hook-with-args-until-failure 'sx-compose-before-send-hook) - (let ((result (funcall sx-compose--send-function))) - (with-demoted-errors - (run-hook-with-args 'sx-compose-after-send-functions - (current-buffer) result))))) + (let ((result (funcall sx-compose--send-function)) + (buf (current-buffer))) + (run-hook-wrapped + 'sx-compose-after-send-functions + (lambda (func) + (with-demoted-errors + "[sx] Error encountered AFTER sending post, but the post was sent successfully: %s" + (funcall func buf result)) + nil))))) (defun sx-compose-insert-tags () "Prompt for a tag list for this draft and insert them." diff --git a/sx-interaction.el b/sx-interaction.el index 97c68b6..3d60cbe 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -136,15 +136,28 @@ Element can be a question, answer, or comment." (save-excursion (yank)) (thing-at-point 'url)))) (list (read-string (concat "Link (" def "): ") nil nil def)))) - (let ((data (sx--link-to-data link))) - (sx-assoc-let data - (cl-case .type - (answer - (sx-display-question - (sx-question-get-from-answer .site_par .id) 'focus)) - (question - (sx-display-question - (sx-question-get-question .site_par .id) 'focus)))))) + ;; For now, we have no chance of handling chat links, let's just + ;; send them to the browser. + (if (string-match (rx string-start "http" (opt "s") "://chat.") link) + (sx-visit-externally link) + (let ((data (sx--link-to-data link))) + (sx-assoc-let data + (cl-case .type + (comment + (sx-display-question + (sx-question-get-from-comment .site_par .id) 'focus) + (sx--find-in-buffer 'comment .id)) + (answer + (sx-display-question + (sx-question-get-from-answer .site_par .id) 'focus) + (sx--find-in-buffer 'answer .id)) + (question + (sx-display-question + (sx-question-get-question .site_par .id) 'focus)) + (t (sx-message + "Don't know how to open this link, please file a bug report: %s" + link) + nil)))))) ;;; Displaying @@ -159,14 +172,35 @@ likes." (interactive (list (sx--data-here))) (sx-assoc-let data (cond - (.notification_type - (sx-message "Viewing notifications is not yet implemented")) - (.item_type (sx-open-link .link)) + ;; This is an attempt to identify when we have the question + ;; object itself, so there's no need to fetch anything. This + ;; happens inside the question-list, but it can be easily + ;; confused with the inbox (whose items have a title, a body, and + ;; a question_id). + ((and .title .question_id .score + (not .item_type) (not .notification_type)) + (sx-display-question data 'focus)) (.answer_id (sx-display-question - (sx-question-get-from-answer .site_par .id) 'focus)) - (.title - (sx-display-question data 'focus))))) + (sx-question-get-from-answer .site_par .answer_id) + 'focus) + (if .comment_id + (sx--find-in-buffer 'comment .comment_id) + (sx--find-in-buffer 'answer .answer_id))) + (.question_id + (sx-display-question + (sx-question-get-question .site_par .question_id) 'focus) + (when .comment_id + (sx--find-in-buffer 'comment .comment_id))) + ;; `sx-question-get-from-comment' takes 2 api requests, so we + ;; test it last. + (.comment_id + (sx-display-question + (sx-question-get-from-comment .site_par .comment_id) 'focus) + (sx--find-in-buffer 'comment .comment_id)) + (.notification_type + (sx-message "Viewing notifications is not yet implemented")) + (.item_type (sx-open-link .link))))) (defun sx-display-question (&optional data focus window) "Display question given by DATA, on WINDOW. diff --git a/sx-question-mode.el b/sx-question-mode.el index 5303ebb..6125416 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -121,10 +121,10 @@ Prefix argument N moves N sections down or up." (while (> count 0) ;; This will either move us to the next section, or move out of ;; the current one. - (unless (sx-question-mode--goto-property-change 'section n) + (unless (sx--goto-property-change 'sx-question-mode--section n) ;; If all we did was move out the current one, then move again ;; and we're guaranteed to reach the next section. - (sx-question-mode--goto-property-change 'section n)) + (sx--goto-property-change 'sx-question-mode--section n)) (unless (get-char-property (point) 'invisible) (cl-decf count)))) (when (equal (selected-window) (get-buffer-window)) @@ -140,22 +140,6 @@ Prefix argument moves N sections up or down." (interactive "p") (sx-question-mode-next-section (- (or n 1)))) -(defun sx-question-mode--goto-property-change (prop &optional direction) - "Move forward to the next change of text-property sx-question-mode--PROP. -Return the new value of PROP at point. - -If DIRECTION is negative, move backwards instead." - (let ((prop (intern (format "sx-question-mode--%s" prop))) - (func (if (and (numberp direction) - (< direction 0)) - #'previous-single-property-change - #'next-single-property-change)) - (limit (if (and (numberp direction) - (< direction 0)) - (point-min) (point-max)))) - (goto-char (funcall func (point) prop nil limit)) - (get-text-property (point) prop))) - (defun sx-question-mode-hide-show-section (&optional _) "Hide or show section under point. Optional argument _ is for `push-button'." diff --git a/sx-question.el b/sx-question.el index 1e3a02c..1df4900 100644 --- a/sx-question.el +++ b/sx-question.el @@ -72,6 +72,26 @@ If ANSWER-ID doesn't exist on SITE, raise an error." (error "Couldn't find answer %S in %S" answer-id site)))) +(defun sx-question-get-from-comment (site comment-id) + "Get question from SITE to which COMMENT-ID belongs. +If COMMENT-ID doesn't exist on SITE, raise an error. + +Note this requires two API requests. One for the comment and one +for the post." + (let ((res (sx-method-call 'comments + :id comment-id + :site site + :auth t + :filter sx-browse-filter))) + (unless (vectorp res) + (error "Couldn't find comment %S in %S" comment-id site)) + (sx-assoc-let (elt res 0) + (funcall (if (string= .post_type "answer") + #'sx-question-get-from-answer + #'sx-question-get-question) + .site_par + .post_id)))) + ;;; Question Properties @@ -92,46 +92,65 @@ with a `link' property)." "Convert string LINK into data that can be displayed." (let ((result (list (cons 'site_par (sx--site link))))) ;; Try to strip a question or answer ID - (when (or + (when (cond ;; Comment + ((or ;; If there's a #commentNUMBER_NUMBER at the end, we + ;; know it's a comment with that ID. + (string-match (rx "#comment" (group-n 1 (+ digit)) + "_" (+ digit) string-end) + link) + ;; From inbox items + (string-match (rx "/posts/comments/" + ;; Comment ID + (group-n 1 (+ digit)) + ;; Optional stuff at the end + (or (and (any "?#") (* any)) "") + string-end) + link)) + (push '(type . comment) result)) ;; Answer - (and (or (string-match - ;; From 'Share' button - (rx "/a/" - ;; Question ID - (group (+ digit)) - ;; User ID - "/" (+ digit) - ;; Answer ID - (group (or (sequence "#" (* any)) "")) - string-end) link) - (string-match - ;; From URL - (rx "/questions/" (+ digit) "/" - (+ (not (any "/"))) "/" - ;; User ID - (optional (group (+ digit))) - (optional "/") - (group (or (sequence "#" (* any)) "")) - string-end) link)) - (push '(type . answer) result)) + ((or ;; If there's a #NUMBER at the end, we know it's an + ;; answer with that ID. + (string-match (rx "#" (group-n 1 (+ digit)) string-end) link) + ;; From 'Share' button + (string-match (rx "/a/" + ;; Answer ID + (group-n 1 (+ digit)) "/" + ;; User ID + (+ digit) + ;; Garbage at the end + (optional (and (any "?#") (* any))) + string-end) + link) + ;; From URL + (string-match (rx "/questions/" (+ digit) "/" + ;; Question title + (+ (not (any "/"))) "/" + ;; Answer ID. If this is absent, we match on + ;; Question clause below. + (group-n 1 (+ digit)) + (opt "/") + ;; Garbage at the end + (optional (and (any "?#") (* any))) + string-end) + link)) + (push '(type . answer) result)) ;; Question - (and (or (string-match - ;; From 'Share' button - (rx "/q/" - ;; Question ID - (group (+ digit)) - ;; User ID - (optional "/" (+ digit)) - ;; Answer or Comment ID - (group (or (sequence "#" (* any)) "")) - string-end) link) - (string-match - ;; From URL - (rx "/questions/" - ;; Question ID - (group (+ digit)) - "/") link)) - (push '(type . question) result))) + ((or ;; From 'Share' button + (string-match (rx "/q/" + ;; Question ID + (group-n 1 (+ digit)) + ;; User ID + (optional "/" (+ digit)) + ;; Garbage at the end + (optional (and (any "?#") (* any))) + string-end) + link) + ;; From URL + (string-match (rx "/questions/" + ;; Question ID + (group-n 1 (+ digit)) "/") + link)) + (push '(type . question) result))) (push (cons 'id (string-to-number (match-string-no-properties 1 link))) result)) result)) @@ -259,19 +278,58 @@ whenever BODY evaluates to nil." :filter (lambda (&optional _) (when (progn ,@body) ,def))))) +(defun sx--goto-property-change (prop &optional direction) + "Move forward to the next change of text-property PROP. +Return the new value of PROP at point. + +If DIRECTION is negative, move backwards instead." + (let ((func (if (and (numberp direction) + (< direction 0)) + #'previous-single-property-change + #'next-single-property-change)) + (limit (if (and (numberp direction) + (< direction 0)) + (point-min) (point-max)))) + (goto-char (funcall func (point) prop nil limit)) + (get-text-property (point) prop))) + +(defun sx--find-in-buffer (type id) + "Move point to an object of TYPE and ID. +That is, move forward from beginning of buffer until +`sx--data-here' is an object of type TYPE with the respective id +ID. If point is left at the of a line, move over the line break. + +TYPE is either question, answer, or comment. +ID is an integer." + (let* ((id-symbol (cl-case type + (answer 'answer_id) + (comment 'comment_id) + (question 'question_id))) + (pos + (save-excursion + (goto-char (point-min)) + (while (not (or (eobp) + (let ((data (sx--data-here type t))) + (and data + (= id (or (cdr (assq id-symbol data)))))))) + (forward-char 1)) + (point)))) + (if (equal pos (point-max)) + (sx-message "Can't find the specified %s" type) + (goto-char pos) + (when (looking-at-p "$") + (forward-char 1))))) + (defmacro sx--create-comparator (name doc compare-func get-func) "Define a new comparator called NAME with documentation DOC. COMPARE-FUNC is a function that takes the return value of GET-FUNC and performs the actual comparison." (declare (indent 1) (doc-string 2)) - `(progn - ;; In using `defalias', the macro supports both function - ;; symbols and lambda expressions. - (defun ,name (a b) - ,doc - (funcall ,compare-func - (funcall ,get-func a) - (funcall ,get-func b))))) + `(defun ,name (a b) + ,doc + (funcall ,compare-func + (funcall ,get-func a) + (funcall ,get-func b)))) ;;; Printing request data diff --git a/test/test-util.el b/test/test-util.el index 1e3dc2b..b466c08 100644 --- a/test/test-util.el +++ b/test/test-util.el @@ -43,3 +43,29 @@ (lambda (path) (intern (mapconcat #'symbol-name path "/"))) '(a b (c d (e f g) h i (j k) l) m (n o) p)) '(a b c/d c/e/f c/e/g c/h c/i c/j/k c/l m n/o p)))) + +(ert-deftest link-to-data () + (should + (equal + (sx--link-to-data "http://meta.emacs.stackexchange.com/posts/comments/510?noredirect=1") + '((id . 510) (type . comment) (site_par . "meta.emacs")))) + (should + (equal + (sx--link-to-data "http://emacs.stackexchange.com/questions/7409/is-there-a-generic-toggle-previous-window-function#comment10965_7409") + '((id . 10965) (type . comment) (site_par . "emacs")))) + (should + (equal + (sx--link-to-data "http://emacs.stackexchange.com/q/7409/50") + '((id . 7409) (type . question) (site_par . "emacs")))) + (should + (equal + (sx--link-to-data "http://emacs.stackexchange.com/a/7410/50") + '((id . 7410) (type . answer) (site_par . "emacs")))) + (should + (equal + (sx--link-to-data "http://emacs.stackexchange.com/questions/7409/is-there-a-generic-toggle-previous-window-function/9999#7410") + '((id . 7410) (type . answer) (site_par . "emacs")))) + (should + (equal + (sx--link-to-data "http://emacs.stackexchange.com/questions/7409/is-there-a-generic-toggle-previous-window-function/7410") + '((id . 7410) (type . answer) (site_par . "emacs"))))) |