216 lines
7.1 KiB
EmacsLisp
216 lines
7.1 KiB
EmacsLisp
|
;;; sx-button.el --- defining buttons -*- lexical-binding: t; -*-
|
|||
|
|
|
|||
|
|
;; 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:
|
|||
|
|
;;
|
|||
|
|
;; This file defines all buttons used by SX. For information on
|
|||
|
|
;; buttons, see:
|
|||
|
|
;; http://www.gnu.org/software/emacs/manual/html_node/elisp/Buttons.html
|
|||
|
|
;;
|
|||
|
|
;; Most interactive parts of the SX buffers are buttons. Wherever you
|
|||
|
|
;; are, you can always cycle through all buttons by hitting `TAB',
|
|||
|
|
;; that should help identify what's a button in each buffer.
|
|||
|
|
;;
|
|||
|
|
;; To define a new type of button follow the examples below using
|
|||
|
|
;; `define-button-type' with :supertype `sx-button'. Required
|
|||
|
|
;; properties are `action' and `help-echo'. You'll probably want to
|
|||
|
|
;; give it a `face' as well, unless you want it to look like a link.
|
|||
|
|
;;
|
|||
|
|
;; Buttons can then be inserted in their respective files using
|
|||
|
|
;; `insert-text-button'. Give it the string, the `:type' you defined,
|
|||
|
|
;; and any additional properties that can only be determined at
|
|||
|
|
;; creation. Existing text can be transformed into a button with
|
|||
|
|
;; `make-text-button' instead.
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Code:
|
|||
|
|
(require 'button)
|
|||
|
|
|
|||
|
|
(require 'sx)
|
|||
|
|
(require 'sx-question)
|
|||
|
|
|
|||
|
|
(declare-function sx-accept "sx-interaction")
|
|||
|
|
(declare-function sx-answer "sx-interaction")
|
|||
|
|
(declare-function sx-comment "sx-interaction")
|
|||
|
|
(declare-function sx-open-link "sx-interaction")
|
|||
|
|
(declare-function sx-question-mode-hide-show-section "sx-question-mode")
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Face
|
|||
|
|
(defface sx-custom-button
|
|||
|
|
'((((type x w32 ns) (class color)) ; Like default mode line
|
|||
|
|
:box (:line-width 3 :style released-button)
|
|||
|
|
:height 0.9
|
|||
|
|
:background "lightgrey" :foreground "black"))
|
|||
|
|
"Face used on buttons such as \"Write an Answer\"."
|
|||
|
|
:group 'sx)
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; 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 &optional majormode)
|
|||
|
|
"Open a temp buffer populated with the string TEXT-OR-MARKER using MAJORMODE.
|
|||
|
|
When given a marker (or interactively), use the 'sx-button-copy
|
|||
|
|
and the 'sx-mode text-properties under the marker. These are
|
|||
|
|
usually part of a code-block."
|
|||
|
|
(interactive (list (point-marker)))
|
|||
|
|
;; Buttons receive markers.
|
|||
|
|
(when (markerp text-or-marker)
|
|||
|
|
(setq majormode (get-text-property text-or-marker 'sx-mode))
|
|||
|
|
(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)
|
|||
|
|
(when majormode
|
|||
|
|
(funcall majormode))))
|
|||
|
|
|
|||
|
|
(defun sx-button-follow-link (&optional pos)
|
|||
|
|
"Follow link at POS. If POS is nil, use `point'."
|
|||
|
|
(interactive)
|
|||
|
|
(let ((url (or (get-text-property (or pos (point)) 'sx-button-url)
|
|||
|
|
(sx-user-error "No url under point: %s" (or pos (point))))))
|
|||
|
|
;; If we didn't recognize the link, this errors immediately. If
|
|||
|
|
;; we mistakenly recognize it, it will error when we try to fetch
|
|||
|
|
;; whatever we thought it was.
|
|||
|
|
(condition-case nil (sx-open-link url)
|
|||
|
|
;; When it errors, don't blame the user, just visit externally.
|
|||
|
|
(error (browse-url url)))))
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Help-echo definitions
|
|||
|
|
(defconst 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.")
|
|||
|
|
|
|||
|
|
(defconst sx-button--user-help-echo
|
|||
|
|
(format sx-button--help-echo
|
|||
|
|
"visit user page"
|
|||
|
|
"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"
|
|||
|
|
"link")
|
|||
|
|
"Help echoed in the minibuffer when point is on a section.")
|
|||
|
|
|
|||
|
|
(defconst sx-button--link-help-echo
|
|||
|
|
(format sx-button--help-echo
|
|||
|
|
"visit %s"
|
|||
|
|
"URL")
|
|||
|
|
"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-user
|
|||
|
|
'action #'sx-button-follow-link
|
|||
|
|
'help-echo sx-button--user-help-echo
|
|||
|
|
;; We use different faces on different parts of the user button.
|
|||
|
|
'face 'sx-user-name
|
|||
|
|
:supertype 'sx-button)
|
|||
|
|
|
|||
|
|
(declare-function sx-search-tag-at-point "sx-search")
|
|||
|
|
(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"
|
|||
|
|
'face 'minibuffer-prompt))
|
|||
|
|
'face 'sx-custom-button
|
|||
|
|
'action #'sx-comment
|
|||
|
|
:supertype 'sx-button)
|
|||
|
|
|
|||
|
|
(define-button-type 'sx-button-accept
|
|||
|
|
'help-echo (concat "mouse-1, RET"
|
|||
|
|
(propertize ": accept answer"
|
|||
|
|
'face 'minibuffer-prompt))
|
|||
|
|
'face 'sx-custom-button
|
|||
|
|
'action #'sx-accept
|
|||
|
|
:supertype 'sx-button)
|
|||
|
|
|
|||
|
|
(define-button-type 'sx-button-answer
|
|||
|
|
'help-echo (concat "mouse-1, RET"
|
|||
|
|
(propertize ": write an answer"
|
|||
|
|
'face 'minibuffer-prompt))
|
|||
|
|
'face 'sx-custom-button
|
|||
|
|
'action #'sx-answer
|
|||
|
|
:supertype 'sx-button)
|
|||
|
|
|
|||
|
|
(provide 'sx-button)
|
|||
|
|
;;; sx-button.el ends here
|
|||
|
|
|
|||
|
|
;; Local Variables:
|
|||
|
|
;; indent-tabs-mode: nil
|
|||
|
|
;; End:
|