1 files changed, 129 insertions, 0 deletions
diff --git a/sx-button.el b/sx-button.el
new file mode 100644
index 0000000..c1abf90
--- /dev/null
+++ b/sx-button.el
@@ -0,0 +1,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: