From 14c8351e551c6c2ee30486948fdc857b5813ad52 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Wed, 26 Nov 2014 00:59:15 -0500 Subject: Default to post author if post editor is missing Fixes #100 --- sx-question-mode.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/sx-question-mode.el b/sx-question-mode.el index 70b8866..947c35d 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -271,7 +271,8 @@ DATA can represent a question or an answer." (when .last_edit_date (format sx-question-mode-last-edit-format (sx-time-since .last_edit_date) - (sx-question-mode--propertize-display-name .last_editor)))) + (sx-question-mode--propertize-display-name + (if .last_editor .last_editor .owner))))) 'sx-question-mode-date) (sx-question-mode--insert-header sx-question-mode-header-score -- cgit v1.2.3 From 31549b4e5a9e67180ad6a0d0b8b61e17274b54a2 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Wed, 26 Nov 2014 14:58:50 -0500 Subject: Use customizable deleted-user structure --- sx-question-mode.el | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/sx-question-mode.el b/sx-question-mode.el index 947c35d..a80704c 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -103,6 +103,13 @@ If WINDOW is given, use that to display the buffer." "Face used on the question title in the question buffer." :group 'sx-question-mode-faces) +(defcustom sx-question-mode-deleted-user + '((display_name . "(deleted user)")) + "The structure used to represent a deleted account." + :type '(alist :options (display_name)) + :risky t + :group 'sx-question-mode) + (defcustom sx-question-mode-header-title "\n" "String used before the question title at the header." :type 'string @@ -272,7 +279,7 @@ DATA can represent a question or an answer." (format sx-question-mode-last-edit-format (sx-time-since .last_edit_date) (sx-question-mode--propertize-display-name - (if .last_editor .last_editor .owner))))) + (or .last_editor sx-question-mode-deleted-user))))) 'sx-question-mode-date) (sx-question-mode--insert-header sx-question-mode-header-score -- cgit v1.2.3 From 8aa2db45afa43da88269c7efa71a6def0b778fdc Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Wed, 26 Nov 2014 18:01:44 -0500 Subject: Enforce string value for display_name --- sx-question-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sx-question-mode.el b/sx-question-mode.el index a80704c..b2856e6 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -106,7 +106,7 @@ If WINDOW is given, use that to display the buffer." (defcustom sx-question-mode-deleted-user '((display_name . "(deleted user)")) "The structure used to represent a deleted account." - :type '(alist :options (display_name)) + :type '(alist :options ((display_name string)) :risky t :group 'sx-question-mode) -- cgit v1.2.3 From d0aa34258e3492ec5ac884dccb766bdb1776b36f Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Wed, 26 Nov 2014 18:12:06 -0500 Subject: Add missing ')' Staged only part of a change -- stupid mistake. --- sx-question-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sx-question-mode.el b/sx-question-mode.el index b2856e6..8f96a01 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -106,7 +106,7 @@ If WINDOW is given, use that to display the buffer." (defcustom sx-question-mode-deleted-user '((display_name . "(deleted user)")) "The structure used to represent a deleted account." - :type '(alist :options ((display_name string)) + :type '(alist :options ((display_name string))) :risky t :group 'sx-question-mode) -- cgit v1.2.3 From 9c2df708ac4dc62c34882b7978761cf1f73e063f Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Thu, 27 Nov 2014 11:05:08 -0500 Subject: Deleted-user variable is not risky --- sx-question-mode.el | 1 - 1 file changed, 1 deletion(-) diff --git a/sx-question-mode.el b/sx-question-mode.el index 8f96a01..bc7c62c 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -107,7 +107,6 @@ If WINDOW is given, use that to display the buffer." '((display_name . "(deleted user)")) "The structure used to represent a deleted account." :type '(alist :options ((display_name string))) - :risky t :group 'sx-question-mode) (defcustom sx-question-mode-header-title "\n" -- cgit v1.2.3 From 4f18a249d23eeb08e1cd29bb1439293b3e7d6977 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 29 Nov 2014 03:18:58 +0000 Subject: Move buttons to sx-button.el Also define command to copy button's content under w. --- sx-button.el | 77 ++++++++++++++++++++++++++++++++++++++++++++++++++++ sx-question-print.el | 27 +++--------------- 2 files changed, 81 insertions(+), 23 deletions(-) create mode 100644 sx-button.el diff --git a/sx-button.el b/sx-button.el new file mode 100644 index 0000000..f009043 --- /dev/null +++ b/sx-button.el @@ -0,0 +1,77 @@ +;;; sx-button.el --- Defining buttons used throughout SX. + +;; Copyright (C) 2014 Artur Malabarba + +;; Author: Artur Malabarba + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + + +;;; Code: +(require 'button) + +(require 'sx) +(require 'sx-question) + + +;;; Command definitions +(defvar sx-button-keymap + (let ((map (copy-keymap button-map))) + (define-key map "w" #'sx-button-copy)) + "Keymap used on buttons. +This extends `button-map', which already defines RET and +mouse-1.") + +(defun sx-button-copy () + "Copy the content of thing at point. +This is usually a link's URL, or the content of a code block." + (interactive) + (let ((content + (get-text-property + (point) 'sx-button-copy-content))) + (if content + (kill-new content) + (sx-message "Nothing to copy here.")))) + +(defun sx-button-follow-link (&optional pos) + "Follow link at POS. If POS is nil, use `point'." + (interactive) + (browse-url + (or (get-text-property (or pos (point)) 'sx-button-url) + (user-error "No url under point: %s" (or pos (point)))))) + + +;;; Type definitions +(define-button-type 'sx-button + 'follow-link t + 'keymap 'sx-button-map) + +(define-button-type 'sx-question-mode-title + 'face 'sx-question-mode-title + 'action #'sx-question-mode-hide-show-section + 'help-echo 'sx-question-mode--section-help-echo + :supertype 'sx-button) + +(define-button-type 'sx-button-link + 'action #'sx-button-follow-link + :supertype 'sx-button) + +(provide 'sx-button) +;;; sx-button.el ends here + +;; Local Variables: +;; lexical-binding: t +;; End: diff --git a/sx-question-print.el b/sx-question-print.el index 0959f36..3b2f141 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -22,7 +22,7 @@ ;;; Code: (require 'markdown-mode) -(require 'button) +(require 'sx-button) (eval-when-compile (require 'rx)) @@ -163,18 +163,6 @@ replaced with the comment." :type 'boolean :group 'sx-question-mode) - -;;; Buttons -(define-button-type 'sx-question-mode-title - 'face 'sx-question-mode-title - 'action #'sx-question-mode-hide-show-section - 'help-echo 'sx-question-mode--section-help-echo - 'follow-link t) - -(define-button-type 'sx-question-mode-link - 'follow-link t - 'action #'sx-question-mode-follow-link) - ;;; Functions ;;;; Printing the general structure @@ -403,15 +391,8 @@ URL is used as 'help-echo and 'url properties." (propertize url 'face 'default) (propertize "RET" 'face 'font-lock-function-name-face)) ;; For visiting and stuff. - 'url url - :type 'sx-question-mode-link)) - -(defun sx-question-mode-follow-link (&optional pos) - "Follow link at POS. If POS is nil, use `point'." - (interactive) - (browse-url - (or (get-text-property (or pos (point)) 'url) - (user-error "No url under point: %s" (or pos (point)))))) + 'sx-button-url url + :type 'sx-button-link)) (defun sx-question-mode-find-reference (id &optional fallback-id) "Find url identified by reference ID in current buffer. @@ -421,7 +402,7 @@ If ID is nil, use FALLBACK-ID instead." (goto-char (point-min)) (when (search-forward-regexp (format sx-question-mode--reference-regexp - (or id fallback-id)) + (or id fallback-id)) nil t) (match-string-no-properties 1))))) -- cgit v1.2.3 From 771bcf75deb0596331a539a57dcf37c278e34910 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 29 Nov 2014 03:35:54 +0000 Subject: Fix button-map --- sx-button.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/sx-button.el b/sx-button.el index f009043..3f532bb 100644 --- a/sx-button.el +++ b/sx-button.el @@ -28,12 +28,12 @@ ;;; Command definitions -(defvar sx-button-keymap +;; This extends `button-map', which already defines RET and mouse-1. +(defvar sx-button-map (let ((map (copy-keymap button-map))) - (define-key map "w" #'sx-button-copy)) - "Keymap used on buttons. -This extends `button-map', which already defines RET and -mouse-1.") + (define-key map "w" #'sx-button-copy) + map) + "Keymap used on buttons.") (defun sx-button-copy () "Copy the content of thing at point. @@ -57,7 +57,7 @@ This is usually a link's URL, or the content of a code block." ;;; Type definitions (define-button-type 'sx-button 'follow-link t - 'keymap 'sx-button-map) + 'keymap sx-button-map) (define-button-type 'sx-question-mode-title 'face 'sx-question-mode-title -- cgit v1.2.3 From 9d39b0d1bcaa3186e21171f656b807fde2611b53 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 29 Nov 2014 03:36:29 +0000 Subject: Improve button-copy --- sx-button.el | 14 +++++++++----- sx-question-print.el | 25 ++++++++++++++----------- sx.el | 2 ++ 3 files changed, 25 insertions(+), 16 deletions(-) diff --git a/sx-button.el b/sx-button.el index 3f532bb..aa77086 100644 --- a/sx-button.el +++ b/sx-button.el @@ -40,11 +40,14 @@ This is usually a link's URL, or the content of a code block." (interactive) (let ((content - (get-text-property - (point) 'sx-button-copy-content))) - (if content - (kill-new content) - (sx-message "Nothing to copy here.")))) + (get-text-property (point) 'sx-button-copy))) + (if (null content) + (sx-message "Nothing to copy here.") + (kill-new content) + (sx-message "Copied %s to kill ring." + (or (get-text-property + (point) 'sx-button-copy-type) + content))))) (defun sx-button-follow-link (&optional pos) "Follow link at POS. If POS is nil, use `point'." @@ -63,6 +66,7 @@ This is usually a link's URL, or the content of a code block." 'face 'sx-question-mode-title 'action #'sx-question-mode-hide-show-section 'help-echo 'sx-question-mode--section-help-echo + 'sx-button-copy-type "Share Link" :supertype 'sx-button) (define-button-type 'sx-button-link diff --git a/sx-question-print.el b/sx-question-print.el index 3b2f141..5b6c5be 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -199,6 +199,7 @@ DATA can represent a question or an answer." (or .title sx-question-mode-answer-title) ;; Section level 'sx-question-mode--section (if .title 1 2) + 'sx-button-copy .share_link :type 'sx-question-mode-title) ;; Sections can be hidden with overlays (sx--wrap-in-overlay @@ -251,6 +252,7 @@ DATA can represent a question or an answer." 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) @@ -392,19 +394,20 @@ URL is used as 'help-echo and 'url properties." (propertize "RET" 'face 'font-lock-function-name-face)) ;; For visiting and stuff. 'sx-button-url url - :type 'sx-button-link)) + 'sx-button-copy url + :type 'sx-button-link) -(defun sx-question-mode-find-reference (id &optional fallback-id) - "Find url identified by reference ID in current buffer. + (defun sx-question-mode-find-reference (id &optional fallback-id) + "Find url identified by reference ID in current buffer. If ID is nil, use FALLBACK-ID instead." - (save-excursion - (save-match-data - (goto-char (point-min)) - (when (search-forward-regexp - (format sx-question-mode--reference-regexp - (or id fallback-id)) - nil t) - (match-string-no-properties 1))))) + (save-excursion + (save-match-data + (goto-char (point-min)) + (when (search-forward-regexp + (format sx-question-mode--reference-regexp + (or id fallback-id)) + nil t) + (match-string-no-properties 1)))))) (defun sx-question-mode--move-over-pre () "Non-nil if paragraph at point can be filled." diff --git a/sx.el b/sx.el index 0fe98c7..83278d3 100644 --- a/sx.el +++ b/sx.el @@ -63,6 +63,7 @@ question.upvoted question.downvoted question.question_id + question.share_link user.display_name comment.owner comment.body_markdown @@ -78,6 +79,7 @@ answer.answer_id answer.last_editor answer.link + answer.share_link answer.owner answer.body_markdown answer.upvoted -- cgit v1.2.3 From 9a39c5d985423e3675cfcd56cf951bb3ab283147 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 29 Nov 2014 17:41:05 +0000 Subject: Normalize and improve button help-echo's --- sx-button.el | 21 ++++++++++++++++++++- sx-question-print.el | 6 ------ 2 files changed, 20 insertions(+), 7 deletions(-) diff --git a/sx-button.el b/sx-button.el index aa77086..ed94558 100644 --- a/sx-button.el +++ b/sx-button.el @@ -56,6 +56,25 @@ This is usually a link's URL, or the content of a code block." (or (get-text-property (or pos (point)) 'sx-button-url) (user-error "No url under point: %s" (or pos (point)))))) +(defvar sx-button--help-echo + (concat "mouse-1, RET" + (propertize ": %s -- " 'face 'minibuffer-prompt) + "w" + (propertize ": copy %s" 'face 'minibuffer-prompt)) + "Base help-echo on which others can be written.") + +(defvar sx-button--question-title-help-echo + (format sx-button--help-echo + (propertize "hide content" 'face 'minibuffer-prompt) + (propertize "link" 'face 'minibuffer-prompt)) + "Help echoed in the minibuffer when point is on a section.") + +(defvar sx-button--link-help-echo + (format sx-button--help-echo + (propertize "visit %s" 'face 'minibuffer-prompt) + (propertize "URL" 'face 'minibuffer-prompt)) + "Help echoed in the minibuffer when point is on a section.") + ;;; Type definitions (define-button-type 'sx-button @@ -65,7 +84,7 @@ This is usually a link's URL, or the content of a code block." (define-button-type 'sx-question-mode-title 'face 'sx-question-mode-title 'action #'sx-question-mode-hide-show-section - 'help-echo 'sx-question-mode--section-help-echo + 'help-echo sx-button--question-title-help-echo 'sx-button-copy-type "Share Link" :supertype 'sx-button) diff --git a/sx-question-print.el b/sx-question-print.el index 5b6c5be..e8efa2d 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -166,12 +166,6 @@ replaced with the comment." ;;; Functions ;;;; Printing the general structure -(defvar sx-question-mode--section-help-echo - (format - (propertize "%s to hide/display content" 'face 'minibuffer-prompt) - (propertize "RET" 'face 'font-lock-function-name-face)) - "Help echoed in the minibuffer when point is on a section.") - (defun sx-question-mode--print-question (question) "Print a buffer describing QUESTION. QUESTION must be a data structure returned by `json-read'." -- cgit v1.2.3 From 69b90717fb304958be8aabe6c3d02199293b27b4 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 29 Nov 2014 20:02:14 +0000 Subject: New sx--shorten-url function in sx.el --- sx.el | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/sx.el b/sx.el index 83278d3..10c0baa 100644 --- a/sx.el +++ b/sx.el @@ -173,6 +173,21 @@ would yield cons-cell)))) data)))) +(defun sx--shorten-url (url) + "Shorten URL hiding anything other than the domain. +Paths after the domain are replaced with \"...\". +Anything before the (sub)domain is removed." + (replace-regexp-in-string + ;; Remove anything after domain. + (rx (group-n 1 (and (1+ (any word ".")) "/")) + (1+ anything) string-end) + (eval-when-compile + (concat "\\1" (if (char-displayable-p ?…) "…" "..."))) + ;; Remove anything before subdomain. + (replace-regexp-in-string + (rx string-start (or (and (0+ word) (optional ":") "//"))) + "" url))) + ;;; Printing request data (defvar sx--overlays nil -- cgit v1.2.3 From 8d38a7bfe808f6af9c95ca7a490a7a822ea59e73 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 29 Nov 2014 20:02:23 +0000 Subject: Better help-echo in links --- sx-question-print.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/sx-question-print.el b/sx-question-print.el index e8efa2d..b8fc633 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -383,9 +383,9 @@ URL is used as 'help-echo and 'url properties." text ;; Mouse-over 'help-echo - (format (propertize "URL: %s, %s to visit" 'face 'minibuffer-prompt) - (propertize url 'face 'default) - (propertize "RET" 'face 'font-lock-function-name-face)) + (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 -- cgit v1.2.3 From eca252dfddba3b18d4da74bee1b802c8d59e0c4a Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 29 Nov 2014 20:53:52 +0000 Subject: New "Add a Comment" button --- sx-button.el | 8 ++++++++ sx-interaction.el | 9 ++++++--- sx-question-print.el | 7 ++++++- 3 files changed, 20 insertions(+), 4 deletions(-) diff --git a/sx-button.el b/sx-button.el index ed94558..afc1cf7 100644 --- a/sx-button.el +++ b/sx-button.el @@ -25,6 +25,7 @@ (require 'sx) (require 'sx-question) +(require 'sx-interaction) ;;; Command definitions @@ -92,6 +93,13 @@ This is usually a link's URL, or the content of a code block." 'action #'sx-button-follow-link :supertype 'sx-button) +(define-button-type 'sx-button-comment + 'help-echo (concat "mouse-1, RET" + (propertize ": write a comment" + 'face 'minibuffer-prompt)) + 'action #'sx-comment + :supertype 'sx-button) + (provide 'sx-button) ;;; sx-button.el ends here diff --git a/sx-interaction.el b/sx-interaction.el index 5f3ece6..92b062b 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -117,15 +117,18 @@ changes." ;;; Commenting -(defun sx-comment (data text) +(defun sx-comment (data &optional text) "Post a comment on DATA given by TEXT. DATA can be a question, an answer, or a comment. Interactively, it is guessed from context at point. If DATA is a comment, the comment is posted as a reply to it. TEXT is a string. Interactively, it is read from the minibufer." - (interactive - (list (sx--data-here) 'query)) + (interactive (list (sx--data-here) 'query)) + ;; When clicking the "Add a Comment" button, first arg is a marker. + (when (markerp data) + (setq data (sx--data-here)) + (setq text 'query)) (sx-assoc-let data ;; Get the comment text (when (eq text 'query) diff --git a/sx-question-print.el b/sx-question-print.el index b8fc633..22f857c 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -237,7 +237,12 @@ DATA can represent a question or an answer." .body_markdown) "\n" (propertize sx-question-mode-separator - 'face 'sx-question-mode-header))))) + 'face 'sx-question-mode-header)))) + ;; This is where the "add a comment" button is printed. + (insert " ") + (insert-text-button "Add a Comment" + :type 'sx-button-comment) + (insert "\n")) ;; Comments have their own `sx--data-here' property (so they can ;; be upvoted too). (when .comments -- cgit v1.2.3 From a77d38b11ec1a2e886fb739f7df3e7bbca1a34c7 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 29 Nov 2014 21:00:26 +0000 Subject: Slight tweak to question-mode-recenter-line So the "add comment" button is visible after navigating to the comments section. --- sx-question-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sx-question-mode.el b/sx-question-mode.el index 01a980a..6f5dec3 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -82,7 +82,7 @@ If WINDOW is given, use that to display the buffer." ;; To move between sections, just search for the property. The value ;; of the text-property is the depth of the section (1 for contents, 2 ;; for comments). -(defcustom sx-question-mode-recenter-line 1 +(defcustom sx-question-mode-recenter-line 2 "Screen line to which we recenter after moving between sections. This is used as an argument to `recenter', only used if the end of section is outside the window. -- cgit v1.2.3 From 7320355e0c746e31aca91051758cc15499624b0c Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 29 Nov 2014 21:21:32 +0000 Subject: Woops. Fix swallowing one function inside the other. --- sx-question-print.el | 14 +++----------- 1 file changed, 3 insertions(+), 11 deletions(-) diff --git a/sx-question-print.el b/sx-question-print.el index 22f857c..ebdba56 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -394,19 +394,11 @@ URL is used as 'help-echo and 'url properties." ;; For visiting and stuff. 'sx-button-url url 'sx-button-copy url - :type 'sx-button-link) + :type 'sx-button-link)) - (defun sx-question-mode-find-reference (id &optional fallback-id) - "Find url identified by reference ID in current buffer. +(defun sx-question-mode-find-reference (id &optional fallback-id) + "Find url identified by reference ID in current buffer. If ID is nil, use FALLBACK-ID instead." - (save-excursion - (save-match-data - (goto-char (point-min)) - (when (search-forward-regexp - (format sx-question-mode--reference-regexp - (or id fallback-id)) - nil t) - (match-string-no-properties 1)))))) (defun sx-question-mode--move-over-pre () "Non-nil if paragraph at point can be filled." -- cgit v1.2.3 From 58c3a9c3a85920dfcaccea63b347f98b945e409f Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 29 Nov 2014 22:05:00 +0000 Subject: Add sx--unindent-text function Used to extract the code contained in code-blocks --- sx.el | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/sx.el b/sx.el index 10c0baa..fc58b02 100644 --- a/sx.el +++ b/sx.el @@ -188,6 +188,27 @@ Anything before the (sub)domain is removed." (rx string-start (or (and (0+ word) (optional ":") "//"))) "" url))) +(defun sx--unindent-text (text) + "Remove indentation from TEXT." + (with-temp-buffer + (insert text) + (goto-char (point-min)) + (let (result) + (while (null (eobp)) + (skip-chars-forward "[:blank:]") + (unless (looking-at "$") + (push (current-column) result)) + (forward-line 1)) + (when result + (let ((rx (format "^ \\{0,%s\\}" + (apply #'min result)))) + (goto-char (point-min)) + (while (and (null (eobp)) + (search-forward-regexp rx nil 'noerror)) + (replace-match "") + (forward-line 1))))) + (buffer-string))) + ;;; Printing request data (defvar sx--overlays nil -- cgit v1.2.3 From 55b33b779069d88e7fa70a25078d37e746ac3f97 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 29 Nov 2014 22:07:27 +0000 Subject: Code-blocks are buttons. RET to edit, w to copy. --- sx-button.el | 20 ++++++++++++++++++++ sx-question-print.el | 40 ++++++++++++++++++++++++++++++++-------- 2 files changed, 52 insertions(+), 8 deletions(-) diff --git a/sx-button.el b/sx-button.el index afc1cf7..af3c7e3 100644 --- a/sx-button.el +++ b/sx-button.el @@ -50,6 +50,21 @@ 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) + "Open a temp buffer populated with the string TEXT-OR-MARKER. +When given a marker (or interactively), use the 'sx-button-copy +text-property under the marker. This is usually the content of a +code-block." + (interactive (list (point-marker))) + ;; Buttons receive markers. + (when (markerp text-or-marker) + (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))) + (defun sx-button-follow-link (&optional pos) "Follow link at POS. If POS is nil, use `point'." (interactive) @@ -89,6 +104,11 @@ This is usually a link's URL, or the content of a code block." 'sx-button-copy-type "Share Link" :supertype 'sx-button) +(define-button-type 'sx-question-mode-code-block + 'action #'sx-button-edit-this + 'face nil + :supertype 'sx-button) + (define-button-type 'sx-button-link 'action #'sx-button-follow-link :supertype 'sx-button) diff --git a/sx-question-print.el b/sx-question-print.el index ebdba56..fb4d2e1 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -352,7 +352,7 @@ E.g.: (defun sx-question-mode--dont-fill-here () "If text shouldn't be filled here, return t and skip over it." - (or (sx-question-mode--move-over-pre) + (or (sx-question-mode--skip-and-fontify-pre) ;; Skip headers and references (let ((pos (point))) (skip-chars-forward "\r\n[:blank:]") @@ -399,13 +399,37 @@ URL is used as 'help-echo and 'url properties." (defun sx-question-mode-find-reference (id &optional fallback-id) "Find url identified by reference ID in current buffer. If ID is nil, use FALLBACK-ID instead." - -(defun sx-question-mode--move-over-pre () - "Non-nil if paragraph at point can be filled." - (markdown-match-pre-blocks - (save-excursion - (skip-chars-forward "\r\n[:blank:]") - (point)))) + (save-excursion + (save-match-data + (goto-char (point-min)) + (when (search-forward-regexp + (format sx-question-mode--reference-regexp + (or id fallback-id)) + nil t) + (match-string-no-properties 1))))) + +(defun sx-question-mode--skip-and-fontify-pre () + "If there's a pre block ahead, handle it, skip it and return t. +Handling means to turn it into a button and remove erroneous +font-locking." + (let (beg end text) + (when (markdown-match-pre-blocks + (save-excursion + (skip-chars-forward "\r\n[:blank:]") + (setq beg (point)))) + (setq end (point)) + (setq text + (sx--unindent-text + (buffer-substring + (save-excursion + (goto-char beg) + (line-beginning-position)) + end))) + (make-text-button + beg end + 'face 'markdown-pre-face + 'sx-button-copy text + :type 'sx-question-mode-code-block)))) (provide 'sx-question-print) ;;; sx-question-print.el ends here -- cgit v1.2.3 From 76ed7fb4f2b625ec782010050f05f6f2bf5c5a0c Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 29 Nov 2014 22:07:57 +0000 Subject: Comments --- sx-button.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/sx-button.el b/sx-button.el index af3c7e3..2ce07e1 100644 --- a/sx-button.el +++ b/sx-button.el @@ -72,6 +72,8 @@ code-block." (or (get-text-property (or pos (point)) 'sx-button-url) (user-error "No url under point: %s" (or pos (point)))))) + +;;; Help-echo definitions (defvar sx-button--help-echo (concat "mouse-1, RET" (propertize ": %s -- " 'face 'minibuffer-prompt) -- cgit v1.2.3 From a68a08fc54b10ca48ab3723f4616aba1a68383b8 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 29 Nov 2014 22:14:04 +0000 Subject: Remove bad require --- sx-button.el | 1 - 1 file changed, 1 deletion(-) diff --git a/sx-button.el b/sx-button.el index 2ce07e1..c1abf90 100644 --- a/sx-button.el +++ b/sx-button.el @@ -25,7 +25,6 @@ (require 'sx) (require 'sx-question) -(require 'sx-interaction) ;;; Command definitions -- cgit v1.2.3 From e459d6d57f517209f4d41df817413170f073998b Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 29 Nov 2014 22:14:38 +0000 Subject: Add needed require --- sx-tab.el | 1 + 1 file changed, 1 insertion(+) diff --git a/sx-tab.el b/sx-tab.el index 154a90f..5026a73 100644 --- a/sx-tab.el +++ b/sx-tab.el @@ -26,6 +26,7 @@ (require 'sx) (require 'sx-question-list) +(require 'sx-interaction) (defcustom sx-tab-default-site "emacs" "Name of the site to use by default when listing questions." -- cgit v1.2.3 From 6f87989747e066e7949c4fb2b72b768428e09346 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 29 Nov 2014 22:17:09 +0000 Subject: Clean 'display in code-blocks. Fixes #117 --- sx-question-print.el | 1 + 1 file changed, 1 insertion(+) diff --git a/sx-question-print.el b/sx-question-print.el index fb4d2e1..f49346b 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -425,6 +425,7 @@ font-locking." (goto-char beg) (line-beginning-position)) end))) + (put-text-property beg end 'display nil) (make-text-button beg end 'face 'markdown-pre-face -- cgit v1.2.3 From deebbf0f032d4649f78206d5d8ef570afb065579 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 29 Nov 2014 22:52:59 +0000 Subject: Fix #57. Set the buffer as unibyte then multibyte again. --- sx-question-print.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/sx-question-print.el b/sx-question-print.el index 0959f36..9245331 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -195,6 +195,10 @@ 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 .answers)) + ;; Display weird chars correctly + (set-buffer-multibyte nil) + (set-buffer-multibyte t) + ;; Go up (goto-char (point-min)) (sx-question-mode-next-section)) -- cgit v1.2.3 From bf56eba935f73c1803ea9964671a36bccb4efa21 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 1 Dec 2014 01:00:06 +0000 Subject: Define and use sx-question-mode-display-buffer-function --- sx-question-mode.el | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/sx-question-mode.el b/sx-question-mode.el index 01a980a..6423ad8 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -30,6 +30,14 @@ ;;; Displaying a question +(defcustom sx-question-mode-display-buffer-function #'switch-to-buffer + "Function used to display the question buffer. +Called, for instance, when hitting \\`\\[sx-question-list-display-question]' on an entry in the +question list. +This is not used when navigating the question list with `\\[sx-question-list-view-next]." + :type 'function + :group 'sx-question-mode) + (defvar sx-question-mode--window nil "Window where the content of questions is displayed.") @@ -71,7 +79,8 @@ If WINDOW is given, use that to display the buffer." ;; No window, but the buffer is already being displayed somewhere. ((get-buffer-window sx-question-mode--buffer 'visible)) ;; Neither, so we create the window. - (t (switch-to-buffer sx-question-mode--buffer))) + (t (funcall sx-question-mode-display-buffer-function + sx-question-mode--buffer))) sx-question-mode--buffer) -- cgit v1.2.3 From d2ac145a981521e23cd975ff41e84dc90fa161e5 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 1 Dec 2014 01:13:04 +0000 Subject: Make sx--data-here throw error on failure. --- sx-interaction.el | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/sx-interaction.el b/sx-interaction.el index 5f3ece6..87f72a5 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -29,13 +29,20 @@ ;;; Using data in buffer -(defun sx--data-here () - "Get the text property `sx--data-here'." +(defun sx--data-here (&optional noerror) + "Get data for the question or other object under point. +If NOERROR is non-nil, don't throw an error on failure. + +This looks at the text property `sx--data-here'. If it's not set, +it looks at a few other reasonable variables. If those fail too, +it throws an error." (or (get-text-property (point) 'sx--data-here) (and (derived-mode-p 'sx-question-list-mode) (tabulated-list-get-id)) (or (derived-mode-p 'sx-question-mode) - sx-question-mode--data))) + sx-question-mode--data) + (and (null noerror) + (error "No question data found here")))) (defun sx--maybe-update-display () "Refresh the question list if we're inside it." -- cgit v1.2.3 From 5924ca1de182fc6a865179e7166029cb68c86d1a Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 1 Dec 2014 01:13:52 +0000 Subject: Section Comment --- sx-interaction.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/sx-interaction.el b/sx-interaction.el index 87f72a5..8f87a47 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -58,6 +58,8 @@ Only fields contained in TO are copied." (setcar to (car from)) (setcdr to (cdr from))) + +;;; Visiting (defun sx-visit (data &optional copy-as-kill) "Visit DATA in a web browser. DATA can be a question, answer, or comment. Interactively, it is -- cgit v1.2.3 From feb3e5d9c61302d71d333cb8472b5e16a9c60e80 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 1 Dec 2014 01:23:35 +0000 Subject: Refactor sx-question-list--unread-count into a function. Less bookeeping --- sx-question-list.el | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/sx-question-list.el b/sx-question-list.el index 9709b99..01cdc61 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -145,9 +145,6 @@ Also see `sx-question-list-refresh'." .title 'face (if (sx-question--read-p question-data) 'sx-question-list-read-question - ;; Increment `sx-question-list--unread-count' for - ;; the mode-line. - (cl-incf sx-question-list--unread-count) 'sx-question-list-unread-question)) (propertize " " 'display "\n ") (propertize favorite 'face 'sx-question-list-favorite) @@ -334,10 +331,6 @@ Non-interactively, DATA is a question alist." ;; "Unanswered", etc. "Variable describing current tab being viewed.") -(defvar sx-question-list--unread-count 0 - "Holds the number of unread questions in the current buffer.") -(make-variable-buffer-local 'sx-question-list--unread-count) - (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) @@ -351,7 +344,7 @@ Non-interactively, DATA is a question alist." " [" "Unread: " (:propertize - (:eval (int-to-string sx-question-list--unread-count)) + (:eval (sx-question-list--unread-count)) face mode-line-buffer-id) ", " "Total: " @@ -361,6 +354,12 @@ Non-interactively, DATA is a question alist." "] ") "Mode-line construct to use in question-list buffers.") +(defun sx-question-list--unread-count () + "Number of unread questions in current dataset, as a string." + (int-to-string + (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. @@ -380,7 +379,6 @@ If the prefix argument NO-UPDATE is nil, query StackExchange for a new list before redisplaying." (interactive "p\nP") ;; Reset the mode-line unread count (we rebuild it here). - (setq sx-question-list--unread-count 0) (unless no-update (setq sx-question-list--pages-so-far 1)) (let* ((question-list @@ -494,7 +492,6 @@ relevant window." (unless data (setq data (tabulated-list-get-id))) (unless data (error "No question here!")) (unless (sx-question--read-p data) - (cl-decf sx-question-list--unread-count) (sx-question--mark-read data) (sx-question-list-refresh 'redisplay 'no-update)) (unless (and (window-live-p sx-question-mode--window) -- cgit v1.2.3 From f0d788a34a6d3e9ea564299703c35eee26f64374 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 1 Dec 2014 01:29:44 +0000 Subject: sx-question--mark-read returns nil if nothing changed --- sx-question-list.el | 3 +-- sx-question.el | 45 +++++++++++++++++++++++++-------------------- 2 files changed, 26 insertions(+), 22 deletions(-) diff --git a/sx-question-list.el b/sx-question-list.el index 01cdc61..9185531 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -491,8 +491,7 @@ relevant window." (interactive '(nil t)) (unless data (setq data (tabulated-list-get-id))) (unless data (error "No question here!")) - (unless (sx-question--read-p data) - (sx-question--mark-read data) + (when (sx-question--mark-read data) (sx-question-list-refresh 'redisplay 'no-update)) (unless (and (window-live-p sx-question-mode--window) (null (equal sx-question-mode--window (selected-window)))) diff --git a/sx-question.el b/sx-question.el index f80a9bd..24fd97f 100644 --- a/sx-question.el +++ b/sx-question.el @@ -86,27 +86,32 @@ See `sx-question--user-read-list'." (defun sx-question--mark-read (question) "Mark QUESTION as being read until it is updated again. +Returns nil if question (in its current state) was already marked +read, i.e., if it was `sx-question--read-p'. See `sx-question--user-read-list'." - (sx-assoc-let question - (sx-question--ensure-read-list .site) - (let ((site-cell (assoc .site sx-question--user-read-list)) - (q-cell (cons .question_id .last_activity_date)) - cell) - (cond - ;; First question from this site. - ((null site-cell) - (push (list .site q-cell) sx-question--user-read-list)) - ;; Question already has an older time. - ((setq cell (assoc .question_id site-cell)) - (setcdr cell .last_activity_date)) - ;; Question wasn't present. - (t - (sx-sorted-insert-skip-first - q-cell site-cell (lambda (x y) (> (car x) (car y)))))))) - ;; Save the results. - ;; @TODO This causes a small lag on `j' and `k' as the list gets - ;; large. Should we do this on a timer? - (sx-cache-set 'read-questions sx-question--user-read-list)) + (prog1 + (sx-assoc-let question + (sx-question--ensure-read-list .site) + (let ((site-cell (assoc .site sx-question--user-read-list)) + (q-cell (cons .question_id .last_activity_date)) + cell) + (cond + ;; First question from this site. + ((null site-cell) + (push (list .site q-cell) sx-question--user-read-list)) + ;; Question already present. + ((setq cell (assoc .question_id site-cell)) + ;; Current version is newer than cached version. + (when (> .last_activity_date (cdr cell)) + (setcdr cell .last_activity_date))) + ;; Question wasn't present. + (t + (sx-sorted-insert-skip-first + q-cell site-cell (lambda (x y) (> (car x) (car y)))))))) + ;; Save the results. + ;; @TODO This causes a small lag on `j' and `k' as the list gets + ;; large. Should we do this on a timer? + (sx-cache-set 'read-questions sx-question--user-read-list))) ;;;; Hidden -- cgit v1.2.3 From 867224348a5d979af7a965c9bbe476dea3c3638f Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 1 Dec 2014 01:46:34 +0000 Subject: Refactor sx-question-mode--window into a function. It made little sense the way it was, and it was complicated. Now that it's a function, it's always up to date. --- sx-question-mode.el | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/sx-question-mode.el b/sx-question-mode.el index 6423ad8..bee3e29 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -38,15 +38,20 @@ This is not used when navigating the question list with `\\[sx-question-list-vie :type 'function :group 'sx-question-mode) -(defvar sx-question-mode--window nil - "Window where the content of questions is displayed.") - (defvar sx-question-mode--buffer nil "Buffer being used to display questions.") (defvar sx-question-mode--data nil "The data of the question being displayed.") +(defun sx-question-mode--get-window () + "Return a window displaying a question, or nil." + (car-safe + (cl-member-if + (lambda (x) (with-selected-window x + (derived-mode-p 'sx-question-mode))) + (window-list nil 'never nil)))) + (defun sx-question-mode--display (data &optional window) "Display question given by DATA on WINDOW. If WINDOW is nil, use selected one. -- cgit v1.2.3 From 5bb980d36c6e0346da629ceeb1835a020e75a9b4 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 1 Dec 2014 02:02:14 +0000 Subject: Refactor sx-question-list-display-question into 2 other functions --- sx-interaction.el | 24 ++++++++++++++++++ sx-question-list.el | 70 ++++++++++++++++++++++++----------------------------- 2 files changed, 56 insertions(+), 38 deletions(-) diff --git a/sx-interaction.el b/sx-interaction.el index 8f87a47..f34c49c 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -82,6 +82,30 @@ If DATA is a question, also mark it as read." (sx-question--mark-read data) (sx--maybe-update-display)))) + +;;; Displaying +(defun sx-display-question (&optional data focus window) + "Display question given by DATA, on WINDOW. +When DATA is nil, display question under point. When FOCUS is +non-nil (the default when called interactively), also focus the +relevant window. + +If WINDOW nil, the window is decided by +`sx-question-mode-display-buffer-function'." + (interactive (list (sx--data-here) t)) + (when (sx-question--mark-read data) + (sx--maybe-update-display)) + ;; Display the question. + (setq window + (get-buffer-window + (sx-question-mode--display data window))) + (when focus + (if (window-live-p window) + (select-window window) + (switch-to-buffer sx-question-mode--buffer)))) + + +;;; Voting (defun sx-toggle-upvote (data) "Apply or remove upvote from DATA. DATA can be a question, answer, or comment. Interactively, it is diff --git a/sx-question-list.el b/sx-question-list.el index 9185531..d2e1bb6 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -301,7 +301,7 @@ into consideration. ("d" sx-toggle-downvote) ("h" sx-question-list-hide) ("m" sx-question-list-mark-read) - ([?\r] sx-question-list-display-question))) + ([?\r] sx-display-question))) (defun sx-question-list-hide (data) "Hide question under point. @@ -421,7 +421,37 @@ Displayed in `sx-question-mode--window', replacing any question that may currently be there." (interactive "p") (sx-question-list-next n) - (sx-question-list-display-question)) + (sx-display-question + (tabulated-list-get-id) + nil + (sx-question-list--create-question-window))) + +(defun sx-question-list--create-question-window () + "Create or find a window where a question can be displayed. + +If any current window displays a question, that window is +returned. If none do, a new one is created such that the +question-list window remains `sx-question-list-height' lines +high (if possible)." + (or (sx-question-mode--get-window) + ;; Create a proper window. + (let ((window + (condition-case er + (split-window (selected-window) sx-question-list-height 'below) + (error + ;; If the window is too small to split, use any one. + (if (string-match + "Window # too small for splitting" + (car (cdr-safe er))) + (next-window) + (error (cdr er))))))) + ;; Configure the window to be closed on `q'. + (set-window-prev-buffers window nil) + (set-window-parameter + window 'quit-restore + ;; See (info "(elisp) Window Parameters") + `(window window ,(selected-window) ,sx-question-mode--buffer)) + window))) (defun sx-question-list-next (n) "Move cursor down N questions. @@ -483,42 +513,6 @@ This does not update `sx-question-mode--window'." (interactive "p") (sx-question-list-next-far (- n))) -(defun sx-question-list-display-question (&optional data focus) - "Display question given by DATA. -When DATA is nil, display question under point. When FOCUS is -non-nil (the default when called interactively), also focus the -relevant window." - (interactive '(nil t)) - (unless data (setq data (tabulated-list-get-id))) - (unless data (error "No question here!")) - (when (sx-question--mark-read data) - (sx-question-list-refresh 'redisplay 'no-update)) - (unless (and (window-live-p sx-question-mode--window) - (null (equal sx-question-mode--window (selected-window)))) - (setq sx-question-mode--window - (condition-case er - (split-window (selected-window) sx-question-list-height 'below) - (error - ;; If the window is too small to split, use current one. - (if (string-match - "Window # too small for splitting" - (car (cdr-safe er))) - nil - (error (cdr er))))))) - ;; Display the question. - (sx-question-mode--display data sx-question-mode--window) - ;; Configure the window to be closed on `q'. - (set-window-prev-buffers sx-question-mode--window nil) - (set-window-parameter - sx-question-mode--window - 'quit-restore - ;; See (info "(elisp) Window Parameters") - `(window window ,(selected-window) ,sx-question-mode--buffer)) - (when focus - (if sx-question-mode--window - (select-window sx-question-mode--window) - (switch-to-buffer sx-question-mode--buffer)))) - (defun sx-question-list-switch-site (site) "Switch the current site to SITE and display its questions. Use `ido-completing-read' if variable `ido-mode' is active. -- cgit v1.2.3 From 30217190b487a9b0acb7e367fe4bdf226e0819e5 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 1 Dec 2014 02:30:49 +0000 Subject: Maintain good line position while navigating the question list. --- sx-question-list.el | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/sx-question-list.el b/sx-question-list.el index d2e1bb6..18f8ba0 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -463,7 +463,21 @@ This does not update `sx-question-mode--window'." ;; If we were trying to move forward, but we hit the end. (when (eobp) ;; Try to get more questions. - (sx-question-list-next-page)))) + (sx-question-list-next-page)) + (sx-question-list--ensure-line-good-line-position))) + +(defun sx-question-list--ensure-line-good-line-position () + "Scroll window such that current line is a good place. +Check if we're at least 6 lines from the bottom. Scroll up if +we're not. Do the same for 3 lines from the top." + ;; At least one entry below us. + (let ((lines-to-bottom (count-screen-lines (point) (window-end)))) + (unless (>= lines-to-bottom 6) + (recenter (- 6)))) + ;; At least one entry above us. + (let ((lines-to-top (count-screen-lines (point) (window-start)))) + (unless (>= lines-to-top 3) + (recenter 3)))) (defun sx-question-list-next-page () "Fetch and display the next page of questions." -- cgit v1.2.3 From 039ef045855fa4e2c039e228dda998d2173eca01 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 1 Dec 2014 02:50:10 +0000 Subject: sx-question-get-questions takes arbitrary keywords. --- sx-question.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/sx-question.el b/sx-question.el index f80a9bd..00b5f7f 100644 --- a/sx-question.el +++ b/sx-question.el @@ -26,15 +26,17 @@ (require 'sx-filter) (require 'sx-method) -(defun sx-question-get-questions (site &optional page) +(defun sx-question-get-questions (site &optional page keywords) "Get SITE questions. Return page PAGE (the first if nil). Return a list of question. Each question is an alist of properties returned by the API with an added (site SITE) property. +KEYWORDS are added to the method call along with PAGE. + `sx-method-call' is used with `sx-browse-filter'." (sx-method-call 'questions - :keywords `((page . ,page)) + :keywords `((page . ,page) ,@keywords) :site site :auth t :filter sx-browse-filter)) -- cgit v1.2.3 From 3e4386a0ec6383eb92ae5535db165c82ed7092b2 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 1 Dec 2014 03:07:32 +0000 Subject: Define 5 new tabs, as per http://api.stackexchange.com/docs/questions --- sx-tab.el | 76 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 75 insertions(+), 1 deletion(-) diff --git a/sx-tab.el b/sx-tab.el index 7ccbf18..1152528 100644 --- a/sx-tab.el +++ b/sx-tab.el @@ -96,7 +96,7 @@ If SITE is nil, use `sx-tab-default-site'." (sx-tab--define "FrontPage" (lambda (page) (sx-question-get-questions - sx-question-list--site page))) + sx-question-list--site page '((sort . activity))))) ;;;###autoload (autoload 'sx-tab-frontpage (expand-file-name @@ -105,5 +105,79 @@ If SITE is nil, use `sx-tab-default-site'." (file-name-directory load-file-name))) nil t) + +;;; Newest +(sx-tab--define "Newest" + (lambda (page) + (sx-question-get-questions + sx-question-list--site page '((sort . creation))))) +;;;###autoload +(autoload 'sx-tab-newest + (expand-file-name + "sx-tab" + (when load-file-name + (file-name-directory load-file-name))) + nil t) + + + +;;; TopVoted +(sx-tab--define "TopVoted" + (lambda (page) + (sx-question-get-questions + sx-question-list--site page '((sort . votes))))) +;;;###autoload +(autoload 'sx-tab-topvoted + (expand-file-name + "sx-tab" + (when load-file-name + (file-name-directory load-file-name))) + nil t) + + + +;;; Hot +(sx-tab--define "Hot" + (lambda (page) + (sx-question-get-questions + sx-question-list--site page '((sort . hot))))) +;;;###autoload +(autoload 'sx-tab-hot + (expand-file-name + "sx-tab" + (when load-file-name + (file-name-directory load-file-name))) + nil t) + + + +;;; Week +(sx-tab--define "Week" + (lambda (page) + (sx-question-get-questions + sx-question-list--site page '((sort . week))))) +;;;###autoload +(autoload 'sx-tab-week + (expand-file-name + "sx-tab" + (when load-file-name + (file-name-directory load-file-name))) + nil t) + + + +;;; Month +(sx-tab--define "Month" + (lambda (page) + (sx-question-get-questions + sx-question-list--site page '((sort . month))))) +;;;###autoload +(autoload 'sx-tab-month + (expand-file-name + "sx-tab" + (when load-file-name + (file-name-directory load-file-name))) + nil t) + (provide 'sx-tab) ;;; sx-tab.el ends here -- cgit v1.2.3 From 10597c39adbcf775841f908452082ed344110ce9 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 1 Dec 2014 03:08:52 +0000 Subject: Define command for changing tab --- sx-tab.el | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/sx-tab.el b/sx-tab.el index 1152528..b497ce0 100644 --- a/sx-tab.el +++ b/sx-tab.el @@ -32,6 +32,18 @@ :type 'string :group 'sx) +(defvar sx-tab--list nil + "List of the names of all defined tabs.") + +(defun sx-tab-switch (tab) + "Switch to another question-list tab." + (interactive + (list (funcall (if ido-mode #'ido-completing-read #'completing-read) + "Switch to tab: " sx-tab--list + (lambda (tab) (not (equal tab sx-question-list--current-tab))) + t))) + (funcall (intern (format "sx-tab-%s" (downcase tab))))) + (defmacro sx-tab--define (tab pager &optional printer refresher &rest body) "Define a StackExchange tab called TAB. @@ -55,7 +67,7 @@ variables, but before refreshing the display." `(progn (defvar ,buffer-variable nil ,(format "Buffer where the %s questions are displayed." - tab)) + tab)) (defun ,(intern (concat "sx-tab-" name)) (&optional no-update site) @@ -63,7 +75,7 @@ variables, but before refreshing the display." NO-UPDATE (the prefix arg) is passed to `sx-question-list-refresh'. If SITE is nil, use `sx-tab-default-site'." - tab) + tab) (interactive (list current-prefix-arg (funcall (if ido-mode #'ido-completing-read #'completing-read) @@ -89,7 +101,10 @@ If SITE is nil, use `sx-tab-default-site'." (setq sx-question-list--current-tab ,tab) ,@body (sx-question-list-refresh 'redisplay no-update)) - (switch-to-buffer ,buffer-variable))))) + (switch-to-buffer ,buffer-variable)) + ;; Add this tab to the list of existing tabs. So we can prompt + ;; the user with completion and stuff. + (add-to-list 'sx-tab--list ,tab)))) ;;; FrontPage -- cgit v1.2.3 From 4f4b4d9f9a1000ce5f91e6d835cb71268f9525ec Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 1 Dec 2014 03:08:59 +0000 Subject: Bind sx-tab-switch to t in question list Fixes #17 --- sx-question-list.el | 1 + 1 file changed, 1 insertion(+) diff --git a/sx-question-list.el b/sx-question-list.el index 9709b99..852c11a 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -299,6 +299,7 @@ into consideration. ("K" sx-question-list-previous-far) ("g" sx-question-list-refresh) (":" sx-question-list-switch-site) + ("t" sx-question-list-switch-tab) ("v" sx-visit) ("u" sx-toggle-upvote) ("d" sx-toggle-downvote) -- cgit v1.2.3 From 39f2ae05597edd902610764b9b402111d33a8fe7 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 1 Dec 2014 10:30:08 +0000 Subject: question-mod now uses overlays to store the sx--data-here property This lets us stack one inside each other (comments inside questions) without overwriting them. --- sx-interaction.el | 6 +++--- sx-question-print.el | 4 ++-- sx.el | 24 +++++++++++++----------- 3 files changed, 18 insertions(+), 16 deletions(-) diff --git a/sx-interaction.el b/sx-interaction.el index 92b062b..b6113a2 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -31,11 +31,11 @@ ;;; Using data in buffer (defun sx--data-here () "Get the text property `sx--data-here'." - (or (get-text-property (point) 'sx--data-here) + (or (get-pos-property (point) 'sx--data-here) (and (derived-mode-p 'sx-question-list-mode) (tabulated-list-get-id)) - (or (derived-mode-p 'sx-question-mode) - sx-question-mode--data))) + (and (derived-mode-p 'sx-question-mode) + sx-question-mode--data))) (defun sx--maybe-update-display () "Refresh the question list if we're inside it." diff --git a/sx-question-print.el b/sx-question-print.el index f49346b..45124c4 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -185,7 +185,7 @@ QUESTION must be a data structure returned by `json-read'." DATA can represent a question or an answer." ;; This makes `data' accessible through `sx--data-here'. (sx-assoc-let data - (sx--wrap-in-text-property + (sx--wrap-in-overlay (list 'sx--data-here data) (insert sx-question-mode-header-title) (insert-text-button @@ -270,7 +270,7 @@ DATA can represent a question or an answer." "Print the comment described by alist COMMENT-DATA. The comment is indented, filled, and then printed according to `sx-question-mode-comments-format'." - (sx--wrap-in-text-property + (sx--wrap-in-overlay (list 'sx--data-here comment-data) (sx-assoc-let comment-data (insert diff --git a/sx.el b/sx.el index fc58b02..f1d3634 100644 --- a/sx.el +++ b/sx.el @@ -215,6 +215,11 @@ Anything before the (sub)domain is removed." "Overlays created by sx on this buffer.") (make-variable-buffer-local 'sx--overlays) +(defvar sx--overlay-printing-depth 0 + "Track how many overlays we're printing on top of each other. +Used for assigning higher priority to inner overlays.") +(make-variable-buffer-local 'sx--overlay-printing-depth) + (defmacro sx--wrap-in-overlay (properties &rest body) "Start a scope with overlay PROPERTIES and execute BODY. Overlay is pushed on the buffer-local variable `sx--overlays' and @@ -224,24 +229,21 @@ Return the result of BODY." (declare (indent 1) (debug t)) `(let ((p (point-marker)) - (result (progn ,@body))) + (result (progn ,@body)) + ;; The first overlay is the shallowest. Any overlays created + ;; while the first one is still being created go deeper and + ;; deeper. + (sx--overlay-printing-depth (1+ sx--overlay-printing-depth))) (let ((ov (make-overlay p (point))) (props ,properties)) (while props (overlay-put ov (pop props) (pop props))) + ;; Let's multiply by 10 just in case we ever want to put + ;; something in the middle. + (overlay-put ov 'priority (* 10 sx--overlay-printing-depth)) (push ov sx--overlays)) result)) -(defmacro sx--wrap-in-text-property (properties &rest body) - "Start a scope with PROPERTIES and execute BODY. -Return the result of BODY." - (declare (indent 1) - (debug t)) - `(let ((p (point-marker)) - (result (progn ,@body))) - (add-text-properties p (point) ,properties) - result)) - (defun sx--user-@name (user) "Get the `display_name' of USER prepended with @. In order to correctly @mention the user, all whitespace is -- cgit v1.2.3 From a9c1d6c5f7ae3f043c5db5259e0a55d4ede13a8b Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 1 Dec 2014 10:38:48 +0000 Subject: Better positioning of the add comment button --- sx-question-print.el | 43 +++++++++++++++++++++++++------------------ 1 file changed, 25 insertions(+), 18 deletions(-) diff --git a/sx-question-print.el b/sx-question-print.el index 45124c4..d6d554d 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -238,27 +238,34 @@ 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) + (insert "\n") + (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. + (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 " ") (insert-text-button "Add a Comment" :type 'sx-button-comment) - (insert "\n")) - ;; 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) - (insert "\n") - (sx--wrap-in-overlay - '(face sx-question-mode-content-face) - (mapc #'sx-question-mode--print-comment .comments)))))) + (insert "\n")))) (defun sx-question-mode--propertize-display-name (author) "Return display_name of AUTHOR with `sx-question-mode-author' face." -- cgit v1.2.3 From 2a87b0f4830d408d59cf4ddb21ddb8371e4787c7 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 1 Dec 2014 10:45:15 +0000 Subject: Comments are now hidden when you fold the question --- sx-question-mode.el | 14 ++++++++------ sx-question-print.el | 54 ++++++++++++++++++++++++++-------------------------- 2 files changed, 35 insertions(+), 33 deletions(-) diff --git a/sx-question-mode.el b/sx-question-mode.el index 6f5dec3..c44519c 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -141,9 +141,9 @@ If DIRECTION is negative, move backwards instead." "Hide or show section under point. Optional argument _ is for `push-button'." (interactive) - (let ((ov (car (or (sx-question-mode--section-overlays-at (point)) - (sx-question-mode--section-overlays-at - (line-end-position)))))) + (let ((ov (or (sx-question-mode--section-overlays-at + (line-end-position)) + (sx-question-mode--section-overlays-at (point))))) (goto-char (overlay-start ov)) (forward-line 0) (overlay-put @@ -151,9 +151,11 @@ Optional argument _ is for `push-button'." (null (overlay-get ov 'invisible))))) (defun sx-question-mode--section-overlays-at (pos) - "Return a list of `sx-question-mode--section-content' overlays at POS." - (cl-remove-if (lambda (x) (null (overlay-get x 'sx-question-mode--section-content))) - (overlays-at pos))) + "Return the highest priority section overlay at POS. +A section overlay has a `sx-question-mode--section-content' +property." + (cdr-safe (get-char-property-and-overlay + pos 'sx-question-mode--section-content nil))) ;;; Major-mode diff --git a/sx-question-print.el b/sx-question-print.el index d6d554d..307742a 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -237,35 +237,35 @@ DATA can represent a question or an answer." .body_markdown) "\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) + '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 - '(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. - (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" - :type 'sx-button-comment) - (insert "\n")))) + '(sx-question-mode--section-content t) + (insert "\n") + (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. + (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" + :type 'sx-button-comment) + (insert "\n"))))) (defun sx-question-mode--propertize-display-name (author) "Return display_name of AUTHOR with `sx-question-mode-author' face." -- cgit v1.2.3 From 7d6110a64c3b9e6d95a2976b8423ab26fe312b2c Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 1 Dec 2014 11:14:00 +0000 Subject: Reimplement deleted-user --- sx-question-print.el | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/sx-question-print.el b/sx-question-print.el index 0959f36..3200ead 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -43,6 +43,11 @@ ;;; Faces and Variables +(defcustom sx-question-mode-deleted-user + '((display_name . "(deleted user)")) + "The structure used to represent a deleted account." + :type '(alist :options ((display_name string))) + :group 'sx-question-mode) (defface sx-question-mode-header '((t :inherit font-lock-variable-name-face)) @@ -227,7 +232,8 @@ DATA can represent a question or an answer." (when .last_edit_date (format sx-question-mode-last-edit-format (sx-time-since .last_edit_date) - (sx-question-mode--propertize-display-name .last_editor)))) + (sx-question-mode--propertize-display-name + (or .last_editor sx-question-mode-deleted-user))))) 'sx-question-mode-date) (sx-question-mode--insert-header sx-question-mode-header-score -- cgit v1.2.3 From 5cfd9b840e3835ed373a8c6e67291c69f336a3b6 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 1 Dec 2014 15:31:28 +0000 Subject: Switch get-pos-property to get-char-property --- sx-interaction.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sx-interaction.el b/sx-interaction.el index b6113a2..305e61c 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -31,7 +31,7 @@ ;;; Using data in buffer (defun sx--data-here () "Get the text property `sx--data-here'." - (or (get-pos-property (point) 'sx--data-here) + (or (get-char-property (point) 'sx--data-here) (and (derived-mode-p 'sx-question-list-mode) (tabulated-list-get-id)) (and (derived-mode-p 'sx-question-mode) -- cgit v1.2.3 From 8795a394f90f143239edeabd870bf0767303543d Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Tue, 2 Dec 2014 15:24:47 +0000 Subject: Redo sx--data-here take &optional noerror --- sx-interaction.el | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/sx-interaction.el b/sx-interaction.el index b04a49e..b67e0df 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -29,13 +29,20 @@ ;;; Using data in buffer -(defun sx--data-here () - "Get the text property `sx--data-here'." - (or (get-char-property (point) 'sx--data-here) +(defun sx--data-here (&optional noerror) + "Get data for the question or other object under point. +If NOERROR is non-nil, don't throw an error on failure. + +This looks at the text property `sx--data-here'. If it's not set, +it looks at a few other reasonable variables. If those fail too, +it throws an error." + (or (get-text-property (point) 'sx--data-here) (and (derived-mode-p 'sx-question-list-mode) (tabulated-list-get-id)) (and (derived-mode-p 'sx-question-mode) - sx-question-mode--data))) + sx-question-mode--data) + (and (null noerror) + (error "No question data found here")))) (defun sx--maybe-update-display () "Refresh the question list if we're inside it." -- cgit v1.2.3