| 1 | ;;; erc-match.el --- Highlight messages matching certain regexps |
| 2 | |
| 3 | ;; Copyright (C) 2002-2011 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Andreas Fuchs <asf@void.at> |
| 6 | ;; Keywords: comm, faces |
| 7 | ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcMatch |
| 8 | |
| 9 | ;; This file is part of GNU Emacs. |
| 10 | |
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
| 12 | ;; it under the terms of the GNU General Public License as published by |
| 13 | ;; the Free Software Foundation, either version 3 of the License, or |
| 14 | ;; (at your option) any later version. |
| 15 | |
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 19 | ;; GNU General Public License for more details. |
| 20 | |
| 21 | ;; You should have received a copy of the GNU General Public License |
| 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 23 | |
| 24 | ;;; Commentary: |
| 25 | |
| 26 | ;; This file includes stuff to work with pattern matching in ERC. If |
| 27 | ;; you were used to customizing erc-fools, erc-keywords, erc-pals, |
| 28 | ;; erc-dangerous-hosts and the like, this file contains these |
| 29 | ;; customizable variables. |
| 30 | |
| 31 | ;; Usage: |
| 32 | ;; Put (erc-match-mode 1) into your ~/.emacs file. |
| 33 | |
| 34 | ;;; Code: |
| 35 | |
| 36 | (require 'erc) |
| 37 | (eval-when-compile (require 'cl)) |
| 38 | |
| 39 | ;; Customisation: |
| 40 | |
| 41 | (defgroup erc-match nil |
| 42 | "Keyword and Friend/Foe/... recognition. |
| 43 | Group containing all things concerning pattern matching in ERC |
| 44 | messages." |
| 45 | :group 'erc) |
| 46 | |
| 47 | ;;;###autoload (autoload 'erc-match-mode "erc-match") |
| 48 | (define-erc-module match nil |
| 49 | "This mode checks whether messages match certain patterns. If so, |
| 50 | they are hidden or highlighted. This is controlled via the variables |
| 51 | `erc-pals', `erc-fools', `erc-keywords', `erc-dangerous-hosts', and |
| 52 | `erc-current-nick-highlight-type'. For all these highlighting types, |
| 53 | you can decide whether the entire message or only the sending nick is |
| 54 | highlighted." |
| 55 | ((add-hook 'erc-insert-modify-hook 'erc-match-message 'append)) |
| 56 | ((remove-hook 'erc-insert-modify-hook 'erc-match-message))) |
| 57 | |
| 58 | ;; Remaining customizations |
| 59 | |
| 60 | (defcustom erc-pals nil |
| 61 | "List of pals on IRC." |
| 62 | :group 'erc-match |
| 63 | :type '(repeat regexp)) |
| 64 | |
| 65 | (defcustom erc-fools nil |
| 66 | "List of fools on IRC." |
| 67 | :group 'erc-match |
| 68 | :type '(repeat regexp)) |
| 69 | |
| 70 | (defcustom erc-keywords nil |
| 71 | "List of keywords to highlight in all incoming messages. |
| 72 | Each entry in the list is either a regexp, or a cons cell with the |
| 73 | regexp in the car and the face to use in the cdr. If no face is |
| 74 | specified, `erc-keyword-face' is used." |
| 75 | :group 'erc-match |
| 76 | :type '(repeat (choice regexp |
| 77 | (list regexp face)))) |
| 78 | |
| 79 | (defcustom erc-dangerous-hosts nil |
| 80 | "List of regexps for hosts to highlight. |
| 81 | Useful to mark nicks from dangerous hosts." |
| 82 | :group 'erc-match |
| 83 | :type '(repeat regexp)) |
| 84 | |
| 85 | (defcustom erc-current-nick-highlight-type 'keyword |
| 86 | "*Determines how to highlight text in which your current nickname appears |
| 87 | \(does not apply to text sent by you\). |
| 88 | |
| 89 | The following values are allowed: |
| 90 | |
| 91 | nil - do not highlight the message at all |
| 92 | 'keyword - highlight all instances of current nickname in message |
| 93 | 'nick - highlight the nick of the user who typed your nickname |
| 94 | 'nick-or-keyword - highlight the nick of the user who typed your nickname, |
| 95 | or all instances of the current nickname if there was |
| 96 | no sending user |
| 97 | 'all - highlight the entire message where current nickname occurs |
| 98 | |
| 99 | Any other value disables highlighting of current nickname altogether." |
| 100 | :group 'erc-match |
| 101 | :type '(choice (const nil) |
| 102 | (const nick) |
| 103 | (const keyword) |
| 104 | (const nick-or-keyword) |
| 105 | (const all))) |
| 106 | |
| 107 | (defcustom erc-pal-highlight-type 'nick |
| 108 | "*Determines how to highlight messages by pals. |
| 109 | See `erc-pals'. |
| 110 | |
| 111 | The following values are allowed: |
| 112 | |
| 113 | nil - do not highlight the message at all |
| 114 | 'nick - highlight pal's nickname only |
| 115 | 'all - highlight the entire message from pal |
| 116 | |
| 117 | Any other value disables pal highlighting altogether." |
| 118 | :group 'erc-match |
| 119 | :type '(choice (const nil) |
| 120 | (const nick) |
| 121 | (const all))) |
| 122 | |
| 123 | (defcustom erc-fool-highlight-type 'nick |
| 124 | "*Determines how to highlight messages by fools. |
| 125 | See `erc-fools'. |
| 126 | |
| 127 | The following values are allowed: |
| 128 | |
| 129 | nil - do not highlight the message at all |
| 130 | 'nick - highlight fool's nickname only |
| 131 | 'all - highlight the entire message from fool |
| 132 | |
| 133 | Any other value disables fool highlighting altogether." |
| 134 | :group 'erc-match |
| 135 | :type '(choice (const nil) |
| 136 | (const nick) |
| 137 | (const all))) |
| 138 | |
| 139 | (defcustom erc-keyword-highlight-type 'keyword |
| 140 | "*Determines how to highlight messages containing keywords. |
| 141 | See variable `erc-keywords'. |
| 142 | |
| 143 | The following values are allowed: |
| 144 | |
| 145 | 'keyword - highlight keyword only |
| 146 | 'all - highlight the entire message containing keyword |
| 147 | |
| 148 | Any other value disables keyword highlighting altogether." |
| 149 | :group 'erc-match |
| 150 | :type '(choice (const nil) |
| 151 | (const keyword) |
| 152 | (const all))) |
| 153 | |
| 154 | (defcustom erc-dangerous-host-highlight-type 'nick |
| 155 | "*Determines how to highlight messages by nicks from dangerous-hosts. |
| 156 | See `erc-dangerous-hosts'. |
| 157 | |
| 158 | The following values are allowed: |
| 159 | |
| 160 | 'nick - highlight nick from dangerous-host only |
| 161 | 'all - highlight the entire message from dangerous-host |
| 162 | |
| 163 | Any other value disables dangerous-host highlighting altogether." |
| 164 | :group 'erc-match |
| 165 | :type '(choice (const nil) |
| 166 | (const nick) |
| 167 | (const all))) |
| 168 | |
| 169 | |
| 170 | (defcustom erc-log-matches-types-alist '((keyword . "ERC Keywords")) |
| 171 | "Alist telling ERC where to log which match types. |
| 172 | Valid match type keys are: |
| 173 | - keyword |
| 174 | - pal |
| 175 | - dangerous-host |
| 176 | - fool |
| 177 | - current-nick |
| 178 | |
| 179 | The other element of each cons pair in this list is the buffer name to |
| 180 | use for the logged message." |
| 181 | :group 'erc-match |
| 182 | :type '(repeat (cons (choice :tag "Key" |
| 183 | (const keyword) |
| 184 | (const pal) |
| 185 | (const dangerous-host) |
| 186 | (const fool) |
| 187 | (const current-nick)) |
| 188 | (string :tag "Buffer name")))) |
| 189 | |
| 190 | (defcustom erc-log-matches-flag 'away |
| 191 | "Flag specifying when matched message logging should happen. |
| 192 | When nil, don't log any matched messages. |
| 193 | When t, log messages. |
| 194 | When 'away, log messages only when away." |
| 195 | :group 'erc-match |
| 196 | :type '(choice (const nil) |
| 197 | (const away) |
| 198 | (const t))) |
| 199 | |
| 200 | (defcustom erc-log-match-format "%t<%n:%c> %m" |
| 201 | "Format for matched Messages. |
| 202 | This variable specifies how messages in the corresponding log buffers will |
| 203 | be formatted. The various format specs are: |
| 204 | |
| 205 | %t Timestamp (uses `erc-timestamp-format' if non-nil or \"[%Y-%m-%d %H:%M] \") |
| 206 | %n Nickname of sender |
| 207 | %u Nickname!user@host of sender |
| 208 | %c Channel in which this was received |
| 209 | %m Message" |
| 210 | :group 'erc-match |
| 211 | :type 'string) |
| 212 | |
| 213 | (defcustom erc-beep-match-types '(current-nick) |
| 214 | "Types of matches to beep for when a match occurs. |
| 215 | The function `erc-beep-on-match' needs to be added to `erc-text-matched-hook' |
| 216 | for beeping to work." |
| 217 | :group 'erc-match |
| 218 | :type '(choice (repeat :tag "Beep on match" (choice |
| 219 | (const current-nick) |
| 220 | (const keyword) |
| 221 | (const pal) |
| 222 | (const dangerous-host) |
| 223 | (const fool))) |
| 224 | (const :tag "Don't beep" nil))) |
| 225 | |
| 226 | (defcustom erc-text-matched-hook '(erc-log-matches) |
| 227 | "Hook run when text matches a given match-type. |
| 228 | Functions in this hook are passed as arguments: |
| 229 | \(match-type nick!user@host message) where MATCH-TYPE is a symbol of: |
| 230 | current-nick, keyword, pal, dangerous-host, fool" |
| 231 | :options '(erc-log-matches erc-hide-fools erc-beep-on-match) |
| 232 | :group 'erc-match |
| 233 | :type 'hook) |
| 234 | |
| 235 | ;; Internal variables: |
| 236 | |
| 237 | ;; This is exactly the same as erc-button-syntax-table. Should we |
| 238 | ;; just put it in erc.el |
| 239 | (defvar erc-match-syntax-table |
| 240 | (let ((table (make-syntax-table))) |
| 241 | (modify-syntax-entry ?\( "w" table) |
| 242 | (modify-syntax-entry ?\) "w" table) |
| 243 | (modify-syntax-entry ?\[ "w" table) |
| 244 | (modify-syntax-entry ?\] "w" table) |
| 245 | (modify-syntax-entry ?\{ "w" table) |
| 246 | (modify-syntax-entry ?\} "w" table) |
| 247 | (modify-syntax-entry ?` "w" table) |
| 248 | (modify-syntax-entry ?' "w" table) |
| 249 | (modify-syntax-entry ?^ "w" table) |
| 250 | (modify-syntax-entry ?- "w" table) |
| 251 | (modify-syntax-entry ?_ "w" table) |
| 252 | (modify-syntax-entry ?| "w" table) |
| 253 | (modify-syntax-entry ?\\ "w" table) |
| 254 | table) |
| 255 | "Syntax table used when highlighting messages. |
| 256 | This syntax table should make all the valid nick characters word |
| 257 | constituents.") |
| 258 | |
| 259 | ;; Faces: |
| 260 | |
| 261 | (defface erc-current-nick-face '((t (:bold t :foreground "DarkTurquoise"))) |
| 262 | "ERC face for occurrences of your current nickname." |
| 263 | :group 'erc-faces) |
| 264 | |
| 265 | (defface erc-dangerous-host-face '((t (:foreground "red"))) |
| 266 | "ERC face for people on dangerous hosts. |
| 267 | See `erc-dangerous-hosts'." |
| 268 | :group 'erc-faces) |
| 269 | |
| 270 | (defface erc-pal-face '((t (:bold t :foreground "Magenta"))) |
| 271 | "ERC face for your pals. |
| 272 | See `erc-pals'." |
| 273 | :group 'erc-faces) |
| 274 | |
| 275 | (defface erc-fool-face '((t (:foreground "dim gray"))) |
| 276 | "ERC face for fools on the channel. |
| 277 | See `erc-fools'." |
| 278 | :group 'erc-faces) |
| 279 | |
| 280 | (defface erc-keyword-face '((t (:bold t :foreground "pale green"))) |
| 281 | "ERC face for your keywords. |
| 282 | Note that this is the default face to use if |
| 283 | `erc-keywords' does not specify another." |
| 284 | :group 'erc-faces) |
| 285 | |
| 286 | ;; Functions: |
| 287 | |
| 288 | (defun erc-add-entry-to-list (list prompt &optional completions) |
| 289 | "Add an entry interactively to a list. |
| 290 | LIST must be passed as a symbol |
| 291 | The query happens using PROMPT. |
| 292 | Completion is performed on the optional alist COMPLETIONS." |
| 293 | (let ((entry (completing-read |
| 294 | prompt |
| 295 | completions |
| 296 | (lambda (x) |
| 297 | (not (erc-member-ignore-case (car x) (symbol-value list))))))) |
| 298 | (if (erc-member-ignore-case entry (symbol-value list)) |
| 299 | (error "\"%s\" is already on the list" entry) |
| 300 | (set list (cons entry (symbol-value list)))))) |
| 301 | |
| 302 | (defun erc-remove-entry-from-list (list prompt) |
| 303 | "Remove an entry interactively from a list. |
| 304 | LIST must be passed as a symbol. |
| 305 | The elements of LIST can be strings, or cons cells where the |
| 306 | car is the string." |
| 307 | (let* ((alist (mapcar (lambda (x) |
| 308 | (if (listp x) |
| 309 | x |
| 310 | (list x))) |
| 311 | (symbol-value list))) |
| 312 | (entry (completing-read |
| 313 | prompt |
| 314 | alist |
| 315 | nil |
| 316 | t))) |
| 317 | (if (erc-member-ignore-case entry (symbol-value list)) |
| 318 | ;; plain string |
| 319 | (set list (delete entry (symbol-value list))) |
| 320 | ;; cons cell |
| 321 | (set list (delete (assoc entry (symbol-value list)) |
| 322 | (symbol-value list)))))) |
| 323 | |
| 324 | ;;;###autoload |
| 325 | (defun erc-add-pal () |
| 326 | "Add pal interactively to `erc-pals'." |
| 327 | (interactive) |
| 328 | (erc-add-entry-to-list 'erc-pals "Add pal: " (erc-get-server-nickname-alist))) |
| 329 | |
| 330 | ;;;###autoload |
| 331 | (defun erc-delete-pal () |
| 332 | "Delete pal interactively to `erc-pals'." |
| 333 | (interactive) |
| 334 | (erc-remove-entry-from-list 'erc-pals "Delete pal: ")) |
| 335 | |
| 336 | ;;;###autoload |
| 337 | (defun erc-add-fool () |
| 338 | "Add fool interactively to `erc-fools'." |
| 339 | (interactive) |
| 340 | (erc-add-entry-to-list 'erc-fools "Add fool: " |
| 341 | (erc-get-server-nickname-alist))) |
| 342 | |
| 343 | ;;;###autoload |
| 344 | (defun erc-delete-fool () |
| 345 | "Delete fool interactively to `erc-fools'." |
| 346 | (interactive) |
| 347 | (erc-remove-entry-from-list 'erc-fools "Delete fool: ")) |
| 348 | |
| 349 | ;;;###autoload |
| 350 | (defun erc-add-keyword () |
| 351 | "Add keyword interactively to `erc-keywords'." |
| 352 | (interactive) |
| 353 | (erc-add-entry-to-list 'erc-keywords "Add keyword: ")) |
| 354 | |
| 355 | ;;;###autoload |
| 356 | (defun erc-delete-keyword () |
| 357 | "Delete keyword interactively to `erc-keywords'." |
| 358 | (interactive) |
| 359 | (erc-remove-entry-from-list 'erc-keywords "Delete keyword: ")) |
| 360 | |
| 361 | ;;;###autoload |
| 362 | (defun erc-add-dangerous-host () |
| 363 | "Add dangerous-host interactively to `erc-dangerous-hosts'." |
| 364 | (interactive) |
| 365 | (erc-add-entry-to-list 'erc-dangerous-hosts "Add dangerous-host: ")) |
| 366 | |
| 367 | ;;;###autoload |
| 368 | (defun erc-delete-dangerous-host () |
| 369 | "Delete dangerous-host interactively to `erc-dangerous-hosts'." |
| 370 | (interactive) |
| 371 | (erc-remove-entry-from-list 'erc-dangerous-hosts "Delete dangerous-host: ")) |
| 372 | |
| 373 | (defun erc-match-current-nick-p (nickuserhost msg) |
| 374 | "Check whether the current nickname is in MSG. |
| 375 | NICKUSERHOST will be ignored." |
| 376 | (with-syntax-table erc-match-syntax-table |
| 377 | (and msg |
| 378 | (string-match (concat "\\b" |
| 379 | (regexp-quote (erc-current-nick)) |
| 380 | "\\b") |
| 381 | msg)))) |
| 382 | |
| 383 | (defun erc-match-pal-p (nickuserhost msg) |
| 384 | "Check whether NICKUSERHOST is in `erc-pals'. |
| 385 | MSG will be ignored." |
| 386 | (and nickuserhost |
| 387 | (erc-list-match erc-pals nickuserhost))) |
| 388 | |
| 389 | (defun erc-match-fool-p (nickuserhost msg) |
| 390 | "Check whether NICKUSERHOST is in `erc-fools' or MSG is directed at a fool." |
| 391 | (and msg nickuserhost |
| 392 | (or (erc-list-match erc-fools nickuserhost) |
| 393 | (erc-match-directed-at-fool-p msg)))) |
| 394 | |
| 395 | (defun erc-match-keyword-p (nickuserhost msg) |
| 396 | "Check whether any keyword of `erc-keywords' matches for MSG. |
| 397 | NICKUSERHOST will be ignored." |
| 398 | (and msg |
| 399 | (erc-list-match |
| 400 | (mapcar (lambda (x) |
| 401 | (if (listp x) |
| 402 | (car x) |
| 403 | x)) |
| 404 | erc-keywords) |
| 405 | msg))) |
| 406 | |
| 407 | (defun erc-match-dangerous-host-p (nickuserhost msg) |
| 408 | "Check whether NICKUSERHOST is in `erc-dangerous-hosts'. |
| 409 | MSG will be ignored." |
| 410 | (and nickuserhost |
| 411 | (erc-list-match erc-dangerous-hosts nickuserhost))) |
| 412 | |
| 413 | (defun erc-match-directed-at-fool-p (msg) |
| 414 | "Check whether MSG is directed at a fool. |
| 415 | In order to do this, every entry in `erc-fools' will be used. |
| 416 | In any of the following situations, MSG is directed at an entry FOOL: |
| 417 | |
| 418 | - MSG starts with \"FOOL: \" or \"FOO, \" |
| 419 | - MSG contains \", FOOL.\" (actually, \"\\s. FOOL\\s.\")" |
| 420 | (let ((fools-beg (mapcar (lambda (entry) |
| 421 | (concat "^" entry "[:,] ")) |
| 422 | erc-fools)) |
| 423 | (fools-end (mapcar (lambda (entry) |
| 424 | (concat "\\s. " entry "\\s.")) |
| 425 | erc-fools))) |
| 426 | (or (erc-list-match fools-beg msg) |
| 427 | (erc-list-match fools-end msg)))) |
| 428 | |
| 429 | (defun erc-match-message () |
| 430 | "Mark certain keywords in a region. |
| 431 | Use this defun with `erc-insert-modify-hook'." |
| 432 | ;; This needs some refactoring. |
| 433 | (goto-char (point-min)) |
| 434 | (let* ((to-match-nick-dep '("pal" "fool" "dangerous-host")) |
| 435 | (to-match-nick-indep '("keyword" "current-nick")) |
| 436 | (vector (erc-get-parsed-vector (point-min))) |
| 437 | (nickuserhost (erc-get-parsed-vector-nick vector)) |
| 438 | (nickname (and nickuserhost |
| 439 | (nth 0 (erc-parse-user nickuserhost)))) |
| 440 | (old-pt (point)) |
| 441 | (nick-beg (and nickname |
| 442 | (re-search-forward (regexp-quote nickname) |
| 443 | (point-max) t) |
| 444 | (match-beginning 0))) |
| 445 | (nick-end (when nick-beg |
| 446 | (match-end 0))) |
| 447 | (message (buffer-substring (if (and nick-end |
| 448 | (<= (+ 2 nick-end) (point-max))) |
| 449 | (+ 2 nick-end) |
| 450 | (point-min)) |
| 451 | (point-max)))) |
| 452 | (when vector |
| 453 | (mapc |
| 454 | (lambda (match-type) |
| 455 | (goto-char (point-min)) |
| 456 | (let* ((match-prefix (concat "erc-" match-type)) |
| 457 | (match-pred (intern (concat "erc-match-" match-type "-p"))) |
| 458 | (match-htype (eval (intern (concat match-prefix |
| 459 | "-highlight-type")))) |
| 460 | (match-regex (if (string= match-type "current-nick") |
| 461 | (regexp-quote (erc-current-nick)) |
| 462 | (eval (intern (concat match-prefix "s"))))) |
| 463 | (match-face (intern (concat match-prefix "-face")))) |
| 464 | (when (funcall match-pred nickuserhost message) |
| 465 | (cond |
| 466 | ;; Highlight the nick of the message |
| 467 | ((and (eq match-htype 'nick) |
| 468 | nick-end) |
| 469 | (erc-put-text-property |
| 470 | nick-beg nick-end |
| 471 | 'face match-face (current-buffer))) |
| 472 | ;; Highlight the nick of the message, or the current |
| 473 | ;; nick if there's no nick in the message (e.g. /NAMES |
| 474 | ;; output) |
| 475 | ((and (string= match-type "current-nick") |
| 476 | (eq match-htype 'nick-or-keyword)) |
| 477 | (if nick-end |
| 478 | (erc-put-text-property |
| 479 | nick-beg nick-end |
| 480 | 'face match-face (current-buffer)) |
| 481 | (goto-char (+ 2 (or nick-end |
| 482 | (point-min)))) |
| 483 | (while (re-search-forward match-regex nil t) |
| 484 | (erc-put-text-property (match-beginning 0) (match-end 0) |
| 485 | 'face match-face)))) |
| 486 | ;; Highlight the whole message |
| 487 | ((eq match-htype 'all) |
| 488 | (erc-put-text-property |
| 489 | (point-min) (point-max) |
| 490 | 'face match-face (current-buffer))) |
| 491 | ;; Highlight all occurrences of the word to be |
| 492 | ;; highlighted. |
| 493 | ((and (string= match-type "keyword") |
| 494 | (eq match-htype 'keyword)) |
| 495 | (mapc (lambda (elt) |
| 496 | (let ((regex elt) |
| 497 | (face match-face)) |
| 498 | (when (consp regex) |
| 499 | (setq regex (car elt) |
| 500 | face (cdr elt))) |
| 501 | (goto-char (+ 2 (or nick-end |
| 502 | (point-min)))) |
| 503 | (while (re-search-forward regex nil t) |
| 504 | (erc-put-text-property |
| 505 | (match-beginning 0) (match-end 0) |
| 506 | 'face face)))) |
| 507 | match-regex)) |
| 508 | ;; Highlight all occurrences of our nick. |
| 509 | ((and (string= match-type "current-nick") |
| 510 | (eq match-htype 'keyword)) |
| 511 | (goto-char (+ 2 (or nick-end |
| 512 | (point-min)))) |
| 513 | (while (re-search-forward match-regex nil t) |
| 514 | (erc-put-text-property (match-beginning 0) (match-end 0) |
| 515 | 'face match-face))) |
| 516 | ;; Else twiddle your thumbs. |
| 517 | (t nil)) |
| 518 | (run-hook-with-args |
| 519 | 'erc-text-matched-hook |
| 520 | (intern match-type) |
| 521 | (or nickuserhost |
| 522 | (concat "Server:" (erc-get-parsed-vector-type vector))) |
| 523 | message)))) |
| 524 | (if nickuserhost |
| 525 | (append to-match-nick-dep to-match-nick-indep) |
| 526 | to-match-nick-indep))))) |
| 527 | |
| 528 | (defun erc-log-matches (match-type nickuserhost message) |
| 529 | "Log matches in a separate buffer, determined by MATCH-TYPE. |
| 530 | The behavior of this function is controlled by the variables |
| 531 | `erc-log-matches-types-alist' and `erc-log-matches-flag'. |
| 532 | Specify the match types which should be logged in the former, |
| 533 | and deactivate/activate match logging in the latter. |
| 534 | See `erc-log-match-format'." |
| 535 | (let ((match-buffer-name (cdr (assq match-type |
| 536 | erc-log-matches-types-alist))) |
| 537 | (nick (nth 0 (erc-parse-user nickuserhost)))) |
| 538 | (when (and |
| 539 | (or (eq erc-log-matches-flag t) |
| 540 | (and (eq erc-log-matches-flag 'away) |
| 541 | (erc-away-time))) |
| 542 | match-buffer-name) |
| 543 | (let ((line (format-spec erc-log-match-format |
| 544 | (format-spec-make |
| 545 | ?n nick |
| 546 | ?t (format-time-string |
| 547 | (or (and (boundp 'erc-timestamp-format) |
| 548 | erc-timestamp-format) |
| 549 | "[%Y-%m-%d %H:%M] ")) |
| 550 | ?c (or (erc-default-target) "") |
| 551 | ?m message |
| 552 | ?u nickuserhost)))) |
| 553 | (with-current-buffer (erc-log-matches-make-buffer match-buffer-name) |
| 554 | (let ((inhibit-read-only t)) |
| 555 | (goto-char (point-max)) |
| 556 | (insert line))))))) |
| 557 | |
| 558 | (defun erc-log-matches-make-buffer (name) |
| 559 | "Create or get a log-matches buffer named NAME and return it." |
| 560 | (let* ((buffer-already (get-buffer name)) |
| 561 | (buffer (or buffer-already |
| 562 | (get-buffer-create name)))) |
| 563 | (with-current-buffer buffer |
| 564 | (unless buffer-already |
| 565 | (insert " == Type \"q\" to dismiss messages ==\n") |
| 566 | (erc-view-mode-enter nil (lambda (buffer) |
| 567 | (when (y-or-n-p "Discard messages? ") |
| 568 | (kill-buffer buffer))))) |
| 569 | buffer))) |
| 570 | |
| 571 | (defun erc-log-matches-come-back (proc parsed) |
| 572 | "Display a notice that messages were logged while away." |
| 573 | (when (and (erc-away-time) |
| 574 | (eq erc-log-matches-flag 'away)) |
| 575 | (mapc |
| 576 | (lambda (match-type) |
| 577 | (let ((buffer (get-buffer (cdr match-type))) |
| 578 | (buffer-name (cdr match-type))) |
| 579 | (when buffer |
| 580 | (let* ((last-msg-time (erc-emacs-time-to-erc-time |
| 581 | (with-current-buffer buffer |
| 582 | (get-text-property (1- (point-max)) |
| 583 | 'timestamp)))) |
| 584 | (away-time (erc-emacs-time-to-erc-time (erc-away-time)))) |
| 585 | (when (and away-time last-msg-time |
| 586 | (erc-time-gt last-msg-time away-time)) |
| 587 | (erc-display-message |
| 588 | nil 'notice 'active |
| 589 | (format "You have logged messages waiting in \"%s\"." |
| 590 | buffer-name)) |
| 591 | (erc-display-message |
| 592 | nil 'notice 'active |
| 593 | (format "Type \"C-c C-k %s RET\" to view them." |
| 594 | buffer-name))))))) |
| 595 | erc-log-matches-types-alist)) |
| 596 | nil) |
| 597 | |
| 598 | ; This handler must be run _before_ erc-process-away is. |
| 599 | (add-hook 'erc-server-305-functions 'erc-log-matches-come-back nil) |
| 600 | |
| 601 | (defun erc-go-to-log-matches-buffer () |
| 602 | "Interactively open an erc-log-matches buffer." |
| 603 | (interactive) |
| 604 | (let ((buffer-name (completing-read "Switch to ERC Log buffer: " |
| 605 | (mapcar (lambda (x) |
| 606 | (cons (cdr x) t)) |
| 607 | erc-log-matches-types-alist) |
| 608 | (lambda (buffer-cons) |
| 609 | (get-buffer (car buffer-cons)))))) |
| 610 | (switch-to-buffer buffer-name))) |
| 611 | |
| 612 | (define-key erc-mode-map "\C-c\C-k" 'erc-go-to-log-matches-buffer) |
| 613 | |
| 614 | (defun erc-hide-fools (match-type nickuserhost message) |
| 615 | "Hide foolish comments. |
| 616 | This function should be called from `erc-text-matched-hook'." |
| 617 | (when (eq match-type 'fool) |
| 618 | (erc-put-text-properties (point-min) (point-max) |
| 619 | '(invisible intangible) |
| 620 | (current-buffer)))) |
| 621 | |
| 622 | (defun erc-beep-on-match (match-type nickuserhost message) |
| 623 | "Beep when text matches. |
| 624 | This function is meant to be called from `erc-text-matched-hook'." |
| 625 | (when (member match-type erc-beep-match-types) |
| 626 | (beep))) |
| 627 | |
| 628 | (provide 'erc-match) |
| 629 | |
| 630 | ;;; erc-match.el ends here |
| 631 | ;; |
| 632 | ;; Local Variables: |
| 633 | ;; indent-tabs-mode: t |
| 634 | ;; tab-width: 8 |
| 635 | ;; End: |
| 636 | |