-
Notifications
You must be signed in to change notification settings - Fork 26
/
sauron-erc.el
166 lines (143 loc) · 5.5 KB
/
sauron-erc.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
;;; sauron-erc.el --- an ERC tracking module, part of sauron
;;
;; Copyright (C) 2011 Dirk-Jan C. Binnema
;; This file is not part of GNU Emacs.
;;
;; Sauron is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; Sauron is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; For documentation, please see:
;; https://github.com/djcb/sauron/blob/master/README.org
;;; Code:
(require 'erc nil 'noerror)
(eval-when-compile (require 'cl))
(defvar sauron-erc-interesting-events
'(privmsg current-nick keyword)
"The list of ERC events we are interested in. Available are:
- privmsg: a PRIVMSG message received
- join a JOIN message received
- quit a QUIT message received
The following events are erc-track
- current-nick: current nick mentioned in ERC
- keyword: some keyword mentioned in ERC.")
(defvar sauron-prio-erc-default 2
"ERC event default priority.")
(defvar sauron-prio-erc-privmsg-root 2
"ERC message from root event priority.")
(defvar sauron-prio-erc-privmsg-for-me 3
"ERC message for me event priority.")
(defvar sauron-prio-erc-privmsg-mentioned 3
"ERC mention event priority.")
(defvar sauron-prio-erc-privmsg-default 2
"ERC private message event default priority.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar sr-erc-running nil
"*internal* Whether sauron erc is running.")
(defun sauron-erc-start ()
"Start watching ERC."
(if (not (fboundp 'erc-version))
(progn
(message "sauron-erc not available")
nil)
(unless sr-erc-running
(add-hook 'erc-server-PRIVMSG-functions 'sr-erc-PRIVMSG-hook-func)
(add-hook 'erc-server-JOIN-functions 'sr-erc-JOIN-hook-func)
(add-hook 'erc-server-PART-functions 'sr-erc-PART-hook-func)
(add-hook 'erc-server-QUIT-functions 'sr-erc-QUIT-hook-func)
(setq sr-erc-running t))
t))
(defun sauron-erc-stop ()
"Stop watching ERC."
(when sr-erc-running
(remove-hook 'erc-server-PRIVMSG-functions 'sr-erc-PRIVMSG-hook-func)
(remove-hook 'erc-server-JOIN-functions 'sr-erc-JOIN-hook-func)
(remove-hook 'erc-server-PART-functions 'sr-erc-PART-hook-func)
(remove-hook 'erc-server-QUIT-functions 'sr-erc-QUIT-hook-func)
(setq sr-erc-running nil)))
;; note, this function is called from the server-buffer, not from the channel it
;; refers to
(defun sr-erc-hook-func (proc parsed event)
"Hook function, to be called for erc-matched-hook."
(let* ( (me (erc-current-nick))
(sender (car (erc-parse-user (erc-response.sender parsed))))
(channel (car (erc-response.command-args parsed)))
(msg (erc-response.contents parsed)))
(sauron-add-event
'erc
sauron-prio-erc-default
(concat (propertize sender 'face 'sauron-highlight1-face) " has "
(case event
('quit (concat "quit (" msg ")"))
('part (concat "left "
(propertize channel 'face 'sauron-highlight2-face)
" (" msg ")"))
('join (concat "joined "
(propertize channel 'face 'sauron-highlight2-face)))))
(lexical-let ((target channel))
(lambda() (sauron-switch-to-marker-or-buffer target)))
`( :event ,event
:sender ,sender
:me ,me
:channel ,channel
:msg ,msg))))
(defun sr-erc-JOIN-hook-func (proc parsed)
"JOIN hook function."
(sr-erc-hook-func proc parsed 'join) nil)
(defun sr-erc-QUIT-hook-func (proc parsed)
"QUIT hook function."
(sr-erc-hook-func proc parsed 'quit) nil)
(defun sr-erc-PART-hook-func (proc parsed)
"PART hook function."
(sr-erc-hook-func proc parsed 'part) nil)
(defun sr-erc-msg-clean (msg)
"Clean IRC escaped stuff from messages."
(when msg ;; remove the IRC meta crap
(replace-regexp-in-string ".*[]" "" msg)))
(defun sr-erc-PRIVMSG-hook-func (proc parsed)
"Hook function, to be called for erc-matched-hook."
(let* ( (me (erc-current-nick))
(sender (car (erc-parse-user (erc-response.sender parsed))))
(channel (car (erc-response.command-args parsed)))
(msg (sr-erc-msg-clean (erc-response.contents parsed)))
(for-me (string= me channel))
(prio
(cond
;; e.g. bitlbee stuff; low-prio
((string= sender "root") sauron-prio-erc-privmsg-root)
;; private msg for me => prio 4
(for-me sauron-prio-erc-privmsg-for-me)
;; I'm mentioned => prio 3
((string-match me msg) sauron-prio-erc-privmsg-mentioned)
;; default
(t sauron-prio-erc-privmsg-default)))
(target (if (buffer-live-p (get-buffer channel))
(with-current-buffer (get-buffer channel)
(point-marker)))))
(sauron-add-event
'erc
prio
(concat
(propertize sender 'face 'sauron-highlight1-face) "@"
(propertize channel 'face 'sauron-highlight2-face)
(propertize ": " 'face 'sauron-highlight1-face)
msg)
(lexical-let* ((target-mark target)
(target-buf (if for-me sender channel)))
(lambda ()
(sauron-switch-to-marker-or-buffer (or target-mark target-buf))))
`( :event privmsg
:sender ,sender
:me ,me
:channel ,channel
:msg ,msg)))
nil)
(provide 'sauron-erc)
;;; sauron-erc ends here