diff options
| author | Eli Zaretskii | 2006-09-02 21:25:11 +0000 |
|---|---|---|
| committer | Eli Zaretskii | 2006-09-02 21:25:11 +0000 |
| commit | f8db61b2de10a2712cecadf07021d36226bdbc43 (patch) | |
| tree | 4aadc3274413ee22e5f9fe05d66abf0dc438ef8f | |
| parent | bdbae5b870c10ce7a8225d079f844896bd32c450 (diff) | |
| download | emacs-f8db61b2de10a2712cecadf07021d36226bdbc43.tar.gz emacs-f8db61b2de10a2712cecadf07021d36226bdbc43.zip | |
(rcirc-keywords): New variable.
(rcirc-bright-nicks, rcirc-dim-nicks): New variables.
(rcirc-bright-nick-regexp, rcirc-dim-nick-regexp): Remove variables.
(rcirc-responses-no-activity): New function.
(rcirc-handler-generic): Check for responses in above.
(rcirc-process-command): Add ?: character to arguments of raw server commands.
(rcirc-format-response-string): Use `rcirc-bright-nicks' and `rcirc-dim-nicks'.
(rcirc-gray-toggle): Remove unused variable.
(rcirc-print): Remove some tracking logic, which is moved into markup functions.
(rcirc-activity-types): Was `rcirc-activity-type', now a list of types.
(rcirc-activity-string): Look for 'keyword in activity-types.
(rcirc-window-configuration-change): Don't erase overlay-arrow unnecessarily.
(rcirc-add-or-remove): New function.
(rcirc-cmd-ignore): Use it.
(rcirc-message-leader): Remove unused function.
(rcicr-cmd-bright, rcirc-cmd-dim, rcirc-cmd-keyword): New commands.
(rcirc-add-face): New function.
(rcirc-facify): Use rcirc-add-face.
(rcirc-url-regexp): Add parens.
(rcirc-map-regexp): Remove function.
(rcirc-mangle-regexp): Remove function.
(rcirc-markup-text-functions): New variable.
(rcirc-markup-text): New function (replaces `rcirc-mangle-text').
(rcirc-markup-body-text, rcirc-markup-attributes)
(rcirc-markup-my-nick, rcirc-markup-urls, rcirc-markup-keywords)
(rcirc-markup-bright-nicks): New markup handler functions.
(rcirc-nick-in-message-full-line): New face.
(rcirc-track-nick): Rename from `rcirc-mode-line-nick'.
(rcirc-track-keyword, rcirc-url, rcirc-keyword): New faces.
| -rw-r--r-- | lisp/net/rcirc.el | 376 |
1 files changed, 232 insertions, 144 deletions
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index c34ac7dcf78..8c678b6ae5f 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el | |||
| @@ -144,7 +144,9 @@ number. If zero or nil, no truncating is done." | |||
| 144 | 144 | ||
| 145 | (defcustom rcirc-show-maximum-output t | 145 | (defcustom rcirc-show-maximum-output t |
| 146 | "*If non-nil, scroll buffer to keep the point at the bottom of | 146 | "*If non-nil, scroll buffer to keep the point at the bottom of |
| 147 | the window.") | 147 | the window." |
| 148 | :type 'boolean | ||
| 149 | :group 'rcirc) | ||
| 148 | 150 | ||
| 149 | (defcustom rcirc-authinfo nil | 151 | (defcustom rcirc-authinfo nil |
| 150 | "List of authentication passwords. | 152 | "List of authentication passwords. |
| @@ -200,6 +202,11 @@ use either M-x customize or also call `rcirc-update-prompt'." | |||
| 200 | :initialize 'custom-initialize-default | 202 | :initialize 'custom-initialize-default |
| 201 | :group 'rcirc) | 203 | :group 'rcirc) |
| 202 | 204 | ||
| 205 | (defcustom rcirc-keywords nil | ||
| 206 | "List of keywords to highlight in message text." | ||
| 207 | :type '(repeat string) | ||
| 208 | :group 'rcirc) | ||
| 209 | |||
| 203 | (defcustom rcirc-ignore-list () | 210 | (defcustom rcirc-ignore-list () |
| 204 | "List of ignored nicks. | 211 | "List of ignored nicks. |
| 205 | Use /ignore to list them, use /ignore NICK to add or remove a nick." | 212 | Use /ignore to list them, use /ignore NICK to add or remove a nick." |
| @@ -212,16 +219,16 @@ When an ignored person renames, their nick is added to both lists. | |||
| 212 | Nicks will be removed from the automatic list on follow-up renamings or | 219 | Nicks will be removed from the automatic list on follow-up renamings or |
| 213 | parts.") | 220 | parts.") |
| 214 | 221 | ||
| 215 | (defcustom rcirc-bright-nick-regexp nil | 222 | (defcustom rcirc-bright-nicks nil |
| 216 | "Regexp matching nicks to be emphasized. | 223 | "List of nicks to be emphasized. |
| 217 | See `rcirc-bright-nick' face." | 224 | See `rcirc-bright-nick' face." |
| 218 | :type 'regexp | 225 | :type '(repeat string) |
| 219 | :group 'rcirc) | 226 | :group 'rcirc) |
| 220 | 227 | ||
| 221 | (defcustom rcirc-dim-nick-regexp nil | 228 | (defcustom rcirc-dim-nicks nil |
| 222 | "Regexp matching nicks to be deemphasized. | 229 | "List of nicks to be deemphasized. |
| 223 | See `rcirc-dim-nick' face." | 230 | See `rcirc-dim-nick' face." |
| 224 | :type 'regexp | 231 | :type '(repeat string) |
| 225 | :group 'rcirc) | 232 | :group 'rcirc) |
| 226 | 233 | ||
| 227 | (defcustom rcirc-print-hooks nil | 234 | (defcustom rcirc-print-hooks nil |
| @@ -246,7 +253,7 @@ Called with 5 arguments, PROCESS, SENDER, RESPONSE, TARGET and TEXT." | |||
| 246 | :group 'rcirc) | 253 | :group 'rcirc) |
| 247 | 254 | ||
| 248 | (defcustom rcirc-coding-system-alist nil | 255 | (defcustom rcirc-coding-system-alist nil |
| 249 | "Alist to decide a coding system to use for a file I/O operation. | 256 | "Alist to decide a coding system to use for a channel I/O operation. |
| 250 | The format is ((PATTERN . VAL) ...). | 257 | The format is ((PATTERN . VAL) ...). |
| 251 | PATTERN is either a string or a cons of strings. | 258 | PATTERN is either a string or a cons of strings. |
| 252 | If PATTERN is a string, it is used to match a target. | 259 | If PATTERN is a string, it is used to match a target. |
| @@ -528,10 +535,14 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") | |||
| 528 | process cmd sender args text))) | 535 | process cmd sender args text))) |
| 529 | (message "UNHANDLED: %s" text))) | 536 | (message "UNHANDLED: %s" text))) |
| 530 | 537 | ||
| 531 | (defun rcirc-handler-generic (process command sender args text) | 538 | (defvar rcirc-responses-no-activity '("305" "306") |
| 539 | "Responses that don't trigger activity in the mode-line indicator.") | ||
| 540 | |||
| 541 | (defun rcirc-handler-generic (process response sender args text) | ||
| 532 | "Generic server response handler." | 542 | "Generic server response handler." |
| 533 | (rcirc-print process sender command nil | 543 | (rcirc-print process sender response nil |
| 534 | (mapconcat 'identity (cdr args) " ") t)) | 544 | (mapconcat 'identity (cdr args) " ") |
| 545 | (not (member response rcirc-responses-no-activity)))) | ||
| 535 | 546 | ||
| 536 | (defun rcirc-send-string (process string) | 547 | (defun rcirc-send-string (process string) |
| 537 | "Send PROCESS a STRING plus a newline." | 548 | "Send PROCESS a STRING plus a newline." |
| @@ -748,13 +759,10 @@ If NOTICEP is non-nil, send a notice instead of privmsg." | |||
| 748 | 759 | ||
| 749 | ;; if the user changes the major mode or kills the buffer, there is | 760 | ;; if the user changes the major mode or kills the buffer, there is |
| 750 | ;; cleanup work to do | 761 | ;; cleanup work to do |
| 751 | (make-local-variable 'change-major-mode-hook) | 762 | (add-hook 'change-major-mode-hook 'rcirc-change-major-mode-hook nil t) |
| 752 | (add-hook 'change-major-mode-hook 'rcirc-change-major-mode-hook) | 763 | (add-hook 'kill-buffer-hook 'rcirc-kill-buffer-hook nil t) |
| 753 | (make-local-variable 'kill-buffer-hook) | ||
| 754 | (add-hook 'kill-buffer-hook 'rcirc-kill-buffer-hook) | ||
| 755 | 764 | ||
| 756 | (make-local-variable 'window-scroll-functions) | 765 | (add-hook 'window-scroll-functions 'rcirc-scroll-to-bottom nil t) |
| 757 | (add-hook 'window-scroll-functions 'rcirc-scroll-to-bottom) | ||
| 758 | 766 | ||
| 759 | ;; add to buffer list, and update buffer abbrevs | 767 | ;; add to buffer list, and update buffer abbrevs |
| 760 | (when target ; skip server buffer | 768 | (when target ; skip server buffer |
| @@ -941,7 +949,7 @@ Create the buffer if it doesn't exist." | |||
| 941 | (if (fboundp fun) | 949 | (if (fboundp fun) |
| 942 | (funcall fun args process rcirc-target) | 950 | (funcall fun args process rcirc-target) |
| 943 | (rcirc-send-string process | 951 | (rcirc-send-string process |
| 944 | (concat command " " args))))))) | 952 | (concat command " :" args))))))) |
| 945 | 953 | ||
| 946 | (defvar rcirc-parent-buffer nil) | 954 | (defvar rcirc-parent-buffer nil) |
| 947 | (defvar rcirc-window-configuration nil) | 955 | (defvar rcirc-window-configuration nil) |
| @@ -1073,7 +1081,8 @@ is found by looking up RESPONSE in `rcirc-response-formats'." | |||
| 1073 | "%") | 1081 | "%") |
| 1074 | ((or (eq key ?n) (eq key ?N)) | 1082 | ((or (eq key ?n) (eq key ?N)) |
| 1075 | ;; %n/%N -- nick | 1083 | ;; %n/%N -- nick |
| 1076 | (let ((nick (concat (if (string= (with-rcirc-process-buffer process | 1084 | (let ((nick (concat (if (string= (with-rcirc-process-buffer |
| 1085 | process | ||
| 1077 | rcirc-server) | 1086 | rcirc-server) |
| 1078 | sender) | 1087 | sender) |
| 1079 | "" | 1088 | "" |
| @@ -1084,26 +1093,26 @@ is found by looking up RESPONSE in `rcirc-response-formats'." | |||
| 1084 | face | 1093 | face |
| 1085 | (cond ((string= sender (rcirc-nick process)) | 1094 | (cond ((string= sender (rcirc-nick process)) |
| 1086 | 'rcirc-my-nick) | 1095 | 'rcirc-my-nick) |
| 1087 | ((and rcirc-bright-nick-regexp | 1096 | ((and rcirc-bright-nicks |
| 1088 | (string-match rcirc-bright-nick-regexp sender)) | 1097 | (string-match |
| 1098 | (regexp-opt rcirc-bright-nicks) | ||
| 1099 | sender)) | ||
| 1089 | 'rcirc-bright-nick) | 1100 | 'rcirc-bright-nick) |
| 1090 | ((and rcirc-dim-nick-regexp | 1101 | ((and rcirc-dim-nicks |
| 1091 | (string-match rcirc-dim-nick-regexp sender)) | 1102 | (string-match |
| 1103 | (regexp-opt rcirc-dim-nicks) | ||
| 1104 | sender)) | ||
| 1092 | 'rcirc-dim-nick) | 1105 | 'rcirc-dim-nick) |
| 1093 | (t | 1106 | (t |
| 1094 | 'rcirc-other-nick)))))) | 1107 | 'rcirc-other-nick)))))) |
| 1095 | ((eq key ?T) | 1108 | ((eq key ?T) |
| 1096 | ;; %T -- timestamp | 1109 | ;; %T -- timestamp |
| 1097 | (rcirc-facify | 1110 | (rcirc-facify |
| 1098 | (format-time-string rcirc-time-format (current-time)) | 1111 | (format-time-string rcirc-time-format (current-time)) |
| 1099 | 'rcirc-timestamp)) | 1112 | 'rcirc-timestamp)) |
| 1100 | ((eq key ?m) | 1113 | ((eq key ?m) |
| 1101 | ;; %m -- message text | 1114 | ;; %m -- message text |
| 1102 | ;; We add the text property `rcirc-text' to identify this | 1115 | (rcirc-markup-text process sender response (rcirc-facify text face))) |
| 1103 | ;; as the body text. | ||
| 1104 | (propertize | ||
| 1105 | (rcirc-mangle-text process (rcirc-facify text face)) | ||
| 1106 | 'rcirc-text text)) | ||
| 1107 | ((eq key ?t) | 1116 | ((eq key ?t) |
| 1108 | ;; %t -- target | 1117 | ;; %t -- target |
| 1109 | (rcirc-facify (or rcirc-target "") face)) | 1118 | (rcirc-facify (or rcirc-target "") face)) |
| @@ -1152,12 +1161,10 @@ is found by looking up RESPONSE in `rcirc-response-formats'." | |||
| 1152 | ((or (rcirc-get-buffer process target) | 1161 | ((or (rcirc-get-buffer process target) |
| 1153 | (rcirc-any-buffer process)))))) | 1162 | (rcirc-any-buffer process)))))) |
| 1154 | 1163 | ||
| 1155 | (defvar rcirc-activity-type nil) | 1164 | (defvar rcirc-activity-types nil) |
| 1156 | (make-variable-buffer-local 'rcirc-activity-type) | 1165 | (make-variable-buffer-local 'rcirc-activity-types) |
| 1157 | (defvar rcirc-last-sender nil) | 1166 | (defvar rcirc-last-sender nil) |
| 1158 | (make-variable-buffer-local 'rcirc-last-sender) | 1167 | (make-variable-buffer-local 'rcirc-last-sender) |
| 1159 | (defvar rcirc-gray-toggle nil) | ||
| 1160 | (make-variable-buffer-local 'rcirc-gray-toggle) | ||
| 1161 | 1168 | ||
| 1162 | (defun rcirc-scroll-to-bottom (window display-start) | 1169 | (defun rcirc-scroll-to-bottom (window display-start) |
| 1163 | "Scroll window to show maximum output if `rcirc-show-maximum-output' is | 1170 | "Scroll window to show maximum output if `rcirc-show-maximum-output' is |
| @@ -1261,26 +1268,13 @@ record activity." | |||
| 1261 | (buffer-enable-undo)) | 1268 | (buffer-enable-undo)) |
| 1262 | 1269 | ||
| 1263 | ;; record modeline activity | 1270 | ;; record modeline activity |
| 1264 | (when activity | 1271 | (when (and activity |
| 1265 | (let ((nick-match | 1272 | (not rcirc-ignore-buffer-activity-flag) |
| 1266 | (with-syntax-table rcirc-nick-syntax-table | 1273 | (not (and rcirc-dim-nicks sender |
| 1267 | (string-match (concat "\\b" | 1274 | (string-match (regexp-opt rcirc-dim-nicks) sender)))) |
| 1268 | (regexp-quote (rcirc-nick process)) | 1275 | (rcirc-record-activity (current-buffer) |
| 1269 | "\\b") | 1276 | (when (not (rcirc-channel-p rcirc-target)) |
| 1270 | text)))) | 1277 | 'nick))) |
| 1271 | (when (if rcirc-ignore-buffer-activity-flag | ||
| 1272 | ;; - Always notice when our nick is mentioned | ||
| 1273 | nick-match | ||
| 1274 | ;; - unless our nick is mentioned, don't bother us | ||
| 1275 | ;; - with dim-nicks | ||
| 1276 | (or nick-match | ||
| 1277 | (not (and rcirc-dim-nick-regexp sender | ||
| 1278 | (string-match rcirc-dim-nick-regexp sender))))) | ||
| 1279 | (rcirc-record-activity | ||
| 1280 | (current-buffer) | ||
| 1281 | (when (or nick-match (and (not (rcirc-channel-p rcirc-target)) | ||
| 1282 | (not rcirc-low-priority-flag))) | ||
| 1283 | 'nick))))) | ||
| 1284 | 1278 | ||
| 1285 | (sit-for 0) ; displayed text before hook | 1279 | (sit-for 0) ; displayed text before hook |
| 1286 | (run-hook-with-args 'rcirc-print-hooks | 1280 | (run-hook-with-args 'rcirc-print-hooks |
| @@ -1501,8 +1495,7 @@ activity. Only run if the buffer is not visible and | |||
| 1501 | (let ((t1 (with-current-buffer b1 rcirc-last-post-time)) | 1495 | (let ((t1 (with-current-buffer b1 rcirc-last-post-time)) |
| 1502 | (t2 (with-current-buffer b2 rcirc-last-post-time))) | 1496 | (t2 (with-current-buffer b2 rcirc-last-post-time))) |
| 1503 | (time-less-p t2 t1))))) | 1497 | (time-less-p t2 t1))))) |
| 1504 | (if (not rcirc-activity-type) | 1498 | (pushnew type rcirc-activity-types) |
| 1505 | (setq rcirc-activity-type type)) | ||
| 1506 | (rcirc-update-activity-string))) | 1499 | (rcirc-update-activity-string))) |
| 1507 | (run-hook-with-args 'rcirc-activity-hooks buffer)) | 1500 | (run-hook-with-args 'rcirc-activity-hooks buffer)) |
| 1508 | 1501 | ||
| @@ -1510,7 +1503,7 @@ activity. Only run if the buffer is not visible and | |||
| 1510 | "Clear the BUFFER activity." | 1503 | "Clear the BUFFER activity." |
| 1511 | (setq rcirc-activity (delete buffer rcirc-activity)) | 1504 | (setq rcirc-activity (delete buffer rcirc-activity)) |
| 1512 | (with-current-buffer buffer | 1505 | (with-current-buffer buffer |
| 1513 | (setq rcirc-activity-type nil))) | 1506 | (setq rcirc-activity-types nil))) |
| 1514 | 1507 | ||
| 1515 | (defun rcirc-split-activity (activity) | 1508 | (defun rcirc-split-activity (activity) |
| 1516 | "Return a cons cell with ACTIVITY split into (lopri . hipri)." | 1509 | "Return a cons cell with ACTIVITY split into (lopri . hipri)." |
| @@ -1518,7 +1511,7 @@ activity. Only run if the buffer is not visible and | |||
| 1518 | (dolist (buf rcirc-activity) | 1511 | (dolist (buf rcirc-activity) |
| 1519 | (with-current-buffer buf | 1512 | (with-current-buffer buf |
| 1520 | (if (and rcirc-low-priority-flag | 1513 | (if (and rcirc-low-priority-flag |
| 1521 | (not (eq rcirc-activity-type 'nick))) | 1514 | (not (member 'nick rcirc-activity-types))) |
| 1522 | (add-to-list 'lopri buf t) | 1515 | (add-to-list 'lopri buf t) |
| 1523 | (add-to-list 'hipri buf t)))) | 1516 | (add-to-list 'hipri buf t)))) |
| 1524 | (cons lopri hipri))) | 1517 | (cons lopri hipri))) |
| @@ -1547,11 +1540,15 @@ activity. Only run if the buffer is not visible and | |||
| 1547 | 1540 | ||
| 1548 | (defun rcirc-activity-string (buffers) | 1541 | (defun rcirc-activity-string (buffers) |
| 1549 | (mapconcat (lambda (b) | 1542 | (mapconcat (lambda (b) |
| 1550 | (let ((s (rcirc-short-buffer-name b))) | 1543 | (let ((s (substring-no-properties (rcirc-short-buffer-name b)))) |
| 1551 | (with-current-buffer b | 1544 | (with-current-buffer b |
| 1552 | (if (not (eq rcirc-activity-type 'nick)) | 1545 | (dolist (type rcirc-activity-types) |
| 1553 | s | 1546 | (rcirc-add-face 0 (length s) |
| 1554 | (rcirc-facify s 'rcirc-mode-line-nick))))) | 1547 | (case type |
| 1548 | ('nick 'rcirc-track-nick) | ||
| 1549 | ('keyword 'rcirc-track-keyword)) | ||
| 1550 | s))) | ||
| 1551 | s)) | ||
| 1555 | buffers ",")) | 1552 | buffers ",")) |
| 1556 | 1553 | ||
| 1557 | (defun rcirc-short-buffer-name (buffer) | 1554 | (defun rcirc-short-buffer-name (buffer) |
| @@ -1566,15 +1563,18 @@ Also, clear the overlay arrow if the current buffer is now hidden." | |||
| 1566 | (let ((current-now-hidden t)) | 1563 | (let ((current-now-hidden t)) |
| 1567 | (walk-windows (lambda (w) | 1564 | (walk-windows (lambda (w) |
| 1568 | (let ((buf (window-buffer w))) | 1565 | (let ((buf (window-buffer w))) |
| 1569 | (when (eq major-mode 'rcirc-mode) | 1566 | (with-current-buffer buf |
| 1570 | (rcirc-clear-activity buf) | 1567 | (when (eq major-mode 'rcirc-mode) |
| 1568 | (rcirc-clear-activity buf))) | ||
| 1571 | (when (eq buf rcirc-current-buffer) | 1569 | (when (eq buf rcirc-current-buffer) |
| 1572 | (setq current-now-hidden nil)))))) | 1570 | (setq current-now-hidden nil))))) |
| 1573 | ;; add overlay arrow if the buffer isn't displayed | 1571 | ;; add overlay arrow if the buffer isn't displayed |
| 1574 | (when (and rcirc-current-buffer current-now-hidden) | 1572 | (when (and current-now-hidden |
| 1573 | rcirc-current-buffer | ||
| 1574 | (buffer-live-p rcirc-current-buffer)) | ||
| 1575 | (with-current-buffer rcirc-current-buffer | 1575 | (with-current-buffer rcirc-current-buffer |
| 1576 | (when (eq major-mode 'rcirc-mode) | 1576 | (when (and (eq major-mode 'rcirc-mode) |
| 1577 | (marker-position overlay-arrow-position) | 1577 | (marker-position overlay-arrow-position)) |
| 1578 | (set-marker overlay-arrow-position nil))))) | 1578 | (set-marker overlay-arrow-position nil))))) |
| 1579 | 1579 | ||
| 1580 | ;; remove any killed buffers from list | 1580 | ;; remove any killed buffers from list |
| @@ -1792,17 +1792,21 @@ With a prefix arg, prompt for new topic." | |||
| 1792 | (rcirc-send-string process (format "PRIVMSG %s :\C-aACTION %s\C-a" | 1792 | (rcirc-send-string process (format "PRIVMSG %s :\C-aACTION %s\C-a" |
| 1793 | target args))) | 1793 | target args))) |
| 1794 | 1794 | ||
| 1795 | (defun rcirc-add-or-remove (set &optional elt) | ||
| 1796 | (if (and elt (not (string= "" elt))) | ||
| 1797 | (if (member-ignore-case elt set) | ||
| 1798 | (delete elt set) | ||
| 1799 | (cons elt set)) | ||
| 1800 | set)) | ||
| 1801 | |||
| 1795 | (defun-rcirc-command ignore (nick) | 1802 | (defun-rcirc-command ignore (nick) |
| 1796 | "Manage the ignore list. | 1803 | "Manage the ignore list. |
| 1797 | Ignore NICK, unignore NICK if already ignored, or list ignored | 1804 | Ignore NICK, unignore NICK if already ignored, or list ignored |
| 1798 | nicks when no NICK is given. When listing ignored nicks, the | 1805 | nicks when no NICK is given. When listing ignored nicks, the |
| 1799 | ones added to the list automatically are marked with an asterisk." | 1806 | ones added to the list automatically are marked with an asterisk." |
| 1800 | (interactive "sToggle ignoring of nick: ") | 1807 | (interactive "sToggle ignoring of nick: ") |
| 1801 | (when (not (string= "" nick)) | 1808 | (setq rcirc-ignore-list (rcirc-add-or-remove rcirc-ignore-list nick)) |
| 1802 | (if (member-ignore-case nick rcirc-ignore-list) | 1809 | (rcirc-print process nil "IGNORE" target |
| 1803 | (setq rcirc-ignore-list (delete nick rcirc-ignore-list)) | ||
| 1804 | (setq rcirc-ignore-list (cons nick rcirc-ignore-list)))) | ||
| 1805 | (rcirc-print process (rcirc-nick process) "IGNORE" target | ||
| 1806 | (mapconcat | 1810 | (mapconcat |
| 1807 | (lambda (nick) | 1811 | (lambda (nick) |
| 1808 | (concat nick | 1812 | (concat nick |
| @@ -1810,14 +1814,47 @@ ones added to the list automatically are marked with an asterisk." | |||
| 1810 | "*" ""))) | 1814 | "*" ""))) |
| 1811 | rcirc-ignore-list " "))) | 1815 | rcirc-ignore-list " "))) |
| 1812 | 1816 | ||
| 1817 | (defun-rcirc-command bright (nick) | ||
| 1818 | "Manage the bright nick list." | ||
| 1819 | (interactive "sToggle emphasis of nick: ") | ||
| 1820 | (setq rcirc-bright-nicks (rcirc-add-or-remove rcirc-bright-nicks nick)) | ||
| 1821 | (rcirc-print process nil "BRIGHT" target | ||
| 1822 | (mapconcat 'identity rcirc-bright-nicks " "))) | ||
| 1823 | |||
| 1824 | (defun-rcirc-command dim (nick) | ||
| 1825 | "Manage the dim nick list." | ||
| 1826 | (interactive "sToggle deemphasis of nick: ") | ||
| 1827 | (setq rcirc-dim-nicks (rcirc-add-or-remove rcirc-dim-nicks nick)) | ||
| 1828 | (rcirc-print process nil "DIM" target | ||
| 1829 | (mapconcat 'identity rcirc-dim-nicks " "))) | ||
| 1830 | |||
| 1831 | (defun-rcirc-command keyword (keyword) | ||
| 1832 | "Manage the keyword list. | ||
| 1833 | Mark KEYWORD, unmark KEYWORD if already marked, or list marked | ||
| 1834 | keywords when no KEYWORD is given." | ||
| 1835 | (interactive "sToggle highlighting of keyword: ") | ||
| 1836 | (setq rcirc-keywords (rcirc-add-or-remove rcirc-keywords keyword)) | ||
| 1837 | (rcirc-print process nil "KEYWORD" target | ||
| 1838 | (mapconcat 'identity rcirc-keywords " "))) | ||
| 1839 | |||
| 1813 | 1840 | ||
| 1814 | (defun rcirc-message-leader (sender face) | 1841 | (defun rcirc-add-face (start end name &optional object) |
| 1815 | "Return a string with SENDER propertized with FACE." | 1842 | "Add face NAME to the face text property of the text from START to END." |
| 1816 | (rcirc-facify (concat "<" sender "> ") face)) | 1843 | (when name |
| 1844 | (let ((pos start) | ||
| 1845 | next prop) | ||
| 1846 | (while (< pos end) | ||
| 1847 | (setq prop (get-text-property pos 'face object) | ||
| 1848 | next (next-single-property-change pos 'face object end)) | ||
| 1849 | (unless (member name (get-text-property pos 'face object)) | ||
| 1850 | (add-text-properties pos next (list 'face (cons name prop)) object)) | ||
| 1851 | (setq pos next))))) | ||
| 1817 | 1852 | ||
| 1818 | (defun rcirc-facify (string face) | 1853 | (defun rcirc-facify (string face) |
| 1819 | "Return a copy of STRING with FACE property added." | 1854 | "Return a copy of STRING with FACE property added." |
| 1820 | (propertize (or string "") 'face face 'rear-nonsticky t)) | 1855 | (let ((string (or string ""))) |
| 1856 | (rcirc-add-face 0 (length string) face string) | ||
| 1857 | string)) | ||
| 1821 | 1858 | ||
| 1822 | (defvar rcirc-url-regexp | 1859 | (defvar rcirc-url-regexp |
| 1823 | (rx-to-string | 1860 | (rx-to-string |
| @@ -1835,8 +1872,8 @@ ones added to the list automatically are marked with an asterisk." | |||
| 1835 | word-boundary)) | 1872 | word-boundary)) |
| 1836 | (optional | 1873 | (optional |
| 1837 | (and "/" | 1874 | (and "/" |
| 1838 | (1+ (char "-a-zA-Z0-9_=!?#$\@~`%&*+|\\/:;.,{}[]")) | 1875 | (1+ (char "-a-zA-Z0-9_=!?#$\@~`%&*+|\\/:;.,{}[]()")) |
| 1839 | (char "-a-zA-Z0-9_=#$\@~`%&*+|\\/:;{}[]"))))) | 1876 | (char "-a-zA-Z0-9_=#$\@~`%&*+|\\/:;{}[]()"))))) |
| 1840 | "Regexp matching URLs. Set to nil to disable URL features in rcirc.") | 1877 | "Regexp matching URLs. Set to nil to disable URL features in rcirc.") |
| 1841 | 1878 | ||
| 1842 | (defun rcirc-browse-url (&optional arg) | 1879 | (defun rcirc-browse-url (&optional arg) |
| @@ -1863,68 +1900,99 @@ ones added to the list automatically are marked with an asterisk." | |||
| 1863 | (with-current-buffer (window-buffer (posn-window position)) | 1900 | (with-current-buffer (window-buffer (posn-window position)) |
| 1864 | (rcirc-browse-url-at-point (posn-point position))))) | 1901 | (rcirc-browse-url-at-point (posn-point position))))) |
| 1865 | 1902 | ||
| 1866 | (defun rcirc-map-regexp (function regexp string) | 1903 | |
| 1867 | "Return a copy of STRING after calling FUNCTION for each REGEXP match. | 1904 | (defvar rcirc-markup-text-functions |
| 1868 | FUNCTION takes 3 arguments, MATCH-START, MATCH-END, and STRING." | 1905 | '(rcirc-markup-body-text |
| 1869 | (let ((start 0)) | 1906 | rcirc-markup-attributes |
| 1870 | (while (string-match regexp string start) | 1907 | rcirc-markup-my-nick |
| 1871 | (setq start (match-end 0)) | 1908 | rcirc-markup-urls |
| 1872 | (funcall function (match-beginning 0) (match-end 0) string))) | 1909 | rcirc-markup-keywords |
| 1873 | string) | 1910 | rcirc-markup-bright-nicks) |
| 1874 | 1911 | "List of functions used to manipulate text before it is printed. | |
| 1875 | (defun rcirc-mangle-text (process text) | 1912 | |
| 1913 | Each function takes three arguments, PROCESS, SENDER, RESPONSE | ||
| 1914 | and CHANNEL-BUFFER. The current buffer is temporary buffer that | ||
| 1915 | contains the text to manipulate. Each function works on the text | ||
| 1916 | in this buffer.") | ||
| 1917 | |||
| 1918 | (defun rcirc-markup-text (process sender response text) | ||
| 1876 | "Return TEXT with properties added based on various patterns." | 1919 | "Return TEXT with properties added based on various patterns." |
| 1877 | ;; ^B | 1920 | (let ((channel-buffer (current-buffer))) |
| 1878 | (setq text | 1921 | (with-temp-buffer |
| 1879 | (rcirc-map-regexp | 1922 | (insert text) |
| 1880 | (lambda (start end string) | 1923 | (goto-char (point-min)) |
| 1881 | (let ((orig-face (get-text-property start 'face string))) | 1924 | (dolist (fn rcirc-markup-text-functions) |
| 1882 | (add-text-properties | 1925 | (save-excursion |
| 1883 | start end | 1926 | (funcall fn process sender response channel-buffer))) |
| 1884 | (list 'face (if (listp orig-face) | 1927 | (buffer-substring (point-min) (point-max))))) |
| 1885 | (append orig-face | 1928 | |
| 1886 | (list 'bold)) | 1929 | (defun rcirc-markup-body-text (process sender response channel-buffer) |
| 1887 | (list orig-face 'bold)) | 1930 | ;; We add the text property `rcirc-text' to identify this as the |
| 1888 | 'rear-nonsticky t) | 1931 | ;; body text. |
| 1889 | string))) | 1932 | (add-text-properties (point-min) (point-max) |
| 1890 | ".*?" | 1933 | (list 'rcirc-text (buffer-substring-no-properties |
| 1891 | text)) | 1934 | (point-min) (point-max))))) |
| 1892 | ;; TODO: deal with ^_ and ^C colors sequences | 1935 | |
| 1893 | (while (string-match "\\(.*\\)[]\\(.*\\)" text) | 1936 | (defun rcirc-markup-attributes (process sender response channel-buffer) |
| 1894 | (setq text (concat (match-string 1 text) | 1937 | (while (re-search-forward "\\([\C-b\C-_\C-v]\\).*?\\(\\1\\|\C-o\\)" nil t) |
| 1895 | (match-string 2 text)))) | 1938 | (rcirc-add-face (match-beginning 0) (match-end 0) |
| 1896 | ;; my nick | 1939 | (case (char-after (match-beginning 1)) |
| 1897 | (setq text | 1940 | (?\C-b 'bold) |
| 1898 | (with-syntax-table rcirc-nick-syntax-table | 1941 | (?\C-v 'italic) |
| 1899 | (rcirc-map-regexp (lambda (start end string) | 1942 | (?\C-_ 'underline))) |
| 1900 | (add-text-properties | 1943 | ;; keep the ^O since it could terminate other attributes |
| 1901 | start end | 1944 | (when (not (eq ?\C-o (char-before (match-end 2)))) |
| 1902 | (list 'face 'rcirc-nick-in-message | 1945 | (delete-region (match-beginning 2) (match-end 2))) |
| 1903 | 'rear-nonsticky t) | 1946 | (delete-region (match-beginning 1) (match-end 1)) |
| 1904 | string)) | 1947 | (goto-char (1+ (match-beginning 1)))) |
| 1905 | (concat "\\b" | 1948 | ;; remove the ^O characters now |
| 1906 | (regexp-quote (rcirc-nick process)) | 1949 | (while (re-search-forward "\C-o+" nil t) |
| 1907 | "\\b") | 1950 | (delete-region (match-beginning 0) (match-end 0)))) |
| 1908 | text))) | 1951 | |
| 1909 | ;; urls | 1952 | (defun rcirc-markup-my-nick (process sender response channel-buffer) |
| 1910 | (setq text | 1953 | (with-syntax-table rcirc-nick-syntax-table |
| 1911 | (rcirc-map-regexp | 1954 | (while (re-search-forward (concat "\\b" |
| 1912 | (lambda (start end string) | 1955 | (regexp-quote (rcirc-nick process)) |
| 1913 | (let ((orig-face (get-text-property start 'face string))) | 1956 | "\\b") |
| 1914 | (add-text-properties start end | 1957 | nil t) |
| 1915 | (list 'face (if (listp orig-face) | 1958 | (rcirc-add-face (match-beginning 0) (match-end 0) |
| 1916 | (append orig-face | 1959 | 'rcirc-nick-in-message) |
| 1917 | (list 'bold)) | 1960 | (when (string= response "PRIVMSG") |
| 1918 | (list orig-face 'bold)) | 1961 | (rcirc-add-face (point-min) (point-max) 'rcirc-nick-in-message-full-line) |
| 1919 | 'rear-nonsticky t | 1962 | (rcirc-record-activity channel-buffer 'nick))))) |
| 1920 | 'mouse-face 'highlight | 1963 | |
| 1921 | 'keymap rcirc-browse-url-map) | 1964 | (defun rcirc-markup-urls (process sender response channel-buffer) |
| 1922 | string)) | 1965 | (while (re-search-forward rcirc-url-regexp nil t) |
| 1923 | (push (substring-no-properties string start end) rcirc-urls)) | 1966 | (let ((start (match-beginning 0)) |
| 1924 | rcirc-url-regexp | 1967 | (end (match-end 0))) |
| 1925 | text)) | 1968 | (rcirc-add-face start end 'rcirc-url) |
| 1926 | text) | 1969 | (add-text-properties start end (list 'mouse-face 'highlight |
| 1927 | 1970 | 'keymap rcirc-browse-url-map)) | |
| 1971 | ;; record the url | ||
| 1972 | (let ((url (buffer-substring-no-properties start end))) | ||
| 1973 | (with-current-buffer channel-buffer | ||
| 1974 | (push url rcirc-urls)))))) | ||
| 1975 | |||
| 1976 | (defun rcirc-markup-keywords (process sender response channel-buffer) | ||
| 1977 | (let* ((target (with-current-buffer channel-buffer (or rcirc-target ""))) | ||
| 1978 | (keywords (delq nil (mapcar (lambda (keyword) | ||
| 1979 | (when (not (string-match keyword target)) | ||
| 1980 | keyword)) | ||
| 1981 | rcirc-keywords)))) | ||
| 1982 | (when keywords | ||
| 1983 | (while (re-search-forward (regexp-opt keywords 'words) nil t) | ||
| 1984 | (rcirc-add-face (match-beginning 0) (match-end 0) 'rcirc-keyword) | ||
| 1985 | (when (and (string= response "PRIVMSG") | ||
| 1986 | (not (string= sender (rcirc-nick process)))) | ||
| 1987 | (rcirc-record-activity channel-buffer 'keyword)))))) | ||
| 1988 | |||
| 1989 | (defun rcirc-markup-bright-nicks (process sender response channel-buffer) | ||
| 1990 | (when (and rcirc-bright-nicks | ||
| 1991 | (string= response "NAMES")) | ||
| 1992 | (with-syntax-table rcirc-nick-syntax-table | ||
| 1993 | (while (re-search-forward (regexp-opt rcirc-bright-nicks 'words) nil t) | ||
| 1994 | (rcirc-add-face (match-beginning 0) (match-end 0) | ||
| 1995 | 'rcirc-bright-nick))))) | ||
| 1928 | 1996 | ||
| 1929 | ;;; handlers | 1997 | ;;; handlers |
| 1930 | ;; these are called with the server PROCESS, the SENDER, which is a | 1998 | ;; these are called with the server PROCESS, the SENDER, which is a |
| @@ -2275,12 +2343,12 @@ Passwords are stored in `rcirc-authinfo' (which see)." | |||
| 2275 | (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine")) | 2343 | (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine")) |
| 2276 | (((class color) (min-colors 8)) (:foreground "magenta")) | 2344 | (((class color) (min-colors 8)) (:foreground "magenta")) |
| 2277 | (t (:weight bold :underline t))) | 2345 | (t (:weight bold :underline t))) |
| 2278 | "Face used for nicks matched by `rcirc-bright-nick-regexp'." | 2346 | "Face used for nicks matched by `rcirc-bright-nicks'." |
| 2279 | :group 'rcirc-faces) | 2347 | :group 'rcirc-faces) |
| 2280 | 2348 | ||
| 2281 | (defface rcirc-dim-nick | 2349 | (defface rcirc-dim-nick |
| 2282 | '((t :inherit default)) | 2350 | '((t :inherit default)) |
| 2283 | "Face used for nicks matched by `rcirc-dim-nick-regexp'." | 2351 | "Face used for nicks in `rcirc-dim-nicks'." |
| 2284 | :group 'rcirc-faces) | 2352 | :group 'rcirc-faces) |
| 2285 | 2353 | ||
| 2286 | (defface rcirc-server ; font-lock-comment-face | 2354 | (defface rcirc-server ; font-lock-comment-face |
| @@ -2329,9 +2397,14 @@ Passwords are stored in `rcirc-authinfo' (which see)." | |||
| 2329 | (((class color) (min-colors 16) (background dark)) (:foreground "Cyan")) | 2397 | (((class color) (min-colors 16) (background dark)) (:foreground "Cyan")) |
| 2330 | (((class color) (min-colors 8)) (:foreground "cyan" :weight bold)) | 2398 | (((class color) (min-colors 8)) (:foreground "cyan" :weight bold)) |
| 2331 | (t (:weight bold))) | 2399 | (t (:weight bold))) |
| 2332 | "The face used to highlight instances of nick within messages." | 2400 | "The face used to highlight instances of your nick within messages." |
| 2333 | :group 'rcirc-faces) | 2401 | :group 'rcirc-faces) |
| 2334 | 2402 | ||
| 2403 | (defface rcirc-nick-in-message-full-line | ||
| 2404 | '((t (:bold t))) | ||
| 2405 | "The face used emphasize the entire message when your nick is mentioned." | ||
| 2406 | :group 'rcirc-faces) | ||
| 2407 | |||
| 2335 | (defface rcirc-prompt ; comint-highlight-prompt | 2408 | (defface rcirc-prompt ; comint-highlight-prompt |
| 2336 | '((((min-colors 88) (background dark)) (:foreground "cyan1")) | 2409 | '((((min-colors 88) (background dark)) (:foreground "cyan1")) |
| 2337 | (((background dark)) (:foreground "cyan")) | 2410 | (((background dark)) (:foreground "cyan")) |
| @@ -2339,9 +2412,24 @@ Passwords are stored in `rcirc-authinfo' (which see)." | |||
| 2339 | "The face used to highlight prompts." | 2412 | "The face used to highlight prompts." |
| 2340 | :group 'rcirc-faces) | 2413 | :group 'rcirc-faces) |
| 2341 | 2414 | ||
| 2342 | (defface rcirc-mode-line-nick | 2415 | (defface rcirc-track-nick |
| 2416 | '((t (:inverse-video t))) | ||
| 2417 | "The face used in the mode-line when your nick is mentioned." | ||
| 2418 | :group 'rcirc-faces) | ||
| 2419 | |||
| 2420 | (defface rcirc-track-keyword | ||
| 2421 | '((t (:bold t ))) | ||
| 2422 | "The face used in the mode-line when keywords are mentioned." | ||
| 2423 | :group 'rcirc-faces) | ||
| 2424 | |||
| 2425 | (defface rcirc-url | ||
| 2343 | '((t (:bold t))) | 2426 | '((t (:bold t))) |
| 2344 | "The face used indicate activity directed at you." | 2427 | "The face used to highlight urls." |
| 2428 | :group 'rcirc-faces) | ||
| 2429 | |||
| 2430 | (defface rcirc-keyword | ||
| 2431 | '((t (:inherit highlight))) | ||
| 2432 | "The face used to highlight keywords." | ||
| 2345 | :group 'rcirc-faces) | 2433 | :group 'rcirc-faces) |
| 2346 | 2434 | ||
| 2347 | 2435 | ||