;;; weechat-button --- Add buttons to text ;; -*- lexical-binding: t -*- ;; Copyright (C) 2013 Rüdiger Sonderfeld ;; Author: Rüdiger Sonderfeld ;; Moritz Ulrich ;; Aristid Breitkreuz ;; 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 . ;;; 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