Move buttons to sx-button.el

Also define command to copy button's content under w.

2 files changed, 81 insertions, 23 deletions

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 <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
+(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))
 
@@ -164,18 +164,6 @@ replaced with the comment."
   :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
 (defvar sx-question-mode--section-help-echo
@@ -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)))))