diff options
| -rw-r--r-- | sx-button.el | 13 | ||||
| -rw-r--r-- | sx-question-list.el | 9 | ||||
| -rw-r--r-- | sx-question-print.el | 47 | ||||
| -rw-r--r-- | sx-question.el | 6 | ||||
| -rw-r--r-- | sx-search.el | 14 | ||||
| -rw-r--r-- | sx-tag.el | 22 | ||||
| -rw-r--r-- | test/test-printing.el | 20 |
7 files changed, 90 insertions, 41 deletions
diff --git a/sx-button.el b/sx-button.el index 992c654..8a4bcc0 100644 --- a/sx-button.el +++ b/sx-button.el @@ -122,6 +122,12 @@ usually part of a code-block." "link") "Help echoed in the minibuffer when point is on a user.") +(defconst sx-button--tag-help-echo + (format sx-button--help-echo + "Tag search" + "tag") + "Help echoed in the minibuffer when point is on a tag.") + (defconst sx-button--question-title-help-echo (format sx-button--help-echo "hide content" @@ -163,6 +169,13 @@ usually part of a code-block." 'face 'sx-user-name :supertype 'sx-button) +(declare-function sx-search-tag-at-point "sx-tag") +(define-button-type 'sx-button-tag + 'action #'sx-search-tag-at-point + 'help-echo sx-button--tag-help-echo + 'face 'sx-tag + :supertype 'sx-button) + (define-button-type 'sx-button-comment 'help-echo (concat "mouse-1, RET" (propertize ": write a comment" diff --git a/sx-question-list.el b/sx-question-list.el index 7757503..333fd83 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -27,6 +27,7 @@ (require 'sx) (require 'sx-time) +(require 'sx-tag) (require 'sx-site) (require 'sx-question) (require 'sx-question-mode) @@ -81,11 +82,6 @@ "" :group 'sx-question-list-faces) -(defface sx-question-list-tags - '((t :inherit sx-question-mode-tags)) - "" - :group 'sx-question-list-faces) - (defface sx-question-list-date '((t :inherit font-lock-comment-face)) "" @@ -170,8 +166,7 @@ Also see `sx-question-list-refresh'." " " ;; @TODO: Make this width customizable. (Or maybe just make ;; the whole thing customizable) - (propertize (format "%-40s" (mapconcat #'sx-question--tag-format .tags " ")) - 'face 'sx-question-list-tags) + (format "%-40s" (mapconcat #'sx-tag--format .tags " ")) " " (sx-user--format "%15d %4r" .owner) (propertize " " 'display "\n"))))))) diff --git a/sx-question-print.el b/sx-question-print.el index 778b580..190c924 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -79,11 +79,6 @@ Some faces of this mode might be defined in the `sx-user' group." :type 'string :group 'sx-question-mode) -(defface sx-question-mode-tags - '((t :underline nil :inherit font-lock-function-name-face)) - "Face used on the question tags in the question buffer." - :group 'sx-question-mode-faces) - (defface sx-question-mode-score '((t)) "Face used for the score in the question buffer." @@ -228,8 +223,8 @@ DATA can represent a question or an answer." ;; Tags (sx-question-mode--insert-header sx-question-mode-header-tags - (mapconcat #'sx-question--tag-format .tags " ") - 'sx-question-mode-tags)) + (mapconcat #'sx-tag--format .tags " ") + nil)) ;; Body (insert "\n" (propertize sx-question-mode-separator @@ -304,7 +299,10 @@ where `value' is given `face' as its face. (while args (insert (propertize (pop args) 'face 'sx-question-mode-header) - (propertize (pop args) 'face (pop args))))) + (let ((header (pop args)) + (face (pop args))) + (if face (propertize header 'face face) + header))))) ;;;; Printing and Font-locking the content (body) @@ -322,7 +320,8 @@ E.g.: (defconst sx-question-mode--link-regexp ;; Done at compile time. - (rx (or (and "[" (group-n 1 (1+ (not (any "]")))) "]" + (rx (or (and "[tag:" (group-n 5 (+ (not (any " ]")))) "]") + (and "[" (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") "://") "" @@ -370,18 +369,24 @@ E.g.: (save-excursion (goto-char (point-min)) (while (search-forward-regexp sx-question-mode--link-regexp nil t) - (let* ((text (match-string-no-properties 1)) - (url (or (match-string-no-properties 2) - (match-string-no-properties 4) - (sx-question-mode-find-reference - (match-string-no-properties 3) - text))) - (full-text (match-string-no-properties 0))) - (when (stringp url) - (replace-match "") - (sx-question-mode--insert-link - (or (if sx-question-mode-pretty-links text full-text) url) - url)))))) + ;; Tags are tag-buttons. + (let ((tag (match-string-no-properties 5))) + (if (and tag (> (length tag) 0)) + (progn (replace-match "") + (sx-tag--insert tag)) + ;; Other links are link-buttons. + (let* ((text (match-string-no-properties 1)) + (url (or (match-string-no-properties 2) + (match-string-no-properties 4) + (sx-question-mode-find-reference + (match-string-no-properties 3) + text))) + (full-text (match-string-no-properties 0))) + (when (stringp url) + (replace-match "") + (sx-question-mode--insert-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. diff --git a/sx-question.el b/sx-question.el index 1fde1aa..1162eb9 100644 --- a/sx-question.el +++ b/sx-question.el @@ -197,20 +197,14 @@ If no cache exists for it, initialize one with SITE." ;;;; Other data - (defun sx-question--accepted-answer-id (question) "Return accepted answer in QUESTION or nil if none exists." (sx-assoc-let question (and (integerp .accepted_answer_id) .accepted_answer_id))) -(defun sx-question--tag-format (tag) - "Formats TAG for display." - (concat "[" tag "]")) - ;;; Question Mode Answer-Sorting Functions - (sx--create-comparator sx-answer-higher-score-p "Return t if answer A has a higher score than answer B." #'> (lambda (x) (cdr (assq 'score x)))) diff --git a/sx-search.el b/sx-search.el index 55964b9..b33efff 100644 --- a/sx-search.el +++ b/sx-search.el @@ -32,6 +32,7 @@ (require 'sx) (require 'sx-question-list) +(require 'sx-question-mode) (require 'sx-tag) (defvar sx-search--query-history nil @@ -117,6 +118,19 @@ prefix argument, the user is asked for everything." (sx-question-list-refresh 'redisplay) (switch-to-buffer (current-buffer)))) + +;;; Tag +(defun sx-search-tag-at-point (&optional pos) + "Follow tag under position POS or point." + (interactive) + (let ((tag (save-excursion + (when pos (goto-char pos)) + (or (get-text-property (point) 'sx-tag) + (thing-at-point 'symbol))))) + (sx-search (or sx-question-list--site + (sx-assoc-let sx-question-mode--data .site_par)) + nil tag))) + (provide 'sx-search) ;;; sx-search.el ends here @@ -23,6 +23,13 @@ (require 'sx) (require 'sx-method) +(require 'sx-button) + +(defface sx-tag + '((t :underline nil :inherit font-lock-function-name-face)) + "Face used on the question tags in the question buffer." + :group 'sx-question-mode-faces + :group 'sx-question-list-faces) ;;; Getting the list from a site @@ -133,6 +140,21 @@ tags." (push input list)) (reverse list))) + +;;; Printing +(defun sx-tag--format (tag) + "Format and return TAG for display." + (with-temp-buffer + (sx-tag--insert tag) + (buffer-string))) + +(defun sx-tag--insert (tag) + "Insert TAG button." + (insert-text-button (concat "[" tag "]") + 'sx-button-copy tag + 'sx-tag tag + :type 'sx-button-tag)) + (provide 'sx-tag) ;;; sx-tag.el ends here diff --git a/test/test-printing.el b/test/test-printing.el index bcc3dd9..8016444 100644 --- a/test/test-printing.el +++ b/test/test-printing.el @@ -13,7 +13,7 @@ (defmacro question-list-regex (title votes answers &rest tags) "Construct a matching regexp for TITLE, VOTES, and ANSWERS. Each element of TAGS is appended at the end of the expression -after being run through `sx-question--tag-format'." +after being run through `sx-tag--format'." `(rx line-start (+ whitespace) ,(number-to-string votes) (+ whitespace) ,(number-to-string answers) @@ -22,8 +22,7 @@ after being run through `sx-question--tag-format'." (+ (any whitespace digit)) (or "y" "d" "h" "m" "mo" "s") " ago" (+ whitespace) - (eval (mapconcat #'sx-question--tag-format - (list ,@tags) " ")))) + (eval (mapconcat #'sx-tag--format (list ,@tags) " ")))) ;;; Tests @@ -40,11 +39,18 @@ after being run through `sx-question--tag-format'." (sx-time-since 1420105000.))))) (ert-deftest question-list-tag () - "Test `sx-question--tag-format'." + "Test `sx-tag--format'." (should - (string= - (sx-question--tag-format "tag") - "[tag]"))) + (string= (sx-tag--format "tag") "[tag]")) + (with-temp-buffer + (insert (sx-tag--format "tag")) + (should (get-char-property (point-min) 'button)) + (should + (eq (get-char-property (point-min) 'face) 'sx-tag)) + (should + (string= (get-char-property (point-min) 'sx-tag) "tag")) + (should + (string= (get-char-property (point-min) 'sx-button-copy) "tag")))) (ert-deftest question-list-display () (cl-letf (((symbol-function #'sx-request-make) |