diff options
| -rw-r--r-- | sx-question-mode.el | 101 |
1 files changed, 45 insertions, 56 deletions
diff --git a/sx-question-mode.el b/sx-question-mode.el index 6dc8395..21b6d40 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -22,6 +22,7 @@ ;;; Code: (require 'markdown-mode) +(require 'button) (eval-when-compile (require 'rx)) @@ -96,12 +97,12 @@ If WINDOW is given, use that to display the buffer." :group 'sx-question-mode-faces) (defface sx-question-mode-title - '((t :height 1.3 :weight bold :inherit default)) + '((t :weight bold :inherit default)) "Face used on the question title in the question buffer." :group 'sx-question-mode-faces) (defface sx-question-mode-title-comments - '((t :height 1.1 :inherit sx-question-mode-title)) + '((t :inherit sx-question-mode-title)) "Face used on the question title in the question buffer." :group 'sx-question-mode-faces) @@ -228,17 +229,15 @@ QUESTION must be a data structure returned by `json-read'." (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)) + (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.") -(defvar sx-question-mode--title-properties - `(face sx-question-mode-title - action sx-question-mode-hide-show-section - help-echo ,sx-question-mode--section-help-echo - button t - follow-link t) - "Title properties.") +(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) (defun sx-question-mode--print-section (data) "Print a section corresponding to DATA. @@ -247,17 +246,13 @@ DATA can represent a question or an answer." (sx-assoc-let data (sx--wrap-in-text-property (list 'sx--data-here data) - (insert sx-question-mode-header-title - (apply - #'propertize - ;; Questions have title - (or .title - ;; Answers don't - sx-question-mode-answer-title) - ;; Section level - 'sx-question-mode--section (if .title 1 2) - ;; face, action and help-echo - sx-question-mode--title-properties)) + (insert sx-question-mode-header-title) + (insert-text-button + ;; Questions have title, Answers don't + (or .title sx-question-mode-answer-title) + ;; Section level + 'sx-question-mode--section (if .title 1 2) + :type 'sx-question-mode-title) ;; Sections can be hidden with overlays (sx--wrap-in-overlay '(sx-question-mode--section-content t) @@ -272,8 +267,8 @@ DATA can represent a question or an answer." (sx-time-seconds-to-date .creation_date) (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-time-since .last_edit_date) + (sx-question-mode--propertize-display-name .last_editor)))) 'sx-question-mode-date) (sx-question-mode--insert-header sx-question-mode-header-score @@ -304,12 +299,12 @@ DATA can represent a question or an answer." ;; Comments have their own `sx--data-here' property (so they can ;; be upvoted too). (when .comments - (insert "\n" - (apply #'propertize - sx-question-mode-comments-title - 'face 'sx-question-mode-title-comments - 'sx-question-mode--section 3 - sx-question-mode--title-properties)) + (insert "\n") + (insert-text-button + sx-question-mode-comments-title + 'face 'sx-question-mode-title-comments + 'sx-question-mode--section 3 + :type 'sx-question-mode-title) (sx--wrap-in-overlay '(sx-question-mode--section-content t) (insert "\n") @@ -431,36 +426,30 @@ E.g.: (url (or (match-string-no-properties 2) (sx-question-mode-find-reference (match-string-no-properties 3) - text)))) - (replace-match - (sx-question-mode--propertize-link - (if sx-question-mode-pretty-links - text - (match-string-no-properties 0)) - url) - :fixedcase :literal nil 0))))) - -(defun sx-question-mode--propertize-link (text url) + text))) + (full-text (match-string-no-properties 0))) + (replace-match "") + (sx-question-mode--insert-link + (if sx-question-mode-pretty-links text full-text) + url))))) + +(define-button-type 'sx-question-mode-link + 'follow-link t + 'action #'sx-question-mode-follow-link) + +(defun sx-question-mode--insert-link (text url) "Return a link propertized version of string TEXT. URL is used as 'help-echo and 'url properties." - (propertize + (insert-text-button 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)) - ;; In case we need it. - 'url url - ;; Decoration - 'face 'link - 'mouse-face 'highlight - ;; So RET works - 'button t - ;; So mouse works - 'follow-link t - ;; What RET calls - 'action #'sx-question-mode-follow-link)) + 'help-echo + (format (propertize "URL: %s, %s to visit" 'face 'minibuffer-prompt) + (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'." |