blob: c1abf907d83bd138bcdb7f4a91e5cdf01a7a095a (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
;;; sx-button.el --- Defining buttons used throughout SX.
;; Copyright (C) 2014 Artur Malabarba
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'button)
(require 'sx)
(require 'sx-question)
;;; Command definitions
;; 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)
map)
"Keymap used on buttons.")
(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)))
(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-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)
(browse-url
(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)
"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
'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-button--question-title-help-echo
'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)
(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
;; Local Variables:
;; lexical-binding: t
;; End:
|
