diff options
| -rw-r--r-- | sx-interaction.el | 43 | ||||
| -rw-r--r-- | sx-method.el | 28 | ||||
| -rw-r--r-- | sx-question-mode.el | 5 | ||||
| -rw-r--r-- | sx-question-print.el | 55 | ||||
| -rw-r--r-- | sx.el | 4 |
5 files changed, 89 insertions, 46 deletions
diff --git a/sx-interaction.el b/sx-interaction.el index 3d60cbe..368da09 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -230,14 +230,7 @@ Interactively, it is guessed from context at point. With the UNDO prefix argument, unfavorite the question instead." (interactive (list (sx--error-if-unread (sx--data-here 'question)) current-prefix-arg)) - (sx-assoc-let data - (sx-method-call 'questions - :id .question_id - :submethod (if undo 'favorite/undo 'favorite) - :auth 'warn - :site .site_par - :url-method 'post - :filter sx-browse-filter))) + (sx-method-post-from-data data (if undo 'favorite/undo 'favorite))) (defalias 'sx-star #'sx-favorite) @@ -268,18 +261,8 @@ DATA can be a question, answer, or comment. TYPE can be Besides posting to the api, DATA is also altered to reflect the changes." (let ((result - (sx-assoc-let data - (sx-method-call - (cond - (.comment_id "comments") - (.answer_id "answers") - (.question_id "questions")) - :id (or .comment_id .answer_id .question_id) - :submethod (concat type (unless status "/undo")) - :auth 'warn - :url-method 'post - :filter sx-browse-filter - :site .site_par)))) + (sx-method-post-from-data + data (concat type (unless status "/undo"))))) ;; The api returns the new DATA. (when (> (length result) 0) (sx--copy-data (elt result 0) data) @@ -287,6 +270,26 @@ changes." (sx--maybe-update-display)))) +;;; Delete +(defun sx-delete (data &optional undo) + "Delete an object given by DATA. +DATA can be a question, answer, or comment. Interactively, it is +guessed from context at point. +With UNDO prefix argument, undelete instead." + (interactive (list (sx--error-if-unread (sx--data-here)) + current-prefix-arg)) + (when (y-or-n-p (format "DELETE this %s? " + (let-alist data + (cond (.comment_id "comment") + (.answer_id "answer") + (.question_id "question"))))) + (sx-method-post-from-data data (if undo 'delete/undo 'delete)) + ;; Indicate to ourselves this has been deleted. + (setcdr data (cons (car data) (cdr data))) + (setcar data 'deleted) + (sx--maybe-update-display))) + + ;;; Commenting (defun sx-comment (data &optional text) "Post a comment on DATA given by TEXT. diff --git a/sx-method.el b/sx-method.el index 9d61e60..f2e68b3 100644 --- a/sx-method.el +++ b/sx-method.el @@ -142,6 +142,34 @@ Return the entire response as a complex alist." url-method (or get-all process-function)))) +(defun sx-method-post-from-data (data &rest keys) + "Make a POST `sx-method-call', deriving parameters from DATA. +KEYS are [KEYWORD VALUE] pairs passed to `sx-method-call', except +the following which are decided by this function: + + METHOD :site and :id are derived from DATA, where METHOD is + either \"answers\", \"comments\", or \"questions\". + :url-method is post. + :filter is `sx-browse-filter'. + :auth is warn. + +As a special exception, if KEYS is a single argument, it is +assumed to be the :submethod argument." + (declare (indent 1)) + (sx-assoc-let data + (apply #'sx-method-call + (cond (.comment_id "comments") + (.answer_id "answers") + (.question_id "questions")) + :id (or .comment_id .answer_id .question_id) + :auth 'warn + :url-method 'post + :filter sx-browse-filter + :site .site_par + (if (= 1 (length keys)) + (cons :submethod keys) + keys)))) + (provide 'sx-method) ;;; sx-method.el ends here diff --git a/sx-question-mode.el b/sx-question-mode.el index cb19a0b..2e06de6 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -177,9 +177,10 @@ property." ("q" quit-window) ("SPC" scroll-up-command) ("e" sx-edit "edit") - ("S" sx-search "Search") - ("s" sx-switchto-map "switch-to") + ("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") diff --git a/sx-question-print.el b/sx-question-print.el index 88100bd..5799c96 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -199,6 +199,8 @@ type is not available, images won't work." (defun sx-question-mode--print-question (question) "Print a buffer describing QUESTION. QUESTION must be a data structure returned by `json-read'." + (when (sx--deleted-p question) + (sx-user-error "This is a deleted question")) (setq sx-question-mode--data question) ;; Clear the overlays (mapc #'delete-overlay sx--overlays) @@ -207,7 +209,9 @@ QUESTION must be a data structure returned by `json-read'." (sx-question-mode--print-section question) (sx-assoc-let question (mapc #'sx-question-mode--print-section - (cl-sort .answers sx-question-mode-answer-sort-function))) + (cl-remove-if + #'sx--deleted-p + (cl-sort .answers sx-question-mode-answer-sort-function)))) (insert "\n\n ") (insert-text-button "Write an Answer" :type 'sx-button-answer) ;; Go up @@ -218,9 +222,9 @@ QUESTION must be a data structure returned by `json-read'." "Print a section corresponding to DATA. DATA can represent a question or an answer." ;; This makes `data' accessible through `sx--data-here'. - (sx-assoc-let data - (sx--wrap-in-overlay - (list 'sx--data-here data) + (sx--wrap-in-overlay + (list 'sx--data-here data) + (sx-assoc-let data (insert sx-question-mode-header-title) (insert-text-button ;; Questions have title, Answers don't @@ -284,29 +288,32 @@ DATA can represent a question or an answer." "\n" (propertize sx-question-mode-separator 'face 'sx-question-mode-header))) - ;; Comments have their own `sx--data-here' property (so they can - ;; be upvoted too). - (when .comments - (insert "\n") - (insert-text-button - sx-question-mode-comments-title - 'face 'sx-question-mode-title-comments - 'sx-question-mode--section 3 - 'sx-button-copy .share_link - :type 'sx-question-mode-title) - (sx--wrap-in-overlay - '(sx-question-mode--section-content t) + ;; Clean up commments manually deleted. The `append' call is + ;; to ensure `comments' is a list and not a vector. + (let ((comments (cl-remove-if #'sx--deleted-p (append .comments nil)))) + (when comments (insert "\n") + (insert-text-button + sx-question-mode-comments-title + 'face 'sx-question-mode-title-comments + 'sx-question-mode--section 3 + 'sx-button-copy .share_link + :type 'sx-question-mode-title) (sx--wrap-in-overlay - '(face sx-question-mode-content-face) - (mapc #'sx-question-mode--print-comment .comments)) - ;; If there are comments, we want part of this margin to go - ;; inside them, so the button get's placed beside the - ;; "Comments" header when you hide them. + '(sx-question-mode--section-content t) + (insert "\n") + (sx--wrap-in-overlay + '(face sx-question-mode-content-face) + ;; Comments have their own `sx--data-here' property (so they can + ;; be upvoted too). + (mapc #'sx-question-mode--print-comment comments)) + ;; If there are comments, we want part of this margin to go + ;; inside them, so the button get's placed beside the + ;; "Comments" header when you hide them. + (insert " "))) + ;; If there are no comments, we have to add this margin here. + (unless comments (insert " "))) - ;; If there are no comments, we have to add this margin here. - (unless .comments - (insert " ")) (insert " ") ;; This is where the "add a comment" button is printed. (insert-text-button "Add a Comment" @@ -346,6 +346,10 @@ GET-FUNC and performs the actual comparison." "Return STRING with consecutive whitespace squashed together." (replace-regexp-in-string "[ \r\n]+" " " string)) +(defun sx--deleted-p (data) + "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 #'>. |