diff options
Diffstat (limited to 'lisp/+circe.el')
-rw-r--r-- | lisp/+circe.el | 285 |
1 files changed, 0 insertions, 285 deletions
diff --git a/lisp/+circe.el b/lisp/+circe.el deleted file mode 100644 index 382f0ab..0000000 --- a/lisp/+circe.el +++ /dev/null | |||
@@ -1,285 +0,0 @@ | |||
1 | ;;; +circe.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require '+util) | ||
6 | (require 'circe) | ||
7 | |||
8 | (defgroup +circe nil | ||
9 | "Extra customizations for Circe." | ||
10 | :group 'circe) | ||
11 | |||
12 | (defcustom +circe-left-margin 16 | ||
13 | "The size of the margin on the left." | ||
14 | :type 'integer) | ||
15 | |||
16 | (defcustom +circe-network-inhibit-autoconnect nil | ||
17 | "Servers to inhibit autoconnecting from `circe-network-options'." | ||
18 | :type '(repeat string)) | ||
19 | |||
20 | ;;; Connecting to IRC | ||
21 | |||
22 | ;;;###autoload | ||
23 | (defun +irc () | ||
24 | "Connect to all IRC networks in `circe-network-options'." | ||
25 | (interactive) | ||
26 | (dolist (network (mapcar 'car circe-network-options)) | ||
27 | (unless (member network +circe-network-inhibit-autoconnect) | ||
28 | (+circe-maybe-connect network)))) | ||
29 | |||
30 | (defun +circe-network-connected-p (network) | ||
31 | "Return t if connected to NETWORK, nil otherwise." | ||
32 | (catch 'return | ||
33 | (dolist (buffer (circe-server-buffers)) | ||
34 | (with-current-buffer buffer | ||
35 | (when (string= network circe-server-network) | ||
36 | (throw 'return t)))))) | ||
37 | |||
38 | (defun +circe-maybe-connect (network) | ||
39 | "Connect to NETWORK, asking for confirmation to reconnect." | ||
40 | (interactive ("sNetwork: ")) | ||
41 | (when (or (not (+circe-network-connected-p network)) | ||
42 | (yes-or-no-p (format "Already connected to %s, reconnect? " | ||
43 | network))) | ||
44 | (circe network))) | ||
45 | |||
46 | ;;; Channel information | ||
47 | |||
48 | (defvar-local +circe-current-topic "" | ||
49 | "Cached topic of the buffer's channel.") | ||
50 | |||
51 | (defun +circe-current-topic (&optional message) | ||
52 | "Return the topic of the current channel. | ||
53 | When called with optional MESSAGE non-nil, or interactively, also | ||
54 | message the current topic." | ||
55 | (interactive "p") | ||
56 | (let ((topic | ||
57 | (or (save-excursion | ||
58 | (goto-char (point-max)) | ||
59 | (and (re-search-backward | ||
60 | (rx (group "*** " | ||
61 | (or "Topic" "topic" "TOPIC") | ||
62 | (* (not ":")) ": ") | ||
63 | (group (+ nonl))) | ||
64 | nil t) | ||
65 | (buffer-substring-no-properties | ||
66 | (match-beginning 2) (match-end 2)))) | ||
67 | +circe-current-topic))) | ||
68 | (setq +circe-current-topic topic) | ||
69 | (when message | ||
70 | (message "%s" topic)) | ||
71 | topic)) | ||
72 | |||
73 | ;;; Formatting messages | ||
74 | |||
75 | (defun +circe-format-meta (string &optional no-nick) | ||
76 | "Return a format string for `lui-format' for metadata messages. | ||
77 | Include nick unless NO-NICK is non-nil. If NO-NICK is a string, | ||
78 | replace {nick} in the string with {NO-NICK}." | ||
79 | (cond | ||
80 | ((stringp no-nick) | ||
81 | (format "{%1$s:%2$d.%2$ds} *** %3$s" | ||
82 | no-nick (- +circe-left-margin 3) string)) | ||
83 | (no-nick | ||
84 | (format (format "%%%ds *** %s" (- +circe-left-margin 3) string) " ")) | ||
85 | (t | ||
86 | (format "{nick:%1$d.%1$ds} *** %s" (- +circe-left-margin 3) string)))) | ||
87 | |||
88 | (defun +circe-format-meta* (string) | ||
89 | "Return a format string for `lui-format' for metadata messages, /without/ ") | ||
90 | |||
91 | (defmacro +lui-make-formatting-list-rx (char) | ||
92 | "Make a formatting regex for CHAR delimiters. | ||
93 | For entry into `lui-formatting-list'." | ||
94 | `(rx (or bol whitespace) | ||
95 | (group ,char (+? (not (any whitespace ,char))) ,char) | ||
96 | (or eol whitespace))) | ||
97 | |||
98 | ;;; Hooks & Advice | ||
99 | |||
100 | (defun +circe-chat@set-prompt () | ||
101 | "Set the prompt to the (shortened) buffer name." | ||
102 | (interactive) | ||
103 | (lui-set-prompt (propertize (+string-align (buffer-name) +circe-left-margin | ||
104 | :after " > " | ||
105 | :ellipsis "~" | ||
106 | :alignment 'right)))) | ||
107 | |||
108 | (defun +circe-kill-buffer (&rest _) | ||
109 | "Kill a circe buffer without confirmation, and after a delay." | ||
110 | (let ((circe-channel-killed-confirmation) | ||
111 | (circe-server-killed-confirmation)) | ||
112 | (when (derived-mode-p 'lui-mode) ; don't spuriously kill | ||
113 | (ignore-errors | ||
114 | (kill-buffer))))) | ||
115 | |||
116 | (defun +circe-quit@kill-buffer (&rest _) | ||
117 | "ADVICE: kill all buffers of a server after `circe-command-QUIT'." | ||
118 | (with-circe-server-buffer | ||
119 | (dolist (buf (circe-server-buffers)) | ||
120 | (with-current-buffer buf | ||
121 | (+circe-kill-buffer))) | ||
122 | (+circe-kill-buffer))) | ||
123 | |||
124 | (defun +circe-gquit@kill-buffer (&rest _) | ||
125 | "ADVICE: kill all Circe buffers after `circe-command-GQUIT'." | ||
126 | (let ((circe-channel-killed-confirmation) | ||
127 | (circe-server-killed-confirmation)) | ||
128 | (dolist (buf (circe-server-buffers)) | ||
129 | (with-current-buffer buf | ||
130 | (+circe-quit@kill-buffer))))) | ||
131 | |||
132 | (defun +circe-quit-all@kill-emacs () | ||
133 | "Quit all circe buffers when killing Emacs." | ||
134 | (ignore-errors | ||
135 | (advice-remove 'circe-command-GQUIT | ||
136 | 'circe-gquit@kill-buffer) | ||
137 | (circe-command-GQUIT "Quitting Emacs, bye!"))) | ||
138 | |||
139 | ;;; Patches | ||
140 | |||
141 | (require 'el-patch) | ||
142 | |||
143 | (el-patch-feature circe) | ||
144 | (defvar +circe-server-buffer-action 'pop-to-buffer-same-window | ||
145 | "What to do with `circe-server' buffers when created.") | ||
146 | |||
147 | (el-patch-defun circe (network-or-server &rest server-options) | ||
148 | "Connect to IRC. | ||
149 | |||
150 | Connect to the given network specified by NETWORK-OR-SERVER. | ||
151 | |||
152 | When this function is called, it collects options from the | ||
153 | SERVER-OPTIONS argument, the user variable | ||
154 | `circe-network-options', and the defaults found in | ||
155 | `circe-network-defaults', in this order. | ||
156 | |||
157 | If NETWORK-OR-SERVER is not found in any of these variables, the | ||
158 | argument is assumed to be the host name for the server, and all | ||
159 | relevant settings must be passed via SERVER-OPTIONS. | ||
160 | |||
161 | All SERVER-OPTIONS are treated as variables by getting the string | ||
162 | \"circe-\" prepended to their name. This variable is then set | ||
163 | locally in the server buffer. | ||
164 | |||
165 | See `circe-network-options' for a list of common options." | ||
166 | (interactive (circe--read-network-and-options)) | ||
167 | (let* ((options (circe--server-get-network-options network-or-server | ||
168 | server-options)) | ||
169 | (buffer (circe--server-generate-buffer options))) | ||
170 | (with-current-buffer buffer | ||
171 | (circe-server-mode) | ||
172 | (circe--server-set-variables options) | ||
173 | (circe-reconnect)) | ||
174 | (el-patch-swap (pop-to-buffer-same-window buffer) | ||
175 | (funcall +circe-server-buffer-action buffer)))) | ||
176 | |||
177 | ;;; Chat commands | ||
178 | |||
179 | (defun circe-command-SLAP (nick) | ||
180 | "Slap NICK around a bit with a large trout." | ||
181 | (interactive (list (completing-read "Nick to slap: " | ||
182 | (circe-channel-nicks) | ||
183 | nil t nil))) | ||
184 | (circe-command-ME (format "slaps %s about a bit with a large trout" nick))) | ||
185 | |||
186 | ;;; Filtering functions --- XXX: These don't work right. | ||
187 | ;; Set `lui-input-function' to `+lui-filter', then add the filters you want to | ||
188 | ;; `circe-channel-mode-hook'. | ||
189 | |||
190 | (defvar +lui-filters nil | ||
191 | "Stack of input functions to apply. | ||
192 | This is an alist with cells of the structure (TAG . FN), so we | ||
193 | can easily remove elements.") | ||
194 | (make-variable-buffer-local '+lui-filters) | ||
195 | |||
196 | (defun +lui-filter (text &optional fn-alist) | ||
197 | (let ((fs (nreverse (purecopy (or fn-alist +lui-filters))))) | ||
198 | (while fs | ||
199 | (setq text (funcall (cdr (pop fs)) text))) | ||
200 | (circe--input text))) | ||
201 | |||
202 | (defmacro +circe-define-filter (name docstring &rest body) | ||
203 | "Define a filter for circe-inputted text." | ||
204 | (declare (doc-string 2) | ||
205 | (indent 1)) | ||
206 | (let (plist) | ||
207 | (while (keywordp (car-safe body)) | ||
208 | (push (pop body) plist) | ||
209 | (push (pop body) plist)) | ||
210 | ;; Return value | ||
211 | `(define-minor-mode ,name | ||
212 | ,docstring | ||
213 | ,@(nreverse plist) | ||
214 | (when (derived-mode-p 'circe-chat-mode) | ||
215 | (if ,name | ||
216 | (push '(,name . (lambda (it) ,@body)) +lui-filters) | ||
217 | (setq +lui-filters | ||
218 | (assoc-delete-all ',name +lui-filters))))))) | ||
219 | |||
220 | ;; CAPPY HOUR! (Pure idiocy) | ||
221 | |||
222 | (+circe-define-filter +circe-cappy-hour-mode | ||
223 | "ENABLE CAPPY HOUR IN CIRCE!" | ||
224 | :lighter " CAPPY HOUR" | ||
225 | (upcase it)) | ||
226 | |||
227 | ;; URL Shortener | ||
228 | |||
229 | (+circe-define-filter +circe-shorten-url-mode | ||
230 | "Shorten long urls when chatting." | ||
231 | :lighter " c0x0" | ||
232 | (+circe-0x0-shorten-urls it)) | ||
233 | |||
234 | (defvar +circe-0x0-max-length 20 | ||
235 | "Maximum length of URLs before using a shortener.") | ||
236 | |||
237 | (defun +circe-0x0-shorten-urls (text) | ||
238 | "Find urls in TEXT and shorten them using `0x0'." | ||
239 | (require '0x0) | ||
240 | (require 'browse-url) | ||
241 | (let ((case-fold-search t)) | ||
242 | (replace-regexp-in-string | ||
243 | browse-url-button-regexp | ||
244 | (lambda (match) | ||
245 | (if (> (length match) +circe-0x0-max-length) | ||
246 | (+with-message (format "Shortening URL: %s" match) | ||
247 | (0x0-shorten-uri (0x0--choose-server) | ||
248 | (substring-no-properties match))) | ||
249 | match)) | ||
250 | text))) | ||
251 | |||
252 | (defun +circe-shorten-urls-all () | ||
253 | "Turn on `+circe-shorten-url-mode' in all chat buffers." | ||
254 | (interactive) | ||
255 | (+mapc-some-buffers | ||
256 | (lambda () (+circe-shorten-url-mode +1)) | ||
257 | (lambda (buf) | ||
258 | (derived-mode-p 'circe-chat-mode)))) | ||
259 | |||
260 | ;; Temperature conversion | ||
261 | |||
262 | (+circe-define-filter +circe-F/C-mode | ||
263 | "Convert degF to degF/degC for international chats." | ||
264 | :lighter " F/C" | ||
265 | (str-F/C it)) | ||
266 | |||
267 | (defun fahrenheit-to-celsius (degf) | ||
268 | "Convert DEGF to Celsius." | ||
269 | (round (* (/ 5.0 9.0) (- degf 32)))) | ||
270 | |||
271 | (defun celsius-to-fahrenheit (degc) | ||
272 | "Convert DEGC to Fahrenheit." | ||
273 | (round (+ 32 (* (/ 9.0 5.0) degc)))) | ||
274 | |||
275 | (defun str-F/C (text) | ||
276 | (replace-regexp-in-string "[^.]\\([[:digit:]]+\\(?:\\.[[:digit:]]+\\)?[fF]\\)" | ||
277 | (lambda (match) | ||
278 | (format "%s/%dC" match | ||
279 | (fahrenheit-to-celsius | ||
280 | (string-to-number match)))) | ||
281 | text | ||
282 | nil 1)) | ||
283 | |||
284 | (provide '+circe) | ||
285 | ;;; +circe.el ends here | ||