aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorEli Zaretskii2006-09-02 21:25:11 +0000
committerEli Zaretskii2006-09-02 21:25:11 +0000
commitf8db61b2de10a2712cecadf07021d36226bdbc43 (patch)
tree4aadc3274413ee22e5f9fe05d66abf0dc438ef8f
parentbdbae5b870c10ce7a8225d079f844896bd32c450 (diff)
downloademacs-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.el376
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
147the window.") 147the 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.
205Use /ignore to list them, use /ignore NICK to add or remove a nick." 212Use /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.
212Nicks will be removed from the automatic list on follow-up renamings or 219Nicks will be removed from the automatic list on follow-up renamings or
213parts.") 220parts.")
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.
217See `rcirc-bright-nick' face." 224See `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.
223See `rcirc-dim-nick' face." 230See `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.
250The format is ((PATTERN . VAL) ...). 257The format is ((PATTERN . VAL) ...).
251PATTERN is either a string or a cons of strings. 258PATTERN is either a string or a cons of strings.
252If PATTERN is a string, it is used to match a target. 259If 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.
1797Ignore NICK, unignore NICK if already ignored, or list ignored 1804Ignore NICK, unignore NICK if already ignored, or list ignored
1798nicks when no NICK is given. When listing ignored nicks, the 1805nicks when no NICK is given. When listing ignored nicks, the
1799ones added to the list automatically are marked with an asterisk." 1806ones 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.
1833Mark KEYWORD, unmark KEYWORD if already marked, or list marked
1834keywords 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
1868FUNCTION 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
1913Each function takes three arguments, PROCESS, SENDER, RESPONSE
1914and CHANNEL-BUFFER. The current buffer is temporary buffer that
1915contains the text to manipulate. Each function works on the text
1916in 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