349 lines
14 KiB
EmacsLisp
349 lines
14 KiB
EmacsLisp
;;; weechat-button --- Add buttons to text ;; -*- lexical-binding: t -*-
|
|
|
|
;; Copyright (C) 2013 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
|
|
|
|
;; Author: Rüdiger Sonderfeld <ruediger@c-plusplus.de>
|
|
;; Moritz Ulrich <moritz@tarn-vedra.de>
|
|
;; Aristid Breitkreuz <aristidb@gmail.com>
|
|
;; Keywords: irc chat network weechat
|
|
;; URL: https://github.com/the-kenny/weechat.el
|
|
|
|
;; 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 code is heavily inspired by erc-button.el!
|
|
|
|
;;; Code:
|
|
;;
|
|
|
|
(require 'weechat)
|
|
(require 'button)
|
|
(require 's)
|
|
|
|
;;; Customize
|
|
|
|
(defgroup weechat-button nil
|
|
"WeeChat button interface (URLification)."
|
|
:link '(url-link "https://github.com/the-kenny/weechat.el")
|
|
:prefix "weechat-button"
|
|
:group 'weechat)
|
|
|
|
(defcustom weechat-button-url-regexp
|
|
(concat "\\(www\\.\\|\\(s?https?\\|"
|
|
"ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\)"
|
|
"\\(//[-[:alnum:]_.]+:[0-9]*\\)?"
|
|
"[-[:alnum:]_=!?#$@~`%&*+\\/:;.,()]+[-[:alnum:]_=#$@~`%&*+\\/()]")
|
|
"Regexp to match URLs.
|
|
Copied from erc-button.el."
|
|
:type 'regexp
|
|
:group 'weechat-button)
|
|
|
|
(defcustom weechat-button-default-log-buffer "*WeeChat URL Log*"
|
|
"Buffer name for URL log.
|
|
Valid values include a string describing a buffer name or nil to
|
|
disable url logging (except when an explicit buffer name is
|
|
defined in `weechat-button-list')"
|
|
:group 'weechat-button
|
|
:type '(choice (const :tag "No Log" nil)
|
|
(string :tag "Buffer Name")))
|
|
|
|
(defcustom weechat-button-buttonize-url t
|
|
"Buttonize url links?"
|
|
:group 'weechat-button
|
|
:type '(choice (const :tag "Never" nil)
|
|
(const :tag "Always" t)
|
|
(repeat :tag "If regular expression matches buffer name" regexp)))
|
|
|
|
(defcustom weechat-button-buttonize-channels t
|
|
"Buttonize channel links?"
|
|
:group 'weechat-button
|
|
:type '(choice (const :tag "Never" nil)
|
|
(const :tag "Always" t)
|
|
(repeat :tag "If regular expression matches buffer name" regexp)))
|
|
|
|
(defcustom weechat-button-buttonize-symbols t
|
|
"Buttonize symbol links?"
|
|
:group 'weechat-button
|
|
:type '(choice (const :tag "Never" nil)
|
|
(const :tag "Always" t)
|
|
(repeat :tag "If regular expression matches buffer name" regexp)))
|
|
|
|
(defcustom weechat-button-buttonize-emails nil
|
|
"Buttonize e-mail link?"
|
|
:group 'weechat-button
|
|
:type '(choice (const :tag "Never" nil)
|
|
(const :tag "Always" t)
|
|
(repeat :tag "If regular expression matches buffer name" regexp)))
|
|
|
|
(defcustom weechat-button-buttonize-man nil
|
|
"Buttonize manpage links?
|
|
Format is man(1)."
|
|
:group 'weechat-button
|
|
:type 'boolen)
|
|
|
|
(defcustom weechat-button-buttonize-info '("#emacs" "#weechat\\.el")
|
|
"Buttonize info links?
|
|
Format is (info \"link\")."
|
|
:group 'weechat-button
|
|
:type '(choice (const :tag "Never" nil)
|
|
(const :tag "Always" t)
|
|
(repeat :tag "If regular expression matches buffer name" regexp)))
|
|
|
|
(defcustom weechat-button-rfc-url "http://www.faqs.org/rfcs/rfc%s.html"
|
|
"URL used to browse rfc references.
|
|
%s is replaced by the number."
|
|
:group 'weechat-button
|
|
:type 'string)
|
|
|
|
(defcustom weechat-button-buttonize-rfc nil
|
|
"Buttonize rfc links?"
|
|
:group 'weechat-button
|
|
:type '(choice (const :tag "Never" nil)
|
|
(const :tag "Always" t)
|
|
(repeat :tag "If regular expression matches buffer name" regexp)))
|
|
|
|
; temporarily disabled due to performance problems
|
|
(defcustom weechat-button-buttonize-nicks nil
|
|
"Buttonize nicknames?"
|
|
:group 'weechat-button
|
|
:type '(choice (const :tag "Never" nil)
|
|
(const :tag "Always" t)
|
|
(repeat :tag "If regular expression matches buffer name" regexp)))
|
|
|
|
(defcustom weechat-button-list
|
|
'((weechat-button-url-regexp 0 weechat-button-buttonize-url t "Browse URL"
|
|
browse-url 0)
|
|
("#[-#+_.[:alnum:]]+" 0 weechat-button-buttonize-channels nil "Join Channel"
|
|
weechat-join 0)
|
|
("\\b[A-Z0-9._%+-]+@[A-Z0-9.-]+\\.[A-Z]\\{2,4\\}\\b" 0 weechat-button-buttonize-emails nil
|
|
"email" weechat-button--mailto 0)
|
|
("[`]\\([-_.[:alnum:]]+\\)[']" 1 weechat-button-buttonize-symbols nil "Describe Symbol"
|
|
weechat-button--describe-symbol 1)
|
|
("[[:alpha:][:alnum:]]+([1-9])" 0 weechat-button-buttonize-man nil "Manpage" man 0)
|
|
("(info \"\\(([[:alnum:]]+) .+?\\)\"" 1 weechat-button-buttonize-info nil "info"
|
|
info 1)
|
|
("\\brfc[#: ]?\\([0-9]+\\)" 0 weechat-button-buttonize-rfc nil "RFC"
|
|
weechat-button--rfc 1))
|
|
"List of potential buttons in WeeChat chat buffers.
|
|
Each entry has the form (REGEXP BUTTON-MATCH BUTTONIZE? LOG HELP-ECHO ACTION
|
|
DATA-MATCH...), where
|
|
|
|
REGEXP is a string or variable containing a regular expression to match buttons.
|
|
|
|
BUTTON-MATCH is the number of the regexp grouping which represents the actual
|
|
button.
|
|
|
|
BUTTONIZE? determines if button should be buttonized.
|
|
See `weechat-button--buttonize?' for exact usage.
|
|
|
|
LOG decides if `weechat-button-log-functions' gets called.
|
|
|
|
HELP-ECHO is the `help-echo' property of the button.
|
|
See Info node `(elisp) Button Properties'.
|
|
|
|
ACTION the function to call when the button is selected.
|
|
|
|
DATA-MATCH... numbers of the regexp groupings whose text will be passed to
|
|
ACTION.
|
|
|
|
This is similar (but not identical) to `erc-button-alist' in ERC."
|
|
:group 'weechat-button
|
|
:type '(repeat :tag "Buttons"
|
|
(list (choice :tag "Matches"
|
|
regexp
|
|
(variable :tag "Variable containing regexp"))
|
|
(integer :tag "Number of the regexp section that matches")
|
|
(choice :tag "When to buttonize"
|
|
(const :tag "Always" t)
|
|
(const :tag "Never" nil)
|
|
(repeat :tag "If regular expression matches buffer name"
|
|
regexp)
|
|
(symbol :tag "Variable name"))
|
|
(choice :tag "Log match"
|
|
(const :tag "To default buffer" t)
|
|
(const :tag "Never" nil)
|
|
(string :tag "To buffer name"))
|
|
(string :tag "Help echo text")
|
|
(function :tag "Call this function when button is pressed")
|
|
(repeat :tag "Sections of regexp to send to the function"
|
|
:inline t
|
|
(integer :tag "Regexp section number")))))
|
|
(put 'weechat-button-list 'risky-local-variable t)
|
|
|
|
(defvar weechat-button-log-functions nil
|
|
"List of function to run when a button should be logged.
|
|
|
|
This hook only runs when `LOG' is set to t for the particular
|
|
button type.
|
|
|
|
Functions in list must have two arguments: The button data (the
|
|
match string) and a plist describing the button properties.
|
|
|
|
The functions in this list will be called with
|
|
`weechat-narrow-to-line' active.")
|
|
|
|
;;; Internal functions
|
|
|
|
(defun weechat-button--handler (button)
|
|
"Handle BUTTON actions.
|
|
The function in property `weechat-function' gets called with `weechat-data'."
|
|
(let ((function (button-get button 'weechat-function))
|
|
(data (button-get button 'weechat-data)))
|
|
(when function
|
|
(apply function data))))
|
|
|
|
(defun weechat-button--log-to-buffer (button-data button-properties)
|
|
(when (and weechat-button-default-log-buffer)
|
|
(let ((weechat-buffer-name (buffer-name)))
|
|
(with-current-buffer (get-buffer-create
|
|
weechat-button-default-log-buffer)
|
|
(goto-char (point-max))
|
|
(unless (bolp)
|
|
(insert "\n"))
|
|
(insert weechat-buffer-name "\t")
|
|
(apply #'insert-button button-data button-properties)
|
|
(insert "\n")))))
|
|
|
|
(add-hook 'weechat-button-log-functions 'weechat-button--log-to-buffer)
|
|
|
|
(defun weechat-button--buttonize? (buttonize?)
|
|
"Return non-nil if BUTTONIZE? says so.
|
|
Return non-nil if BUTTONIZE?:
|
|
- is t,
|
|
- is a list of strings and one of the strings matches the channel name,
|
|
- is a variable then apply the rules to the value of the variable."
|
|
(when (and (symbolp buttonize?) (boundp buttonize?))
|
|
(setq buttonize? (symbol-value buttonize?)))
|
|
(cond
|
|
((listp buttonize?)
|
|
(let ((name (buffer-name)) ret)
|
|
(dolist (i buttonize? ret)
|
|
(when (s-matches? i name)
|
|
(setq ret t)))))
|
|
(t t)))
|
|
|
|
(defvar weechat-button-log-buffer-last-log nil)
|
|
(defun weechat-button--add-do (entry &optional text-buttons)
|
|
"Handle each button ENTRY.
|
|
If TEXT-BUTTONS is non-nil then use `make-text-button instead of `make-button'."
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(cl-destructuring-bind
|
|
(regexp-entry button-match buttonize?
|
|
log help-echo action &rest data-match) entry
|
|
(let* ((regexp (or (and (stringp regexp-entry) regexp-entry)
|
|
(and (boundp regexp-entry) (symbol-value regexp-entry))))
|
|
(line-date (weechat-line-date))
|
|
(run-hooks?
|
|
(and line-date
|
|
(or (null weechat-button-log-buffer-last-log)
|
|
(time-less-p weechat-button-log-buffer-last-log
|
|
line-date))))
|
|
(button-fn (if text-buttons
|
|
#'make-text-button
|
|
#'make-button)))
|
|
(when regexp
|
|
(while (re-search-forward regexp nil t)
|
|
(let ((start (match-beginning button-match))
|
|
(end (match-end button-match))
|
|
(button-data-no-properties
|
|
(match-string-no-properties button-match))
|
|
(data (mapcar #'match-string data-match)))
|
|
(when (and (weechat-button--buttonize? buttonize?)
|
|
;; Don't overlap buttons
|
|
;; Handles text-buttons and overlay-buttons
|
|
(cl-every (lambda (o)
|
|
(null (overlay-get o 'button)))
|
|
(overlays-in start end))
|
|
(not (text-property-not-all start end 'button nil)))
|
|
(let ((properties (list 'action #'weechat-button--handler
|
|
'help-echo help-echo
|
|
'follow-link t
|
|
'weechat-function action
|
|
'weechat-data data)))
|
|
(when (and log
|
|
run-hooks?)
|
|
;; Hack: Rebind `weechat-button-default-log-buffer'
|
|
;; to the value supplied by the button type in
|
|
;; `weechat-button-list'
|
|
(let ((weechat-button-default-log-buffer
|
|
(if (or (stringp log) (bufferp log))
|
|
log
|
|
weechat-button-default-log-buffer)))
|
|
(run-hook-with-args 'weechat-button-log-functions
|
|
button-data-no-properties
|
|
properties))
|
|
(setq weechat-button-log-buffer-last-log line-date))
|
|
(apply button-fn start end properties))))))))))
|
|
|
|
(defun weechat-button--add ()
|
|
"Add text buttons to text in buffer."
|
|
(dolist (i weechat-button-list)
|
|
(weechat-button--add-do i))
|
|
(when weechat-button-buttonize-nicks
|
|
(weechat-button--add-nickname-buttons)))
|
|
|
|
(defvar weechat-user-list) ;; See weechat.el
|
|
|
|
(defun weechat-button--add-nickname-buttons ()
|
|
"Add nick name buttons."
|
|
(dolist (nick weechat-user-list)
|
|
(unless (s-blank? nick)
|
|
(weechat-button--add-do (list (concat "\\b" (regexp-quote nick) "\\b")
|
|
0 t 0 "Nick Action"
|
|
#'weechat-nick-action
|
|
0)
|
|
'text-button))))
|
|
|
|
;;; Callback functions
|
|
|
|
;; This function is copied from `erc-button-describe-symbol'
|
|
(defun weechat-button--describe-symbol (symbol-name)
|
|
"Describe SYMBOL-NAME.
|
|
Use `describe-function' for functions, `describe-variable' for variables,
|
|
and `apropos' for other symbols."
|
|
(let ((symbol (intern-soft symbol-name)))
|
|
(cond ((and symbol (fboundp symbol))
|
|
(describe-function symbol))
|
|
((and symbol (boundp symbol))
|
|
(describe-variable symbol))
|
|
(t (apropos symbol-name)))))
|
|
|
|
(defun weechat-button--mailto (email)
|
|
"Call `browse-url' on email with \"mailto:\" prepend."
|
|
(browse-url (concat "mailto:" email)))
|
|
|
|
(defun weechat-button--rfc (rfc)
|
|
"Call `browse-url' on RFC using `weechat-button-rfc-url'."
|
|
(browse-url (format weechat-button-rfc-url rfc)))
|
|
|
|
;;; Module load/unload
|
|
|
|
;;; This is done automatically by `load-library' or `require'.
|
|
;;; Unloading is taken care of, because hooks added via `add-hook'
|
|
;;; will be removed automatically by `unload-feature'.
|
|
|
|
;;; If you need special cleanup code, use define a function named
|
|
;;; `FEATURE-unload-function'. This function will be called by emacs
|
|
;;; right before unloading the feature. Check the docstring of
|
|
;;; `unload-feature' for details.
|
|
|
|
(add-hook 'weechat-insert-modify-hook #'weechat-button--add)
|
|
|
|
(provide 'weechat-button)
|
|
|
|
;;; weechat-button.el ends here
|