1;; erc-button.el --- A way of buttonizing certain things in ERC buffers 2 3;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Mario Lang <mlang@delysid.org> 7;; Keywords: irc, button, url, regexp 8;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcButton 9 10;; This file is part of GNU Emacs. 11 12;; GNU Emacs is free software; you can redistribute it and/or modify 13;; it under the terms of the GNU General Public License as published by 14;; the Free Software Foundation; either version 2, or (at your option) 15;; any later version. 16 17;; GNU Emacs is distributed in the hope that it will be useful, 18;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20;; GNU General Public License for more details. 21 22;; You should have received a copy of the GNU General Public License 23;; along with GNU Emacs; see the file COPYING. If not, write to the 24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 25;; Boston, MA 02110-1301, USA. 26 27;;; Commentary: 28 29;; Heavily borrowed from gnus-art.el. Thanks to the original authors. 30;; This buttonizes nicks and other stuff to make it all clickable. 31;; To enable, add to your ~/.emacs: 32;; (require 'erc-button) 33;; (erc-button-mode 1) 34;; 35;; Todo: 36;; * Rewrite all this to do the same, but use button.el from GNU Emacs 37;; if it's available for xemacs too. Why? button.el is much faster, 38;; and much more elegant, and solves the problem we get with large buffers 39;; and a large erc-button-marker-list. 40 41 42;;; Code: 43 44(require 'erc) 45(require 'wid-edit) 46(require 'erc-fill) 47 48;;; Minor Mode 49 50(defgroup erc-button nil 51 "Define how text can be turned into clickable buttons." 52 :group 'erc) 53 54;;;###autoload (autoload 'erc-button-mode "erc-button" nil t) 55(define-erc-module button nil 56 "This mode buttonizes all messages according to `erc-button-alist'." 57 ((add-hook 'erc-insert-modify-hook 'erc-button-add-buttons 'append) 58 (add-hook 'erc-send-modify-hook 'erc-button-add-buttons 'append) 59 (add-hook 'erc-complete-functions 'erc-button-next) 60 (add-hook 'erc-mode-hook 'erc-button-add-keys)) 61 ((remove-hook 'erc-insert-modify-hook 'erc-button-add-buttons) 62 (remove-hook 'erc-send-modify-hook 'erc-button-add-buttons) 63 (remove-hook 'erc-complete-functions 'erc-button-next) 64 (remove-hook 'erc-mode-hook 'erc-button-add-keys))) 65 66;; Make XEmacs use `erc-button-face'. 67(when (featurep 'xemacs) 68 (add-hook 'erc-mode-hook 69 (lambda () (set (make-local-variable 'widget-button-face) nil)))) 70 71;;; Variables 72 73(defface erc-button '((t (:bold t))) 74 "ERC button face." 75 :group 'erc-faces) 76 77(defcustom erc-button-face 'erc-button 78 "Face used for highlighting buttons in ERC buffers. 79 80A button is a piece of text that you can activate by pressing 81`RET' or `mouse-2' above it. See also `erc-button-keymap'." 82 :type 'face 83 :group 'erc-faces) 84 85(defcustom erc-button-nickname-face 'erc-nick-default-face 86 "Face used for ERC nickname buttons." 87 :type 'face 88 :group 'erc-faces) 89 90(defcustom erc-button-mouse-face 'highlight 91 "Face used for mouse highlighting in ERC buffers. 92 93Buttons will be displayed in this face when the mouse cursor is 94above them." 95 :type 'face 96 :group 'erc-faces) 97 98(defcustom erc-button-url-regexp 99 (concat "\\(www\\.\\|\\(s?https?\\|" 100 "ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\)" 101 "\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?" 102 "[-a-zA-Z0-9_=!?#$@~`%&*+\\/:;.,]+[-a-zA-Z0-9_=#$@~`%&*+\\/]") 103 "Regular expression that matches URLs." 104 :group 'erc-button 105 :type 'regexp) 106 107(defcustom erc-button-wrap-long-urls nil 108 "If non-nil, \"long\" URLs matching `erc-button-url-regexp' will be wrapped. 109 110If this variable is a number, consider URLs longer than its value to 111be \"long\". If t, URLs will be considered \"long\" if they are 112longer than `erc-fill-column'." 113 :group 'erc-button 114 :type '(choice integer boolean)) 115 116(defcustom erc-button-buttonize-nicks t 117 "Flag indicating whether nicks should be buttonized or not." 118 :group 'erc-button 119 :type 'boolean) 120 121(defcustom erc-button-rfc-url "http://www.faqs.org/rfcs/rfc%s.html" 122 "*URL used to browse rfc references. 123%s is replaced by the number." 124 :group 'erc-button 125 :type 'string) 126 127(defcustom erc-button-google-url "http://www.google.com/search?q=%s" 128 "*URL used to browse Google search references. 129%s is replaced by the search string." 130 :group 'erc-button 131 :type 'string) 132 133(defcustom erc-button-alist 134 ;; Since the callback is only executed when the user is clicking on 135 ;; a button, it makes no sense to optimize performance by 136 ;; bytecompiling lambdas in this alist. On the other hand, it makes 137 ;; things hard to maintain. 138 '(('nicknames 0 erc-button-buttonize-nicks erc-nick-popup 0) 139 (erc-button-url-regexp 0 t browse-url 0) 140 ("<URL: *\\([^<> ]+\\) *>" 0 t browse-url 1) 141 ("(\\(\\([^~\n \t@][^\n \t@]*\\)@\\([a-zA-Z0-9.:-]+\\)\\)" 1 t finger 2 3) 142 ;; emacs internal 143 ("[`]\\([a-zA-Z][-a-zA-Z_0-9]+\\)[']" 1 t erc-button-describe-symbol 1) 144 ;; pseudo links 145 ("\\bInfo:[\"]\\([^\"]+\\)[\"]" 0 t Info-goto-node 1) 146 ("\\b\\(Ward\\|Wiki\\|WardsWiki\\|TheWiki\\):\\([A-Z][a-z]+\\([A-Z][a-z]+\\)+\\)" 147 0 t (lambda (page) 148 (browse-url (concat "http://c2.com/cgi-bin/wiki?" page))) 149 2) 150 ("EmacsWiki:\\([A-Z][a-z]+\\([A-Z][a-z]+\\)+\\)" 0 t erc-browse-emacswiki 1) 151 ("Lisp:\\([a-zA-Z.+-]+\\)" 0 t erc-browse-emacswiki-lisp 1) 152 ("\\bGoogle:\\([^ \t\n\r\f]+\\)" 153 0 t (lambda (keywords) 154 (browse-url (format erc-button-google-url keywords))) 155 1) 156 ("\\brfc[#: ]?\\([0-9]+\\)" 157 0 t (lambda (num) 158 (browse-url (format erc-button-rfc-url num))) 159 1) 160 ;; other 161 ("\\s-\\(@\\([0-9][0-9][0-9]\\)\\)" 1 t erc-button-beats-to-time 2)) 162 "*Alist of regexps matching buttons in ERC buffers. 163Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where 164 165REGEXP is the string matching text around the button or a symbol 166 indicating a variable holding that string, or a list of 167 strings, or an alist with the strings in the car. Note that 168 entries in lists or alists are considered to be nicks or other 169 complete words. Therefore they are enclosed in \\< and \\> 170 while searching. REGEXP can also be the quoted symbol 171 'nicknames, which matches the nickname of any user on the 172 current server. 173 174BUTTON is the number of the regexp grouping actually matching the 175 button, This is ignored if REGEXP is 'nicknames. 176 177FORM is a lisp expression which must eval to true for the button to 178 be added, 179 180CALLBACK is the function to call when the user push this button. 181 CALLBACK can also be a symbol. Its variable value will be used 182 as the callback function. 183 184PAR is a number of a regexp grouping whose text will be passed to 185 CALLBACK. There can be several PAR arguments. If REGEXP is 186 'nicknames, these are ignored, and CALLBACK will be called with 187 the nickname matched as the argument." 188 :group 'erc-button 189 :type '(repeat 190 (list :tag "Button" 191 (choice :tag "Matches" 192 regexp 193 (variable :tag "Variable containing regexp") 194 (const :tag "Nicknames" 'nicknames)) 195 (integer :tag "Number of the regexp section that matches") 196 (choice :tag "When to buttonize" 197 (const :tag "Always" t) 198 (sexp :tag "Only when this evaluates to non-nil")) 199 (function :tag "Function to call when button is pressed") 200 (repeat :tag "Sections of regexp to send to the function" 201 :inline t 202 (integer :tag "Regexp section number"))))) 203 204(defcustom erc-emacswiki-url "http://www.emacswiki.org/cgi-bin/wiki.pl?" 205 "*URL of the EmacsWiki Homepage." 206 :group 'erc-button 207 :type 'string) 208 209(defcustom erc-emacswiki-lisp-url "http://www.emacswiki.org/elisp/" 210 "*URL of the EmacsWiki ELisp area." 211 :group 'erc-button 212 :type 'string) 213 214(defvar erc-button-keymap 215 (let ((map (make-sparse-keymap))) 216 (define-key map (kbd "RET") 'erc-button-press-button) 217 (if (featurep 'xemacs) 218 (define-key map (kbd "<button2>") 'erc-button-click-button) 219 (define-key map (kbd "<mouse-2>") 'erc-button-click-button)) 220 (define-key map (kbd "TAB") 'erc-button-next) 221 (define-key map (kbd "<backtab>") 'erc-button-previous) 222 (set-keymap-parent map erc-mode-map) 223 map) 224 "Local keymap for ERC buttons.") 225 226(defvar erc-button-syntax-table 227 (let ((table (make-syntax-table))) 228 (modify-syntax-entry ?\( "w" table) 229 (modify-syntax-entry ?\) "w" table) 230 (modify-syntax-entry ?\[ "w" table) 231 (modify-syntax-entry ?\] "w" table) 232 (modify-syntax-entry ?\{ "w" table) 233 (modify-syntax-entry ?\} "w" table) 234 (modify-syntax-entry ?` "w" table) 235 (modify-syntax-entry ?' "w" table) 236 (modify-syntax-entry ?^ "w" table) 237 (modify-syntax-entry ?- "w" table) 238 (modify-syntax-entry ?_ "w" table) 239 (modify-syntax-entry ?| "w" table) 240 (modify-syntax-entry ?\\ "w" table) 241 table) 242 "Syntax table used when buttonizing messages. 243This syntax table should make all the legal nick characters word 244constituents.") 245 246(defvar erc-button-keys-added nil 247 "Internal variable used to keep track of whether we've added the 248global-level ERC button keys yet.") 249 250(defun erc-button-add-keys () 251 "Add ERC mode-level button movement keys. This is only done once." 252 (unless erc-button-keys-added 253 (define-key erc-mode-map (kbd "<backtab>") 'erc-button-previous) 254 (setq erc-button-keys-added t))) 255 256(defun erc-button-add-buttons () 257 "Find external references in the current buffer and make buttons of them. 258\"External references\" are things like URLs, as 259specified by `erc-button-alist'." 260 (interactive) 261 (save-excursion 262 (with-syntax-table erc-button-syntax-table 263 (let ((buffer-read-only nil) 264 (inhibit-point-motion-hooks t) 265 (inhibit-field-text-motion t) 266 (alist erc-button-alist) 267 entry regexp data) 268 (erc-button-remove-old-buttons) 269 (dolist (entry alist) 270 (if (equal (car entry) (quote (quote nicknames))) 271 (erc-button-add-nickname-buttons entry) 272 (progn 273 (setq regexp (or (and (stringp (car entry)) (car entry)) 274 (and (boundp (car entry)) 275 (symbol-value (car entry))))) 276 (cond ((stringp regexp) 277 (erc-button-add-buttons-1 regexp entry)) 278 ((and (listp regexp) (stringp (car regexp))) 279 (dolist (r regexp) 280 (erc-button-add-buttons-1 281 (concat "\\<" (regexp-quote r) "\\>") 282 entry))) 283 ((and (listp regexp) (listp (car regexp)) 284 (stringp (caar regexp))) 285 (dolist (elem regexp) 286 (erc-button-add-buttons-1 287 (concat "\\<" (regexp-quote (car elem)) "\\>") 288 entry))))))))))) 289 290(defun erc-button-add-nickname-buttons (entry) 291 "Search through the buffer for nicknames, and add buttons." 292 (let ((form (nth 2 entry)) 293 (fun (nth 3 entry)) 294 bounds word) 295 (when (or (eq t form) 296 (eval form)) 297 (goto-char (point-min)) 298 (while (forward-word 1) 299 (setq bounds (bounds-of-thing-at-point 'word)) 300 (setq word (buffer-substring-no-properties 301 (car bounds) (cdr bounds))) 302 (if (erc-get-server-user word) 303 (erc-button-add-button (car bounds) (cdr bounds) 304 fun t (list word))))))) 305 306(defun erc-button-add-buttons-1 (regexp entry) 307 "Search through the buffer for matches to ENTRY and add buttons." 308 (goto-char (point-min)) 309 (while (re-search-forward regexp nil t) 310 (let ((start (match-beginning (nth 1 entry))) 311 (end (match-end (nth 1 entry))) 312 (form (nth 2 entry)) 313 (fun (nth 3 entry)) 314 (data (mapcar 'match-string (nthcdr 4 entry)))) 315 (when (or (eq t form) 316 (eval form)) 317 (erc-button-add-button start end fun nil data regexp))))) 318 319(defun erc-button-remove-old-buttons () 320 "Remove all existing buttons. 321This is called with narrowing in effect, just before the text is 322buttonized again. Removing a button means to remove all the properties 323that `erc-button-add-button' adds, except for the face." 324 (remove-text-properties 325 (point-min) (point-max) 326 '(erc-callback nil 327 erc-data nil 328 mouse-face nil 329 keymap nil))) 330 331(defun erc-button-add-button (from to fun nick-p &optional data regexp) 332 "Create a button between FROM and TO with callback FUN and data DATA. 333NICK-P specifies if this is a nickname button. 334REGEXP is the regular expression which matched for this button." 335 ;; Really nasty hack to <URL: > ise urls, and line-wrap them if 336 ;; they're going to be wider than `erc-fill-column'. 337 ;; This could be a lot cleaner, but it works for me -- lawrence. 338 (let (fill-column) 339 (when (and erc-button-wrap-long-urls 340 (string= regexp erc-button-url-regexp) 341 (> (- to from) 342 (setq fill-column (- (if (numberp erc-button-wrap-long-urls) 343 erc-button-wrap-long-urls 344 erc-fill-column) 345 (length erc-fill-prefix))))) 346 (setq to (prog1 (point-marker) (insert ">")) 347 from (prog2 (goto-char from) (point-marker) (insert "<URL: "))) 348 (let ((pos (copy-marker from))) 349 (while (> (- to pos) fill-column) 350 (goto-char (+ pos fill-column)) 351 (insert "\n" erc-fill-prefix) ; This ought to figure out 352 ; what type of filling we're 353 ; doing, and indent accordingly. 354 (move-marker pos (point)))))) 355 (if nick-p 356 (when erc-button-nickname-face 357 (erc-button-add-face from to erc-button-nickname-face)) 358 (when erc-button-face 359 (erc-button-add-face from to erc-button-face))) 360 (add-text-properties 361 from to 362 (nconc (and erc-button-mouse-face 363 (list 'mouse-face erc-button-mouse-face)) 364 (list 'erc-callback fun) 365 (list 'keymap erc-button-keymap) 366 (list 'rear-nonsticky t) 367 (and data (list 'erc-data data)))) 368 (widget-convert-button 'link from to :action 'erc-button-press-button 369 :suppress-face t 370 ;; Make XEmacs use our faces. 371 :button-face (if nick-p 372 erc-button-nickname-face 373 erc-button-face) 374 ;; Make XEmacs behave with mouse-clicks, for 375 ;; some reason, widget stuff overrides the 376 ;; 'keymap text-property. 377 :mouse-down-action 'erc-button-click-button)) 378 379(defun erc-button-add-face (from to face) 380 "Add FACE to the region between FROM and TO." 381 ;; If we just use `add-text-property', then this will overwrite any 382 ;; face text property already used for the button. It will not be 383 ;; merged correctly. If we use overlays, then redisplay will be 384 ;; very slow with lots of buttons. This is why we manually merge 385 ;; face text properties. 386 (let ((old (erc-list (get-text-property from 'face))) 387 (pos from) 388 (end (next-single-property-change from 'face nil to)) 389 new) 390 ;; old is the face at pos, in list form. It is nil if there is no 391 ;; face at pos. If nil, the new face is FACE. If not nil, the 392 ;; new face is a list containing FACE and the old stuff. end is 393 ;; where this face changes. 394 (while (< pos to) 395 (setq new (if old (cons face old) face)) 396 (put-text-property pos end 'face new) 397 (setq pos end 398 old (erc-list (get-text-property pos 'face)) 399 end (next-single-property-change pos 'face nil to))))) 400 401;; widget-button-click calls with two args, we ignore the first. 402;; Since Emacs runs this directly, rather than with 403;; widget-button-click, we need to fake an extra arg in the 404;; interactive spec. 405(defun erc-button-click-button (ignore event) 406 "Call `erc-button-press-button'." 407 (interactive "P\ne") 408 (save-excursion 409 (mouse-set-point event) 410 (erc-button-press-button))) 411 412;; XEmacs calls this via widget-button-press with a bunch of arguments 413;; which we don't care about. 414(defun erc-button-press-button (&rest ignore) 415 "Check text at point for a callback function. 416If the text at point has a `erc-callback' property, 417call it with the value of the `erc-data' text property." 418 (interactive) 419 (let* ((data (get-text-property (point) 'erc-data)) 420 (fun (get-text-property (point) 'erc-callback))) 421 (unless fun 422 (message "No button at point")) 423 (when (and fun (symbolp fun) (not (fboundp fun))) 424 (error "Function %S is not bound" fun)) 425 (apply fun data))) 426 427(defun erc-button-next () 428 "Go to the next button in this buffer." 429 (interactive) 430 (let ((here (point))) 431 (when (< here (erc-beg-of-input-line)) 432 (while (and (get-text-property here 'erc-callback) 433 (not (= here (point-max)))) 434 (setq here (1+ here))) 435 (while (and (not (get-text-property here 'erc-callback)) 436 (not (= here (point-max)))) 437 (setq here (1+ here))) 438 (if (< here (point-max)) 439 (goto-char here) 440 (error "No next button")) 441 t))) 442 443(defun erc-button-previous () 444 "Go to the previous button in this buffer." 445 (interactive) 446 (let ((here (point))) 447 (when (< here (erc-beg-of-input-line)) 448 (while (and (get-text-property here 'erc-callback) 449 (not (= here (point-min)))) 450 (setq here (1- here))) 451 (while (and (not (get-text-property here 'erc-callback)) 452 (not (= here (point-min)))) 453 (setq here (1- here))) 454 (if (> here (point-min)) 455 (goto-char here) 456 (error "No previous button")) 457 t))) 458 459(defun erc-browse-emacswiki (thing) 460 "Browse to thing in the emacs-wiki." 461 (browse-url (concat erc-emacswiki-url thing))) 462 463(defun erc-browse-emacswiki-lisp (thing) 464 "Browse to THING in the emacs-wiki elisp area." 465 (browse-url (concat erc-emacswiki-lisp-url thing))) 466 467;;; Nickname buttons: 468 469(defcustom erc-nick-popup-alist 470 '(("DeOp" . (erc-cmd-DEOP nick)) 471 ("Kick" . (erc-cmd-KICK (concat nick " " 472 (read-from-minibuffer 473 (concat "Kick " nick ", reason: "))))) 474 ("Msg" . (erc-cmd-MSG (concat nick " " 475 (read-from-minibuffer 476 (concat "Message to " nick ": "))))) 477 ("Op" . (erc-cmd-OP nick)) 478 ("Query" . (erc-cmd-QUERY nick)) 479 ("Whois" . (erc-cmd-WHOIS nick)) 480 ("Lastlog" . (erc-cmd-LASTLOG nick))) 481 "*An alist of possible actions to take on a nickname. 482An entry looks like (\"Action\" . SEXP) where SEXP is evaluated with 483the variable `nick' bound to the nick in question. 484 485Examples: 486 (\"DebianDB\" . 487 (shell-command 488 (format 489 \"ldapsearch -x -P 2 -h db.debian.org -b dc=debian,dc=org ircnick=%s\" 490 nick)))" 491 :group 'erc-button 492 :type '(repeat (cons (string :tag "Op") 493 sexp))) 494 495(defun erc-nick-popup (nick) 496 (let* ((completion-ignore-case t) 497 (action (completing-read (concat "What action to take on '" nick "'? ") 498 erc-nick-popup-alist)) 499 (code (cdr (assoc action erc-nick-popup-alist)))) 500 (when code 501 (erc-set-active-buffer (current-buffer)) 502 (eval code)))) 503 504;;; Callback functions 505(defun erc-button-describe-symbol (symbol-name) 506 "Describe SYMBOL-NAME. 507Use `describe-function' for functions, `describe-variable' for variables, 508and `apropos' for other symbols." 509 (let ((symbol (intern-soft symbol-name))) 510 (cond ((and symbol (fboundp symbol)) 511 (describe-function symbol)) 512 ((and symbol (boundp symbol)) 513 (describe-variable symbol)) 514 (t (apropos symbol-name))))) 515 516(defun erc-button-beats-to-time (beats) 517 "Display BEATS in a readable time format." 518 (let* ((seconds (- (* (string-to-number beats) 86.4) 519 3600 520 (- (car (current-time-zone))))) 521 (hours (mod (floor seconds 3600) 24)) 522 (minutes (mod (round seconds 60) 60))) 523 (message (format "@%s is %d:%02d local time" 524 beats hours minutes)))) 525 526(provide 'erc-button) 527 528;;; erc-button.el ends here 529;; Local Variables: 530;; indent-tabs-mode: nil 531;; End: 532 533;; arch-tag: 7d23bed4-2f30-4273-a03f-d7a274c605c4 534