aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/net/rcirc.el152
1 files changed, 89 insertions, 63 deletions
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 971b65bf25c..f2eff379d14 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -49,7 +49,7 @@
49(defgroup rcirc nil 49(defgroup rcirc nil
50 "Simple IRC client." 50 "Simple IRC client."
51 :version "22.1" 51 :version "22.1"
52 :prefix "rcirc" 52 :prefix "rcirc-"
53 :group 'applications) 53 :group 'applications)
54 54
55(defcustom rcirc-server "irc.freenode.net" 55(defcustom rcirc-server "irc.freenode.net"
@@ -295,16 +295,23 @@ If ARG is non-nil, prompt for a server to connect to."
295(defvar rcirc-topic nil) 295(defvar rcirc-topic nil)
296(defvar rcirc-keepalive-timer nil) 296(defvar rcirc-keepalive-timer nil)
297(defvar rcirc-last-server-message-time nil) 297(defvar rcirc-last-server-message-time nil)
298(defun rcirc-connect (server port nick user-name full-name startup-channels) 298(defun rcirc-connect (&optional server port nick user-name full-name startup-channels)
299 (add-hook 'window-configuration-change-hook 299 (add-hook 'window-configuration-change-hook
300 'rcirc-window-configuration-change) 300 'rcirc-window-configuration-change)
301 301
302 (save-excursion 302 (save-excursion
303 (message "Connecting to %s..." server) 303 (message "Connecting to %s..." server)
304 (let* ((inhibit-eol-conversion) 304 (let* ((inhibit-eol-conversion)
305 (port-number (if (stringp port) 305 (port-number (if port
306 (string-to-number port) 306 (if (stringp port)
307 port)) 307 (string-to-number port)
308 port)
309 rcirc-port))
310 (server (or server rcirc-server))
311 (nick (or nick rcirc-nick))
312 (user-name (or user-name rcirc-user-name))
313 (full-name (or full-name rcirc-user-full-name))
314 (startup-channels (or startup-channels (rcirc-startup-channels server)))
308 (process (open-network-stream server nil server port-number))) 315 (process (open-network-stream server nil server port-number)))
309 ;; set up process 316 ;; set up process
310 (set-process-coding-system process 'raw-text 'raw-text) 317 (set-process-coding-system process 'raw-text 'raw-text)
@@ -758,9 +765,9 @@ if there is no existing buffer for TARGET, otherwise return nil."
758Create the buffer if it doesn't exist." 765Create the buffer if it doesn't exist."
759 (let ((buffer (rcirc-get-buffer process target))) 766 (let ((buffer (rcirc-get-buffer process target)))
760 (if buffer 767 (if buffer
761 (progn 768 (with-current-buffer buffer
762 (when (not rcirc-target) 769 (when (not rcirc-target)
763 (setq rcirc-target target)) 770 (setq rcirc-target target))
764 buffer) 771 buffer)
765 ;; create the buffer 772 ;; create the buffer
766 (with-rcirc-process-buffer process 773 (with-rcirc-process-buffer process
@@ -896,20 +903,22 @@ Create the buffer if it doesn't exist."
896 (kill-buffer (current-buffer)) 903 (kill-buffer (current-buffer))
897 (set-window-configuration rcirc-window-configuration)) 904 (set-window-configuration rcirc-window-configuration))
898 905
899(defun rcirc-get-any-buffer (process) 906(defun rcirc-any-buffer (process)
900 "Return a buffer for PROCESS, either the one selected or the process buffer." 907 "Return a buffer for PROCESS, either the one selected or the process buffer."
901 (let ((buffer (window-buffer (selected-window)))) 908 (if rcirc-always-use-server-buffer-flag
902 (if (and buffer 909 (process-buffer process)
903 (with-current-buffer buffer 910 (let ((buffer (window-buffer (selected-window))))
904 (and (eq major-mode 'rcirc-mode) 911 (if (and buffer
905 (eq rcirc-process process)))) 912 (with-current-buffer buffer
906 buffer 913 (and (eq major-mode 'rcirc-mode)
907 (process-buffer process)))) 914 (eq rcirc-process process))))
915 buffer
916 (process-buffer process)))))
908 917
909(defcustom rcirc-response-formats 918(defcustom rcirc-response-formats
910 '(("PRIVMSG" . "%T<%n> %m") 919 '(("PRIVMSG" . "%T<%N> %m")
911 ("NOTICE" . "%T-%n- %m") 920 ("NOTICE" . "%T-%N- %m")
912 ("ACTION" . "%T[%n] %m") 921 ("ACTION" . "%T[%N %m]")
913 ("COMMAND" . "%T%m") 922 ("COMMAND" . "%T%m")
914 ("ERROR" . "%T%fw!!! %m") 923 ("ERROR" . "%T%fw!!! %m")
915 (t . "%T%fp*** %fs%n %r %m")) 924 (t . "%T%fp*** %fs%n %r %m"))
@@ -921,7 +930,8 @@ The entry's value part should be a string, which is inserted with
921the of the following escape sequences replaced by the described values: 930the of the following escape sequences replaced by the described values:
922 931
923 %m The message text 932 %m The message text
924 %n The sender's nick (with face `rcirc-my-nick' or `rcirc-other-nick') 933 %n The sender's nick
934 %N The sender's nick (with face `rcirc-my-nick' or `rcirc-other-nick')
925 %r The response-type 935 %r The response-type
926 %T The timestamp (with face `rcirc-timestamp') 936 %T The timestamp (with face `rcirc-timestamp')
927 %t The target 937 %t The target
@@ -959,13 +969,20 @@ is found by looking up RESPONSE in `rcirc-response-formats'."
959 (cond ((eq key ?%) 969 (cond ((eq key ?%)
960 ;; %% -- literal % character 970 ;; %% -- literal % character
961 "%") 971 "%")
962 ((eq key ?n) 972 ((or (eq key ?n) (eq key ?N))
963 ;; %n -- nick 973 ;; %n/%N -- nick
964 (rcirc-facify (concat (rcirc-abbrev-nick sender) 974 (let ((nick (concat (if (string= (with-rcirc-process-buffer
965 (and target (concat "," target))) 975 process rcirc-server)
966 (if (string= sender (rcirc-nick process)) 976 sender)
967 'rcirc-my-nick 977 ""
968 'rcirc-other-nick))) 978 (rcirc-abbrev-nick sender))
979 (and target (concat "," target)))))
980 (rcirc-facify nick
981 (if (eq key ?n)
982 face
983 (if (string= sender (rcirc-nick process))
984 'rcirc-my-nick
985 'rcirc-other-nick)))))
969 ((eq key ?T) 986 ((eq key ?T)
970 ;; %T -- timestamp 987 ;; %T -- timestamp
971 (rcirc-facify 988 (rcirc-facify
@@ -1015,9 +1032,7 @@ is found by looking up RESPONSE in `rcirc-response-formats'."
1015 (assert (not (bufferp target))) 1032 (assert (not (bufferp target)))
1016 (with-rcirc-process-buffer process 1033 (with-rcirc-process-buffer process
1017 (cond ((not target) 1034 (cond ((not target)
1018 (if rcirc-always-use-server-buffer-flag 1035 (rcirc-any-buffer process))
1019 (process-buffer process)
1020 (rcirc-get-any-buffer process)))
1021 ((not (rcirc-channel-p target)) 1036 ((not (rcirc-channel-p target))
1022 ;; message from another user 1037 ;; message from another user
1023 (if (string= response "PRIVMSG") 1038 (if (string= response "PRIVMSG")
@@ -1026,7 +1041,7 @@ is found by looking up RESPONSE in `rcirc-response-formats'."
1026 sender)) 1041 sender))
1027 (rcirc-get-buffer process target t))) 1042 (rcirc-get-buffer process target t)))
1028 ((or (rcirc-get-buffer process target) 1043 ((or (rcirc-get-buffer process target)
1029 (rcirc-get-any-buffer process)))))) 1044 (rcirc-any-buffer process))))))
1030 1045
1031(defvar rcirc-activity-type nil) 1046(defvar rcirc-activity-type nil)
1032(make-variable-buffer-local 'rcirc-activity-type) 1047(make-variable-buffer-local 'rcirc-activity-type)
@@ -1069,22 +1084,26 @@ record activity."
1069 (set-marker-insertion-type rcirc-prompt-start-marker nil) 1084 (set-marker-insertion-type rcirc-prompt-start-marker nil)
1070 (set-marker-insertion-type rcirc-prompt-end-marker nil) 1085 (set-marker-insertion-type rcirc-prompt-end-marker nil)
1071 1086
1072 ;; fill the text we just inserted, maybe 1087 (let ((text-start (make-marker)))
1073 (when (and rcirc-fill-flag 1088 (set-marker text-start
1074 (not (string= response "372"))) ;/motd 1089 (or (next-single-property-change fill-start
1075 (let ((fill-prefix 1090 'rcirc-text)
1076 (or rcirc-fill-prefix 1091 (point-max)))
1077 (make-string 1092 ;; squeeze spaces out of text before rcirc-text
1078 (or (next-single-property-change 0 'rcirc-text 1093 (fill-region fill-start (1- text-start))
1079 fmted-text) 1094
1080 8) 1095 ;; fill the text we just inserted, maybe
1081 ?\s))) 1096 (when (and rcirc-fill-flag
1082 (fill-column (cond ((eq rcirc-fill-column 'frame-width) 1097 (not (string= response "372"))) ;/motd
1083 (1- (frame-width))) 1098 (let ((fill-prefix
1084 (rcirc-fill-column 1099 (or rcirc-fill-prefix
1085 rcirc-fill-column) 1100 (make-string (- text-start fill-start) ?\s)))
1086 (t fill-column)))) 1101 (fill-column (cond ((eq rcirc-fill-column 'frame-width)
1087 (fill-region fill-start rcirc-prompt-start-marker 'left t)))) 1102 (1- (frame-width)))
1103 (rcirc-fill-column
1104 rcirc-fill-column)
1105 (t fill-column))))
1106 (fill-region fill-start rcirc-prompt-start-marker 'left t)))))
1088 1107
1089 ;; set inserted text to be read-only 1108 ;; set inserted text to be read-only
1090 (when rcirc-read-only-flag 1109 (when rcirc-read-only-flag
@@ -1175,14 +1194,15 @@ record activity."
1175 1194
1176(defun rcirc-put-nick-channel (process nick channel) 1195(defun rcirc-put-nick-channel (process nick channel)
1177 "Add CHANNEL to list associated with NICK." 1196 "Add CHANNEL to list associated with NICK."
1178 (with-rcirc-process-buffer process 1197 (let ((nick (rcirc-user-nick nick)))
1179 (let* ((chans (gethash nick rcirc-nick-table)) 1198 (with-rcirc-process-buffer process
1180 (record (assoc-string channel chans t))) 1199 (let* ((chans (gethash nick rcirc-nick-table))
1181 (if record 1200 (record (assoc-string channel chans t)))
1182 (setcdr record (current-time)) 1201 (if record
1183 (puthash nick (cons (cons channel (current-time)) 1202 (setcdr record (current-time))
1184 chans) 1203 (puthash nick (cons (cons channel (current-time))
1185 rcirc-nick-table))))) 1204 chans)
1205 rcirc-nick-table))))))
1186 1206
1187(defun rcirc-nick-remove (process nick) 1207(defun rcirc-nick-remove (process nick)
1188 "Remove NICK from table." 1208 "Remove NICK from table."
@@ -1613,15 +1633,21 @@ ones added to the list automatically are marked with an asterisk."
1613 (propertize (or string "") 'face face 'rear-nonsticky t)) 1633 (propertize (or string "") 'face face 'rear-nonsticky t))
1614 1634
1615(defvar rcirc-url-regexp 1635(defvar rcirc-url-regexp
1616 (rx word-boundary 1636 (rx-to-string
1617 (or "www." 1637 `(and word-boundary
1618 (and (or "http" "https" "ftp" "file" "gopher" "news" "telnet" "wais" 1638 (or "www."
1619 "mailto") 1639 (and (or "http" "https" "ftp" "file" "gopher" "news" "telnet"
1620 "://" 1640 "wais" "mailto")
1621 (1+ (char "a-zA-Z0-9_.")) 1641 "://"
1622 (optional ":" (1+ (char "0-9"))))) 1642 (1+ (char "-a-zA-Z0-9_."))
1623 (1+ (char "-a-zA-Z0-9_=!?#$\@~`%&*+|\\/:;.,{}[]")) 1643 (optional ":" (1+ (char "0-9"))))
1624 (char "-a-zA-Z0-9_=#$\@~`%&*+|\\/:;{}[]")) 1644 (and (1+ (char "-a-zA-Z0-9_."))
1645 (or ".com" ".net" ".org")
1646 word-boundary))
1647 (optional
1648 (and "/"
1649 (1+ (char "-a-zA-Z0-9_=!?#$\@~`%&*+|\\/:;.,{}[]"))
1650 (char "-a-zA-Z0-9_=#$\@~`%&*+|\\/:;{}[]")))))
1625 "Regexp matching URLs. Set to nil to disable URL features in rcirc.") 1651 "Regexp matching URLs. Set to nil to disable URL features in rcirc.")
1626 1652
1627(defun rcirc-browse-url (&optional arg) 1653(defun rcirc-browse-url (&optional arg)